{-|
Module      : Toml.ToValue
Description : Automation for converting application values to TOML.
Copyright   : (c) Eric Mertens, 2023
License     : ISC
Maintainer  : emertens@gmail.com

-}
module Toml.ToValue (
    ToValue(..),

    -- * Table construction
    ToTable(..),
    defaultTableToValue,
    table,
    (.=),
    ) where

import Data.Int (Int8, Int16, Int32, Int64)
import Data.Map qualified as Map
import Data.Time (Day, TimeOfDay, LocalTime, ZonedTime)
import Data.Word (Word8, Word16, Word32, Word64)
import Numeric.Natural (Natural)
import Toml.Value (Value(..), Table)

-- | Build a 'Table' from a list of key-value pairs.
--
-- Use '.=' for a convenient way to build the pairs.
table :: [(String, Value)] -> Value
table :: [(String, Value)] -> Value
table = Table -> Value
Table forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

-- | Convenience function for building key-value pairs while
-- constructing a 'Table'.
--
-- @'table' [a '.=' b, c '.=' d]@
(.=) :: ToValue a => String -> a -> (String, Value)
String
k .= :: forall a. ToValue a => String -> a -> (String, Value)
.= a
v = (String
k, forall a. ToValue a => a -> Value
toValue a
v)

-- | Class for types that can be embedded into 'Value'
class ToValue a where

    -- | Embed a single thing into a TOML value.
    toValue :: a -> Value

    -- | Helper for converting a list of things into a value. This is typically
    -- left to be defined by its default implementation and exists to help define
    -- the encoding for TOML arrays.
    toValueList :: [a] -> Value
    toValueList = [Value] -> Value
Array forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. ToValue a => a -> Value
toValue

-- | Class for things that can be embedded into a TOML table.
--
-- Implement this for things that embed into a 'Table' and then
-- the 'ToValue' instance can be derived with 'defaultTableToValue'.
class ToValue a => ToTable a where

    -- | Convert a single value into a table
    toTable :: a -> Table

-- | Convenience function for building 'ToValue' instances.
defaultTableToValue :: ToTable a => a -> Value
defaultTableToValue :: forall a. ToTable a => a -> Value
defaultTableToValue = Table -> Value
Table forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToTable a => a -> Table
toTable

instance ToValue Value where
    toValue :: Value -> Value
toValue = forall a. a -> a
id

-- | Single characters are encoded as singleton strings. Lists of characters
-- are encoded as a single string value.
instance ToValue Char where
    toValue :: Char -> Value
toValue Char
x = String -> Value
String [Char
x]
    toValueList :: String -> Value
toValueList = String -> Value
String

-- | This instance defers to the list element's 'toValueList' implementation.
instance ToValue a => ToValue [a] where
    toValue :: [a] -> Value
toValue = forall a. ToValue a => [a] -> Value
toValueList

instance ToValue Double    where toValue :: Double -> Value
toValue = Double -> Value
Float
instance ToValue Float     where toValue :: Float -> Value
toValue = Double -> Value
Float forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance ToValue Bool      where toValue :: Bool -> Value
toValue = Bool -> Value
Bool
instance ToValue TimeOfDay where toValue :: TimeOfDay -> Value
toValue = TimeOfDay -> Value
TimeOfDay
instance ToValue LocalTime where toValue :: LocalTime -> Value
toValue = LocalTime -> Value
LocalTime
instance ToValue ZonedTime where toValue :: ZonedTime -> Value
toValue = ZonedTime -> Value
ZonedTime
instance ToValue Day       where toValue :: Day -> Value
toValue = Day -> Value
Day
instance ToValue Integer   where toValue :: Integer -> Value
toValue = Integer -> Value
Integer
instance ToValue Natural   where toValue :: Natural -> Value
toValue = Integer -> Value
Integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Int       where toValue :: Int -> Value
toValue = Integer -> Value
Integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Int8      where toValue :: Int8 -> Value
toValue = Integer -> Value
Integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Int16     where toValue :: Int16 -> Value
toValue = Integer -> Value
Integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Int32     where toValue :: Int32 -> Value
toValue = Integer -> Value
Integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Int64     where toValue :: Int64 -> Value
toValue = Integer -> Value
Integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Word      where toValue :: Word -> Value
toValue = Integer -> Value
Integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Word8     where toValue :: Word8 -> Value
toValue = Integer -> Value
Integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Word16    where toValue :: Word16 -> Value
toValue = Integer -> Value
Integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Word32    where toValue :: Word32 -> Value
toValue = Integer -> Value
Integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Word64    where toValue :: Word64 -> Value
toValue = Integer -> Value
Integer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral