{-|
Module      : Toml.ToValue.Generic
Description : GHC.Generics derived table generation
Copyright   : (c) Eric Mertens, 2023
License     : ISC
Maintainer  : emertens@gmail.com

Use 'genericToTable' to derive an instance of 'Toml.ToValue.ToTable'
using the field names of a record.

Use 'genericToArray' to derive an instance of 'Toml.ToValue.ToValue'
using the positions of data in a constructor.

-}
module Toml.ToValue.Generic (

    -- * Records to Tables
    GToTable(..),
    genericToTable,

    -- * Product types to Arrays
    GToArray(..),
    genericToArray,
    ) where

import Data.Map qualified as Map
import GHC.Generics
import Toml.Value (Table, Value(Array))
import Toml.ToValue (ToValue(..))

-- | Use a record's field names to generate a 'Table'
--
-- @since 1.0.2.0
genericToTable :: (Generic a, GToTable (Rep a)) => a -> Table
genericToTable :: forall a. (Generic a, GToTable (Rep a)) => a -> Table
genericToTable a
x = [(String, Value)] -> Table
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (Rep a Any -> [(String, Value)] -> [(String, Value)]
forall a. Rep a a -> [(String, Value)] -> [(String, Value)]
forall (f :: * -> *) a.
GToTable f =>
f a -> [(String, Value)] -> [(String, Value)]
gToTable (a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
x) [])
{-# INLINE genericToTable #-}

-- | Use a record's field names to generate a 'Table'
--
-- @since 1.3.2.0
genericToArray :: (Generic a, GToArray (Rep a)) => a -> Value
genericToArray :: forall a. (Generic a, GToArray (Rep a)) => a -> Value
genericToArray a
a = [Value] -> Value
Array (Rep a Any -> [Value] -> [Value]
forall a. Rep a a -> [Value] -> [Value]
forall (f :: * -> *) a. GToArray f => f a -> [Value] -> [Value]
gToArray (a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
a) [])
{-# INLINE genericToArray #-}

-- | Supports conversion of product types with field selector names
-- to TOML values.
--
-- @since 1.0.2.0
class GToTable f where
    gToTable :: f a -> [(String, Value)] -> [(String, Value)]

-- | Ignores type constructor names
instance GToTable f => GToTable (D1 c f) where
    gToTable :: forall a. D1 c f a -> [(String, Value)] -> [(String, Value)]
gToTable (M1 f a
x) = f a -> [(String, Value)] -> [(String, Value)]
forall a. f a -> [(String, Value)] -> [(String, Value)]
forall (f :: * -> *) a.
GToTable f =>
f a -> [(String, Value)] -> [(String, Value)]
gToTable f a
x
    {-# INLINE gToTable #-}

-- | Ignores value constructor names
instance GToTable f => GToTable (C1 c f) where
    gToTable :: forall a. C1 c f a -> [(String, Value)] -> [(String, Value)]
gToTable (M1 f a
x) = f a -> [(String, Value)] -> [(String, Value)]
forall a. f a -> [(String, Value)] -> [(String, Value)]
forall (f :: * -> *) a.
GToTable f =>
f a -> [(String, Value)] -> [(String, Value)]
gToTable f a
x
    {-# INLINE gToTable #-}

instance (GToTable f, GToTable g) => GToTable (f :*: g) where
    gToTable :: forall a. (:*:) f g a -> [(String, Value)] -> [(String, Value)]
gToTable (f a
x :*: g a
y) = f a -> [(String, Value)] -> [(String, Value)]
forall a. f a -> [(String, Value)] -> [(String, Value)]
forall (f :: * -> *) a.
GToTable f =>
f a -> [(String, Value)] -> [(String, Value)]
gToTable f a
x ([(String, Value)] -> [(String, Value)])
-> ([(String, Value)] -> [(String, Value)])
-> [(String, Value)]
-> [(String, Value)]
forall a. Semigroup a => a -> a -> a
<> g a -> [(String, Value)] -> [(String, Value)]
forall a. g a -> [(String, Value)] -> [(String, Value)]
forall (f :: * -> *) a.
GToTable f =>
f a -> [(String, Value)] -> [(String, Value)]
gToTable g a
y
    {-# INLINE gToTable #-}

-- | Omits the key from the table on nothing, includes it on just
instance {-# OVERLAPS #-} (Selector s, ToValue a) => GToTable (S1 s (K1 i (Maybe a))) where
    gToTable :: forall a.
S1 s (K1 i (Maybe a)) a -> [(String, Value)] -> [(String, Value)]
gToTable (M1 (K1 Maybe a
Nothing)) = [(String, Value)] -> [(String, Value)]
forall a. a -> a
id
    gToTable s :: M1 S s (K1 i (Maybe a)) a
s@(M1 (K1 (Just a
x))) = ((M1 S s (K1 i (Maybe a)) a -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName M1 S s (K1 i (Maybe a)) a
s, a -> Value
forall a. ToValue a => a -> Value
toValue a
x)(String, Value) -> [(String, Value)] -> [(String, Value)]
forall a. a -> [a] -> [a]
:)
    {-# INLINE gToTable #-}

-- | Uses record selector name as table key
instance (Selector s, ToValue a) => GToTable (S1 s (K1 i a)) where
    gToTable :: forall a. S1 s (K1 i a) a -> [(String, Value)] -> [(String, Value)]
gToTable s :: S1 s (K1 i a) a
s@(M1 (K1 a
x)) = ((S1 s (K1 i a) a -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName S1 s (K1 i a) a
s, a -> Value
forall a. ToValue a => a -> Value
toValue a
x)(String, Value) -> [(String, Value)] -> [(String, Value)]
forall a. a -> [a] -> [a]
:)
    {-# INLINE gToTable #-}

-- | Emits empty table
instance GToTable U1 where
    gToTable :: forall a. U1 a -> [(String, Value)] -> [(String, Value)]
gToTable U1 a
_ = [(String, Value)] -> [(String, Value)]
forall a. a -> a
id
    {-# INLINE gToTable #-}

instance GToTable V1 where
    gToTable :: forall a. V1 a -> [(String, Value)] -> [(String, Value)]
gToTable V1 a
v = case V1 a
v of {}
    {-# INLINE gToTable #-}

-- | Convert product types to arrays positionally.
--
-- @since 1.3.2.0
class GToArray f where
    gToArray :: f a -> [Value] -> [Value]

-- | Ignore metadata
instance GToArray f => GToArray (M1 i c f) where
    gToArray :: forall a. M1 i c f a -> [Value] -> [Value]
gToArray (M1 f a
x) = f a -> [Value] -> [Value]
forall a. f a -> [Value] -> [Value]
forall (f :: * -> *) a. GToArray f => f a -> [Value] -> [Value]
gToArray f a
x
    {-# INLINE gToArray #-}

-- | Convert left and then right
instance (GToArray f, GToArray g) => GToArray (f :*: g) where
    gToArray :: forall a. (:*:) f g a -> [Value] -> [Value]
gToArray (f a
x :*: g a
y) = f a -> [Value] -> [Value]
forall a. f a -> [Value] -> [Value]
forall (f :: * -> *) a. GToArray f => f a -> [Value] -> [Value]
gToArray f a
x ([Value] -> [Value]) -> ([Value] -> [Value]) -> [Value] -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g a -> [Value] -> [Value]
forall a. g a -> [Value] -> [Value]
forall (f :: * -> *) a. GToArray f => f a -> [Value] -> [Value]
gToArray g a
y
    {-# INLINE gToArray #-}

-- | Convert fields using 'ToValue' instances
instance ToValue a => GToArray (K1 i a) where
    gToArray :: forall a. K1 i a a -> [Value] -> [Value]
gToArray (K1 a
x) = (a -> Value
forall a. ToValue a => a -> Value
toValue a
x Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
:)
    {-# INLINE gToArray #-}