{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

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

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)

type Table = Map Text Value

data Value
  = Table Table
  | Array [Value]
  | String Text
  | Integer Integer
  | Float Double -- TOML spec specifies this must be a double precision float: https://github.com/toml-lang/toml/issues/538
  | 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
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show, Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq)

-- | 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 :: forall a. Show a => 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