{-# LANGUAGE FlexibleInstances, UndecidableInstances, ScopedTypeVariables, InstanceSigs #-}
{-|
Module      : Toml.Schema.Generic
Description : Integration with DerivingVia extension
Copyright   : (c) Eric Mertens, 2024
License     : ISC
Maintainer  : emertens@gmail.com

This module makes it possible to easily derive the TOML classes
using the @DerivingVia@ extension.

For example:

@
data Physical = Physical {
    color :: String,
    shape :: String
    }
    deriving (Eq, Show, Generic)
    deriving (ToTable, ToValue, FromValue) via GenericTomlTable Physical
@

These derived instances would allow you to match TOML
@{color="red", shape="round"}@ to value @Physical "red" "round"@.

@
data Coord = Coord Int Int
    deriving (Eq, Show, Generic)
    deriving (ToValue, FromValue) via GenericTomlArray Physical
@

These derived instances would allow you to match TOML @[1,2]@ to value @Coord 1 2@.

-}
module Toml.Schema.Generic (
    -- * DerivingVia
    GenericTomlTable(GenericTomlTable),
    GenericTomlArray(GenericTomlArray),

    -- * FromValue
    genericFromArray,
    genericFromTable,
    GFromArray,
    GParseTable,

    -- * ToValue
    genericToArray,
    genericToTable,
    GToArray,
    GToTable,
    ) where

import Data.Coerce (coerce)
import GHC.Generics (Generic(Rep))
import Toml.Schema.FromValue
import Toml.Schema.Matcher
import Toml.Schema.Generic.FromValue
import Toml.Schema.Generic.ToValue (GToTable, GToArray, genericToTable, genericToArray)
import Toml.Schema.ToValue (ToTable(toTable), ToValue(toValue), defaultTableToValue)
import Toml.Semantics (Value, Value', Table)

-- | Helper type to use GHC's DerivingVia extension to derive
-- 'ToValue', 'ToTable', 'FromValue' for records.
newtype GenericTomlTable a = GenericTomlTable a

-- | Instance derived from 'ToTable' instance using 'defaultTableToValue'
instance (Generic a, GToTable (Rep a)) => ToValue (GenericTomlTable a) where
    toValue :: GenericTomlTable a -> Value
toValue = GenericTomlTable a -> Value
forall a. ToTable a => a -> Value
defaultTableToValue
    {-# INLINE toValue #-}

-- | Instance derived using 'genericToTable'
instance (Generic a, GToTable (Rep a)) => ToTable (GenericTomlTable a) where
    toTable :: GenericTomlTable a -> Table
toTable = (a -> Table) -> GenericTomlTable a -> Table
forall a b. Coercible a b => a -> b
coerce (a -> Table
forall a. (Generic a, GToTable (Rep a)) => a -> Table
genericToTable :: a -> Table)
    {-# INLINE toTable #-}

-- | Instance derived using 'genericParseTable'
instance (Generic a, GParseTable (Rep a)) => FromValue (GenericTomlTable a) where
    fromValue :: forall l. Value' l -> Matcher l (GenericTomlTable a)
    fromValue :: forall l. Value' l -> Matcher l (GenericTomlTable a)
fromValue = (Value' l -> Matcher l a)
-> Value' l -> Matcher l (GenericTomlTable a)
forall a b. Coercible a b => a -> b
coerce (ParseTable l a -> Value' l -> Matcher l a
forall l a. ParseTable l a -> Value' l -> Matcher l a
parseTableFromValue ParseTable l a
forall a l. (Generic a, GParseTable (Rep a)) => ParseTable l a
genericParseTable :: Value' l -> Matcher l a)
    {-# INLINE fromValue #-}

-- | Helper type to use GHC's DerivingVia extension to derive
-- 'ToValue', 'ToTable', 'FromValue' for any product type.
newtype GenericTomlArray a = GenericTomlArray a

-- | Instance derived using 'genericToArray'
instance (Generic a, GToArray (Rep a)) => ToValue (GenericTomlArray a) where
    toValue :: GenericTomlArray a -> Value
toValue = (a -> Value) -> GenericTomlArray a -> Value
forall a b. Coercible a b => a -> b
coerce (a -> Value
forall a. (Generic a, GToArray (Rep a)) => a -> Value
genericToArray :: a -> Value)
    {-# INLINE toValue #-}

-- | Instance derived using 'genericFromArray'
instance (Generic a, GFromArray (Rep a)) => FromValue (GenericTomlArray a) where
    fromValue :: forall l. Value' l -> Matcher l (GenericTomlArray a)
    fromValue :: forall l. Value' l -> Matcher l (GenericTomlArray a)
fromValue = (Value' l -> Matcher l a)
-> Value' l -> Matcher l (GenericTomlArray a)
forall a b. Coercible a b => a -> b
coerce (Value' l -> Matcher l a
forall a l.
(Generic a, GFromArray (Rep a)) =>
Value' l -> Matcher l a
genericFromArray :: Value' l -> Matcher l a)
    {-# INLINE fromValue #-}