    {-|
    Module      : Toml.Schema.Generic.ToValue
    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.Schema.Generic.ToValue (

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

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

    import Data.Text (Text)
    import Data.Text qualified as Text
    import GHC.Generics
    import Toml.Semantics
    import Toml.Schema.ToValue (ToValue(..), table)

    -- | Use a record's field names to generate a 'Table'
    genericToTable :: (Generic a, GToTable (Rep a)) => a -> Table
    genericToTable :: forall a. (Generic a, GToTable (Rep a)) => a -> Table
    genericToTable a
    x = [(Text, Value)] -> Table
    table (Rep a (ZonkAny 1) -> [(Text, Value)] -> [(Text, Value)]
    forall a. Rep a a -> [(Text, Value)] -> [(Text, Value)]
    forall (f :: * -> *) a.
    GToTable f =>
    f a -> [(Text, Value)] -> [(Text, Value)]
    gToTable (a -> Rep a (ZonkAny 1)
    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'
    genericToArray :: (Generic a, GToArray (Rep a)) => a -> Value
    genericToArray :: forall a. (Generic a, GToArray (Rep a)) => a -> Value
    genericToArray a
    a = [Value] -> Value
    List (Rep a (ZonkAny 0) -> [Value] -> [Value]
    forall a. Rep a a -> [Value] -> [Value]
    forall (f :: * -> *) a. GToArray f => f a -> [Value] -> [Value]
    gToArray (a -> Rep a (ZonkAny 0)
    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.
    class GToTable f where
        gToTable :: f a -> [(Text, Value)] -> [(Text, Value)]

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

    instance (GToTable f, GToTable g) => GToTable (f :*: g) where
        gToTable :: forall a. (:*:) f g a -> [(Text, Value)] -> [(Text, Value)]
    gToTable (f a
    x :*: g a
    y) = f a -> [(Text, Value)] -> [(Text, Value)]
    forall a. f a -> [(Text, Value)] -> [(Text, Value)]
    forall (f :: * -> *) a.
    GToTable f =>
    f a -> [(Text, Value)] -> [(Text, Value)]
    gToTable f a
    x ([(Text, Value)] -> [(Text, Value)])
    -> ([(Text, Value)] -> [(Text, Value)])
    -> [(Text, Value)]
    -> [(Text, Value)]
    forall a. Semigroup a => a -> a -> a
    <> g a -> [(Text, Value)] -> [(Text, Value)]
    forall a. g a -> [(Text, Value)] -> [(Text, Value)]
    forall (f :: * -> *) a.
    GToTable f =>
    f a -> [(Text, Value)] -> [(Text, 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 -> [(Text, Value)] -> [(Text, Value)]
    gToTable (M1 (K1 Maybe a
    Nothing)) = [(Text, Value)] -> [(Text, Value)]
    forall a. a -> a
    id
        gToTable s :: M1 S s (K1 i (Maybe a)) a
    s@(M1 (K1 (Just a
    x))) = ((String -> Text
    Text.pack (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)(Text, Value) -> [(Text, Value)] -> [(Text, 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 -> [(Text, Value)] -> [(Text, Value)]
    gToTable s :: S1 s (K1 i a) a
    s@(M1 (K1 a
    x)) = ((String -> Text
    Text.pack (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)(Text, Value) -> [(Text, Value)] -> [(Text, Value)]
    forall a. a -> [a] -> [a]
    :)
        {-# INLINE gToTable #-}

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

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

    -- | Convert product types to arrays positionally.
    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 #-}