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

Use 'genericFromTable' to derive an instance of 'Toml.FromValue.FromTable'
using the field names of a record.

-}
module Toml.FromValue.Generic (
    GParseTable(..),
    genericFromTable,
    ) where

import GHC.Generics
import Toml.FromValue (FromValue(..), ParseTable, optKey, reqKey, runParseTable)
import Toml.FromValue.Matcher (Matcher)
import Toml.Value (Table)

-- | Match a 'Table' using the field names in a record.
--
-- @since 1.0.2.0
genericFromTable :: (Generic a, GParseTable (Rep a)) => Table -> Matcher a
genericFromTable :: forall a. (Generic a, GParseTable (Rep a)) => Table -> Matcher a
genericFromTable = forall a. ParseTable a -> Table -> Matcher a
runParseTable (forall (f :: * -> *) a b.
GParseTable f =>
(f a -> ParseTable b) -> ParseTable b
gParseTable (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => Rep a x -> a
to))
{-# INLINE genericFromTable #-}

-- gParseTable is written in continuation passing style because
-- it allows all the GHC.Generics constructors to inline into
-- a single location which allows the optimizer to optimize them
-- complete away.

-- | Supports conversion of product types with field selector names to
-- TOML values.
--
-- @since 1.0.2.0
class GParseTable f where
    -- | Convert a value and apply the continuation to the result.
    gParseTable :: (f a -> ParseTable b) -> ParseTable b

-- | Ignores type constructor name
instance GParseTable f => GParseTable (D1 c f) where
    gParseTable :: forall a b. (D1 c f a -> ParseTable b) -> ParseTable b
gParseTable D1 c f a -> ParseTable b
f = forall (f :: * -> *) a b.
GParseTable f =>
(f a -> ParseTable b) -> ParseTable b
gParseTable (D1 c f a -> ParseTable b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1)
    {-# INLINE gParseTable #-}

-- | Ignores value constructor name
instance GParseTable f => GParseTable (C1 c f) where
    gParseTable :: forall a b. (C1 c f a -> ParseTable b) -> ParseTable b
gParseTable C1 c f a -> ParseTable b
f = forall (f :: * -> *) a b.
GParseTable f =>
(f a -> ParseTable b) -> ParseTable b
gParseTable (C1 c f a -> ParseTable b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1)
    {-# INLINE gParseTable #-}

instance (GParseTable f, GParseTable g) => GParseTable (f :*: g) where
    gParseTable :: forall a b. ((:*:) f g a -> ParseTable b) -> ParseTable b
gParseTable (:*:) f g a -> ParseTable b
f = forall (f :: * -> *) a b.
GParseTable f =>
(f a -> ParseTable b) -> ParseTable b
gParseTable \f a
x -> forall (f :: * -> *) a b.
GParseTable f =>
(f a -> ParseTable b) -> ParseTable b
gParseTable \g a
y -> (:*:) f g a -> ParseTable b
f (f a
x forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a
y)
    {-# INLINE gParseTable #-}

-- | Omits the key from the table on nothing, includes it on just
instance {-# OVERLAPS #-} (Selector s, FromValue a) => GParseTable (S1 s (K1 i (Maybe a))) where
    gParseTable :: forall a b.
(S1 s (K1 i (Maybe a)) a -> ParseTable b) -> ParseTable b
gParseTable S1 s (K1 i (Maybe a)) a -> ParseTable b
f = S1 s (K1 i (Maybe a)) a -> ParseTable b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). c -> K1 i c p
K1 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. FromValue a => String -> ParseTable (Maybe a)
optKey (forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 [] :: S1 s [] ()))
    {-# INLINE gParseTable #-}

-- | Uses record selector name as table key
instance (Selector s, FromValue a) => GParseTable (S1 s (K1 i a)) where
    gParseTable :: forall a b. (S1 s (K1 i a) a -> ParseTable b) -> ParseTable b
gParseTable S1 s (K1 i a) a -> ParseTable b
f = S1 s (K1 i a) a -> ParseTable b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). c -> K1 i c p
K1 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. FromValue a => String -> ParseTable a
reqKey (forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 [] :: S1 s [] ()))
    {-# INLINE gParseTable #-}

-- | Emits empty table
instance GParseTable U1 where
    gParseTable :: forall a b. (U1 a -> ParseTable b) -> ParseTable b
gParseTable U1 a -> ParseTable b
f = U1 a -> ParseTable b
f forall k (p :: k). U1 p
U1
    {-# INLINE gParseTable #-}