{-|
Module      : Toml.Value
Description : Semantic TOML values
Copyright   : (c) Eric Mertens, 2023
License     : ISC
Maintainer  : emertens@gmail.com

This module provides the type for the semantics of a TOML file.
All dotted keys are resolved in this representation. Each table
is a Map with a single level of keys.

-}
module Toml.Value (
    Value(..),
    Table,
    ) where

import Data.Map (Map)
import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime(zonedTimeToLocalTime, zonedTimeZone), timeZoneMinutes)

-- | Representation of a TOML key-value table.
type Table = Map String Value

-- | Semantic TOML value with all table assignments resolved.
data Value
    = Integer   Integer
    | Float     Double
    | Array     [Value]
    | Table     Table
    | Bool      Bool
    | String    String
    | TimeOfDay TimeOfDay
    | ZonedTime ZonedTime
    | LocalTime LocalTime
    | Day       Day
    deriving (Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
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, ReadPrec [Value]
ReadPrec Value
Int -> ReadS Value
ReadS [Value]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Value]
$creadListPrec :: ReadPrec [Value]
readPrec :: ReadPrec Value
$creadPrec :: ReadPrec Value
readList :: ReadS [Value]
$creadList :: ReadS [Value]
readsPrec :: Int -> ReadS Value
$creadsPrec :: Int -> ReadS Value
Read)

instance Eq Value where
    Integer   Integer
x == :: Value -> Value -> Bool
== Integer   Integer
y = Integer
x forall a. Eq a => a -> a -> Bool
== Integer
y
    Float     Double
x == Float     Double
y = Double
x forall a. Eq a => a -> a -> Bool
== Double
y
    Array     [Value]
x == Array     [Value]
y = [Value]
x forall a. Eq a => a -> a -> Bool
== [Value]
y
    Table     Table
x == Table     Table
y = Table
x forall a. Eq a => a -> a -> Bool
== Table
y
    Bool      Bool
x == Bool      Bool
y = Bool
x forall a. Eq a => a -> a -> Bool
== Bool
y
    String    String
x == String    String
y = String
x forall a. Eq a => a -> a -> Bool
== String
y
    TimeOfDay TimeOfDay
x == TimeOfDay TimeOfDay
y = TimeOfDay
x forall a. Eq a => a -> a -> Bool
== TimeOfDay
y
    LocalTime LocalTime
x == LocalTime LocalTime
y = LocalTime
x forall a. Eq a => a -> a -> Bool
== LocalTime
y
    Day       Day
x == Day       Day
y = Day
x forall a. Eq a => a -> a -> Bool
== Day
y
    ZonedTime ZonedTime
x == ZonedTime ZonedTime
y = ZonedTime -> (LocalTime, Int)
projectZT ZonedTime
x forall a. Eq a => a -> a -> Bool
== ZonedTime -> (LocalTime, Int)
projectZT ZonedTime
y
    Value
_           == Value
_           = Bool
False

-- Extract the relevant parts to build an Eq instance
projectZT :: ZonedTime -> (LocalTime, Int)
projectZT :: ZonedTime -> (LocalTime, Int)
projectZT ZonedTime
x = (ZonedTime -> LocalTime
zonedTimeToLocalTime ZonedTime
x, TimeZone -> Int
timeZoneMinutes (ZonedTime -> TimeZone
zonedTimeZone ZonedTime
x))