{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module TOML.Value (
  Value (..),
  renderValue,
  Table,
) where

import Control.DeepSeq (NFData)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time (Day, LocalTime, TimeOfDay, TimeZone)
import GHC.Generics (Generic)

type Table = Map Text Value

data Value
  = Table Table
  | Array [Value]
  | String Text
  | Integer Integer
  | Float Double
  | Boolean Bool
  | OffsetDateTime (LocalTime, TimeZone)
  | LocalDateTime LocalTime
  | LocalDate Day
  | LocalTime TimeOfDay
  deriving (Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show, Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, (forall x. Value -> Rep Value x)
-> (forall x. Rep Value x -> Value) -> Generic Value
forall x. Rep Value x -> Value
forall x. Value -> Rep Value x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Value x -> Value
$cfrom :: forall x. Value -> Rep Value x
Generic, Value -> ()
(Value -> ()) -> NFData Value
forall a. (a -> ()) -> NFData a
rnf :: Value -> ()
$crnf :: Value -> ()
NFData)

-- | Render a Value in pseudo-JSON format.
renderValue :: Value -> Text
renderValue :: Value -> Text
renderValue = \case
  Table Table
kvs -> Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", " (((Text, Value) -> Text) -> [(Text, Value)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Value) -> Text
forall a. Show a => (a, Value) -> Text
renderKeyValue ([(Text, Value)] -> [Text]) -> [(Text, Value)] -> [Text]
forall a b. (a -> b) -> a -> b
$ Table -> [(Text, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList Table
kvs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
  Array [Value]
vs -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
", " ((Value -> Text) -> [Value] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Text
renderValue [Value]
vs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
  String Text
s -> Text -> Text
forall a. Show a => a -> Text
showT Text
s
  Integer Integer
x -> Integer -> Text
forall a. Show a => a -> Text
showT Integer
x
  Float Double
x -> Double -> Text
forall a. Show a => a -> Text
showT Double
x
  Boolean Bool
b -> if Bool
b then Text
"true" else Text
"false"
  OffsetDateTime (LocalTime, TimeZone)
x -> (LocalTime, TimeZone) -> Text
forall a. Show a => a -> Text
showT (LocalTime, TimeZone)
x
  LocalDateTime LocalTime
x -> LocalTime -> Text
forall a. Show a => a -> Text
showT LocalTime
x
  LocalDate Day
x -> Day -> Text
forall a. Show a => a -> Text
showT Day
x
  LocalTime TimeOfDay
x -> TimeOfDay -> Text
forall a. Show a => a -> Text
showT TimeOfDay
x
  where
    renderKeyValue :: (a, Value) -> Text
renderKeyValue (a
k, Value
v) = a -> Text
forall a. Show a => a -> Text
showT a
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
renderValue Value
v

    showT :: Show a => a -> Text
    showT :: a -> Text
showT = String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show