{-# LANGUAGE TypeFamilies #-} -- needed for type equality on old GHC
{-|
Module      : Toml.Schema.ToValue
Description : Automation for converting application values to TOML.
Copyright   : (c) Eric Mertens, 2023
License     : ISC
Maintainer  : emertens@gmail.com

The 'ToValue' class provides a conversion function from
application-specific to TOML values.

Because the top-level TOML document is always a table,
the 'ToTable' class is for types that specifically support
conversion to a 'Table'.

"Toml.Schema.Generic" can be used to derive instances of 'ToTable'
automatically for record types and 'ToValue' for array types.

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

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

import Data.Foldable (toList)
import Data.Int (Int8, Int16, Int32, Int64)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Ratio (Ratio)
import Data.Sequence (Seq)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Lazy qualified
import Data.Time (Day, TimeOfDay, LocalTime, ZonedTime)
import Data.Word (Word8, Word16, Word32, Word64)
import Numeric.Natural (Natural)
import Toml.Semantics

-- | Build a 'Table' from a list of key-value pairs.
--
-- Use '.=' for a convenient way to build the pairs.
table :: [(Text, Value)] -> Table
table :: [(Text, Value)] -> Table
table [(Text, Value)]
kvs = Map Text ((), Value) -> Table
forall a. Map Text (a, Value' a) -> Table' a
MkTable ([(Text, ((), Value))] -> Map Text ((), Value)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text
k, ((), Value
v)) | (Text
k, Value
v) <- [(Text, Value)]
kvs])
{-# INLINE table #-}

-- | Convenience function for building key-value pairs while
-- constructing a 'Table'.
--
-- @'table' [a '.=' b, c '.=' d]@
(.=) :: ToValue a => Text -> a -> (Text, Value)
Text
k .= :: forall a. ToValue a => Text -> a -> (Text, Value)
.= a
v = (Text
k, a -> Value
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
List ([Value] -> Value) -> ([a] -> [Value]) -> [a] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> [a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map a -> Value
forall a. ToValue a => a -> Value
toValue

-- | Class for things that can be embedded into a TOML table.
--
-- Implement this for things that always embed into a 'Table' and then
-- the 'ToValue' instance can be derived with 'defaultTableToValue'.
--
-- @
-- instance ToValue Example where
--     toValue = defaultTableToValue
--
-- -- Option 1: Manual instance
-- instance ToTable Example where
--     toTable x = 'table' ["field1" '.=' field1 x, "field2" '.=' field2 x]
--
-- -- Option 2: GHC.Generics derived instance using Toml.ToValue.Generic
-- instance ToTable Example where
--     toTable = genericToTable
-- @
class ToValue a => ToTable a where

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

instance (ToKey k, ToValue v) => ToTable (Map k v) where
    toTable :: Map k v -> Table
toTable Map k v
m = [(Text, Value)] -> Table
table [(k -> Text
forall a. ToKey a => a -> Text
toKey k
k, v -> Value
forall a. ToValue a => a -> Value
toValue v
v) | (k
k,v
v) <- Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map k v
m]

instance (ToKey k, ToValue v) => ToValue (Map k v) where
    toValue :: Map k v -> Value
toValue = Map k v -> Value
forall a. ToTable a => a -> Value
defaultTableToValue

instance ToTable (Table' a) where
    toTable :: Table' a -> Table
toTable = Table' a -> Table
forall a. Table' a -> Table
forgetTableAnns

instance ToValue (Table' a) where
    toValue :: Table' a -> Value
toValue = Table' a -> Value
forall a. ToTable a => a -> Value
defaultTableToValue

-- | Convert to a table key. This class enables various string types to be
-- used as the keys of a 'Map' when converting into TOML tables.
class ToKey a where
    toKey :: a -> Text

instance Char ~ a => ToKey [a] where
    toKey :: [a] -> Text
toKey = [a] -> Text
String -> Text
Text.pack

instance ToKey Text.Text where
    toKey :: Text -> Text
toKey = Text -> Text
forall a. a -> a
id

instance ToKey Data.Text.Lazy.Text where
    toKey :: Text -> Text
toKey = Text -> Text
Data.Text.Lazy.toStrict

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

-- | Identity function
instance ToValue Value where
    toValue :: Value -> Value
toValue = Value -> Value
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 = Text -> Value
Text (Char -> Text
Text.singleton Char
x)
    toValueList :: String -> Value
toValueList = Text -> Value
Text (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

-- | Encodes as string literal
instance ToValue Text.Text where
    toValue :: Text -> Value
toValue = Text -> Value
Text

-- | Encodes as string literal
instance ToValue Data.Text.Lazy.Text where
    toValue :: Text -> Value
toValue = Text -> Value
Text (Text -> Value) -> (Text -> Text) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Data.Text.Lazy.toStrict

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

-- | Converts to list and encodes that to value
instance ToValue a => ToValue (NonEmpty a) where
    toValue :: NonEmpty a -> Value
toValue = [a] -> Value
forall a. ToValue a => a -> Value
toValue ([a] -> Value) -> (NonEmpty a -> [a]) -> NonEmpty a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.toList

-- | Converts to list and encodes that to value
instance ToValue a => ToValue (Seq a) where
    toValue :: Seq a -> Value
toValue = [a] -> Value
forall a. ToValue a => a -> Value
toValue ([a] -> Value) -> (Seq a -> [a]) -> Seq a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | TOML represents floating point numbers with 'Prelude.Double'.
-- This operation lose precision and can overflow to infinity.
instance Integral a => ToValue (Ratio a) where
    toValue :: Ratio a -> Value
toValue = Double -> Value
Double (Double -> Value) -> (Ratio a -> Double) -> Ratio a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance ToValue Double    where toValue :: Double -> Value
toValue = Double -> Value
Double
instance ToValue Float     where toValue :: Float -> Value
toValue = Double -> Value
Double (Double -> Value) -> (Float -> Double) -> Float -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
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 (Integer -> Value) -> (Natural -> Integer) -> Natural -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Int       where toValue :: Int -> Value
toValue = Integer -> Value
Integer (Integer -> Value) -> (Int -> Integer) -> Int -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Int8      where toValue :: Int8 -> Value
toValue = Integer -> Value
Integer (Integer -> Value) -> (Int8 -> Integer) -> Int8 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Int16     where toValue :: Int16 -> Value
toValue = Integer -> Value
Integer (Integer -> Value) -> (Int16 -> Integer) -> Int16 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Int32     where toValue :: Int32 -> Value
toValue = Integer -> Value
Integer (Integer -> Value) -> (Int32 -> Integer) -> Int32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Int64     where toValue :: Int64 -> Value
toValue = Integer -> Value
Integer (Integer -> Value) -> (Int64 -> Integer) -> Int64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Word      where toValue :: Word -> Value
toValue = Integer -> Value
Integer (Integer -> Value) -> (Word -> Integer) -> Word -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Word8     where toValue :: Word8 -> Value
toValue = Integer -> Value
Integer (Integer -> Value) -> (Word8 -> Integer) -> Word8 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Word16    where toValue :: Word16 -> Value
toValue = Integer -> Value
Integer (Integer -> Value) -> (Word16 -> Integer) -> Word16 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Word32    where toValue :: Word32 -> Value
toValue = Integer -> Value
Integer (Integer -> Value) -> (Word32 -> Integer) -> Word32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance ToValue Word64    where toValue :: Word64 -> Value
toValue = Integer -> Value
Integer (Integer -> Value) -> (Word64 -> Integer) -> Word64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral