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

Use 'genericParseTable' to derive a 'ParseTable' using the field names
of a record. This can be combined with 'Toml.FromValue.parseTableFromValue'
to derive a 'Toml.FromValue.FromValue' instance.

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

import GHC.Generics
import Toml.FromValue.ParseTable (ParseTable)
import Toml.FromValue (FromValue, optKey, reqKey)

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

-- 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 = (f a -> ParseTable b) -> ParseTable b
forall a b. (f a -> ParseTable b) -> ParseTable b
forall (f :: * -> *) a b.
GParseTable f =>
(f a -> ParseTable b) -> ParseTable b
gParseTable (D1 c f a -> ParseTable b
f (D1 c f a -> ParseTable b)
-> (f a -> D1 c f a) -> f a -> ParseTable b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> D1 c f a
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 = (f a -> ParseTable b) -> ParseTable b
forall a b. (f a -> ParseTable b) -> ParseTable b
forall (f :: * -> *) a b.
GParseTable f =>
(f a -> ParseTable b) -> ParseTable b
gParseTable (C1 c f a -> ParseTable b
f (C1 c f a -> ParseTable b)
-> (f a -> C1 c f a) -> f a -> ParseTable b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> C1 c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1)
    {-# INLINE gParseTable #-}

-- | Matches left then right component
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 = (f a -> ParseTable b) -> ParseTable b
forall a b. (f a -> ParseTable b) -> ParseTable b
forall (f :: * -> *) a b.
GParseTable f =>
(f a -> ParseTable b) -> ParseTable b
gParseTable \f a
x -> (g a -> ParseTable b) -> ParseTable b
forall a b. (g a -> ParseTable b) -> ParseTable b
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 f a -> g a -> (:*:) f g a
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 (S1 s (K1 i (Maybe a)) a -> ParseTable b)
-> (Maybe a -> S1 s (K1 i (Maybe a)) a) -> Maybe a -> ParseTable b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 i (Maybe a) a -> S1 s (K1 i (Maybe a)) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i (Maybe a) a -> S1 s (K1 i (Maybe a)) a)
-> (Maybe a -> K1 i (Maybe a) a)
-> Maybe a
-> S1 s (K1 i (Maybe a)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> K1 i (Maybe a) a
forall k i c (p :: k). c -> K1 i c p
K1 (Maybe a -> ParseTable b) -> ParseTable (Maybe a) -> ParseTable b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> ParseTable (Maybe a)
forall a. FromValue a => String -> ParseTable (Maybe a)
optKey (M1 S s [] () -> 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 [] ()
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 (S1 s (K1 i a) a -> ParseTable b)
-> (a -> S1 s (K1 i a) a) -> a -> ParseTable b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 i a a -> S1 s (K1 i a) a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i a a -> S1 s (K1 i a) a)
-> (a -> K1 i a a) -> a -> S1 s (K1 i a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> ParseTable b) -> ParseTable a -> ParseTable b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> ParseTable a
forall a. FromValue a => String -> ParseTable a
reqKey (M1 S s [] () -> 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 [] ()
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 U1 a
forall k (p :: k). U1 p
U1
    {-# INLINE gParseTable #-}