{-# LANGUAGE AllowAmbiguousTypes  #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE PolyKinds            #-}
{-# LANGUAGE Rank2Types           #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}

{- |
Copyright: (c) 2018-2019 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

This module contains implementation of the 'Generic' TOML codec. If your
data types are big and nested, and you want to have codecs for them without writing a lot of
boilerplate code, you can find this module helpful. Below you can find the detailed
explanation on how the 'Generic' codecs work.

Consider the following Haskell data types:

@
__data__ User = User
    { age     :: Int
    , address :: Address
    , socials :: [Social]
    } __deriving__ ('Generic')

__data__ Address = Address
    { street :: Text
    , house  :: Int
    } __deriving__ ('Generic')

__data__ Social = Social
    { name :: Text
    , link :: Text
    } __deriving__ ('Generic')
@

Value of the @User@ type represents the following TOML:

@
age = 27

[address]
  street = "Miami Beach"
  house  = 42

[[socials]]
  name = \"Twitter\"
  link = "https://twitter.com/foo"

[[socials]]
  name = \"GitHub\"
  link = "https://github.com/bar"
@

Normally you would write 'TomlCodec' for this data type like this:

@
userCodec :: 'TomlCodec' User
userCodec = User
    \<$\> Toml.int "age" .= age
    \<*\> Toml.table addressCodec "address" .= address
    \<*\> Toml.list  socialCodec  "socials" .= socials

addressCodec :: 'TomlCodec' Address
addressCodec = Address
    \<$\> Toml.text "street" .= street
    \<*\> Toml.int  "house"  .= house

socialCodec :: 'TomlCodec' Social
socialCodec = Social
    \<$\> Toml.text "name" .= name
    \<*\> Toml.text "link" .= link
@

However, if you derive 'Generic' instance for your data types (as we do in the
example), you can write your codecs in a simpler way.

@
userCodec :: 'TomlCodec' User
userCodec = 'genericCodec'

__instance__ 'HasCodec' Address __where__
    hasCodec = Toml.table 'genericCodec'

__instance__ 'HasItemCodec' Social __where__
    hasItemCodec = Right 'genericCodec'
@

Several notes about the interface:

1. Your top-level data types are always implemented as 'genericCodec' (or other
generic codecs).
2. If you have a custom data type as a field of another type, you need to implement
the instance of the 'HasCodec' typeclass.
3. If the data type appears as an element of a list, you need to implement the instance
of the 'HasItemCodec' typeclass.

@since 1.1.1.0
-}

module Toml.Generic
       ( genericCodec
       , genericCodecWithOptions
       , stripTypeNameCodec

         -- * Options
       , TomlOptions (..)
       , GenericOptions (..)
       , stripTypeNameOptions
       , stripTypeNamePrefix

         -- * Core generic typeclass
       , HasCodec (..)
       , HasItemCodec (..)
       , GenericCodec (..)
       ) where

import Data.Char (isLower, toLower)
import Data.Hashable (Hashable)
import Data.HashSet (HashSet)
import Data.IntSet (IntSet)
import Data.Kind (Type)
import Data.List (stripPrefix)
import Data.List.NonEmpty (NonEmpty)
import Data.Proxy (Proxy (..))
import Data.Set (Set)
import Data.String (IsString (..))
import Data.Text (Text)
import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime)
import Data.Typeable (Typeable, typeRep)
import Data.Word (Word8)
import GHC.Generics ((:*:) (..), (:+:), C1, D1, Generic (..), K1 (..), M1 (..), Rec0, S1,
                     Selector (..))
import GHC.TypeLits (ErrorMessage (..), TypeError)
import Numeric.Natural (Natural)

import Toml.Bi (TomlBiMap, TomlCodec, (.=))
import Toml.PrefixTree (Key)
import Toml.Type (AnyValue)

import qualified Data.Text.Lazy as L
import qualified Toml.Bi as Toml


{- | Generic codec for arbitrary data types. Uses field names as keys.
-}
genericCodec :: (Generic a, GenericCodec (Rep a)) => TomlCodec a
genericCodec :: TomlCodec a
genericCodec = (a -> Rep a Any)
-> (Rep a Any -> a)
-> Codec Env St (Rep a Any) (Rep a Any)
-> TomlCodec a
forall (r :: * -> *) (w :: * -> *) c d a b.
(Functor r, Functor w) =>
(c -> d) -> (a -> b) -> Codec r w d a -> Codec r w c b
Toml.dimap a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Codec Env St (Rep a Any) (Rep a Any) -> TomlCodec a)
-> Codec Env St (Rep a Any) (Rep a Any) -> TomlCodec a
forall a b. (a -> b) -> a -> b
$ GenericOptions -> Codec Env St (Rep a Any) (Rep a Any)
forall k (f :: k -> *) (p :: k).
GenericCodec f =>
GenericOptions -> TomlCodec (f p)
genericTomlCodec ((String -> String) -> GenericOptions
GenericOptions String -> String
forall a. a -> a
id)
{-# INLINE genericCodec #-}

{- | Generic codec with options for arbitrary data types.
-}
genericCodecWithOptions
    :: forall a
     . (Generic a, GenericCodec (Rep a), Typeable a)
    => TomlOptions a
    -> TomlCodec a
genericCodecWithOptions :: TomlOptions a -> TomlCodec a
genericCodecWithOptions = (a -> Rep a Any)
-> (Rep a Any -> a)
-> Codec Env St (Rep a Any) (Rep a Any)
-> TomlCodec a
forall (r :: * -> *) (w :: * -> *) c d a b.
(Functor r, Functor w) =>
(c -> d) -> (a -> b) -> Codec r w d a -> Codec r w c b
Toml.dimap a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Codec Env St (Rep a Any) (Rep a Any) -> TomlCodec a)
-> (TomlOptions a -> Codec Env St (Rep a Any) (Rep a Any))
-> TomlOptions a
-> TomlCodec a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericOptions -> Codec Env St (Rep a Any) (Rep a Any)
forall k (f :: k -> *) (p :: k).
GenericCodec f =>
GenericOptions -> TomlCodec (f p)
genericTomlCodec (GenericOptions -> Codec Env St (Rep a Any) (Rep a Any))
-> (TomlOptions a -> GenericOptions)
-> TomlOptions a
-> Codec Env St (Rep a Any) (Rep a Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Typeable a => TomlOptions a -> GenericOptions
forall k (a :: k). Typeable a => TomlOptions a -> GenericOptions
toGenericOptions @a
{-# INLINE genericCodecWithOptions #-}

{- | Generic codec that uses 'stripTypeNameOptions'.
-}
stripTypeNameCodec
    :: forall a
     . (Generic a, GenericCodec (Rep a), Typeable a)
    => TomlCodec a
stripTypeNameCodec :: TomlCodec a
stripTypeNameCodec = TomlOptions a -> TomlCodec a
forall a.
(Generic a, GenericCodec (Rep a), Typeable a) =>
TomlOptions a -> TomlCodec a
genericCodecWithOptions (TomlOptions a -> TomlCodec a) -> TomlOptions a -> TomlCodec a
forall a b. (a -> b) -> a -> b
$ Typeable a => TomlOptions a
forall k (a :: k). Typeable a => TomlOptions a
stripTypeNameOptions @a
{-# INLINE stripTypeNameCodec #-}

----------------------------------------------------------------------------
-- Generic typeclasses
----------------------------------------------------------------------------

{- | Options to configure various parameters of generic encoding. Specifically:

*  __'tomlOptionsFieldModifier'__: how to translate field names to TOML keys?
-}
data TomlOptions a = TomlOptions
    { TomlOptions a -> Typeable a => Proxy a -> String -> String
tomlOptionsFieldModifier :: Typeable a => Proxy a -> String -> String
    }

{- | Same as 'TomlOptions' but with all data type information erased. This data
type is used internally. Define your options using 'TomlOptions' data type.
-}
newtype GenericOptions = GenericOptions
    { GenericOptions -> String -> String
genericOptionsFieldModifier :: String -> String
    }

toGenericOptions :: forall a . Typeable a => TomlOptions a -> GenericOptions
toGenericOptions :: TomlOptions a -> GenericOptions
toGenericOptions TomlOptions{..} = GenericOptions :: (String -> String) -> GenericOptions
GenericOptions
    { genericOptionsFieldModifier :: String -> String
genericOptionsFieldModifier = Typeable a => Proxy a -> String -> String
Proxy a -> String -> String
tomlOptionsFieldModifier (Proxy a
forall k (t :: k). Proxy t
Proxy @a)
    }

-- | Options that use 'stripTypeNamePrefix' as 'tomlOptionsFieldModifier'.
stripTypeNameOptions :: Typeable a => TomlOptions a
stripTypeNameOptions :: TomlOptions a
stripTypeNameOptions = TomlOptions :: forall k (a :: k).
(Typeable a => Proxy a -> String -> String) -> TomlOptions a
TomlOptions
    { tomlOptionsFieldModifier :: Typeable a => Proxy a -> String -> String
tomlOptionsFieldModifier = Typeable a => Proxy a -> String -> String
forall k (a :: k). Typeable a => Proxy a -> String -> String
stripTypeNamePrefix
    }

{- | Strips name of the type name from field name prefix.

>>> data UserData = UserData { userDataId :: Int, userDataShortInfo :: Text }
>>> stripTypeNamePrefix (Proxy @UserData) "userDataId"
"id"
>>> stripTypeNamePrefix (Proxy @UserData) "userDataShortInfo"
"shortInfo"
>>> stripTypeNamePrefix (Proxy @UserData) "udStats"
"stats"
>>> stripTypeNamePrefix (Proxy @UserData) "fooBar"
"bar"
>>> stripTypeNamePrefix (Proxy @UserData) "name"
"name"
-}
stripTypeNamePrefix :: forall a . Typeable a => Proxy a -> String -> String
stripTypeNamePrefix :: Proxy a -> String -> String
stripTypeNamePrefix _ fieldName :: String
fieldName =
    case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (String -> String
headToLower (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Typeable a => String
forall k (a :: k). Typeable a => String
typeName @a) String
fieldName of
        Just rest :: String
rest -> String -> String
leaveIfEmpty String
rest
        Nothing   -> String -> String
leaveIfEmpty ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isLower String
fieldName)
  where
    headToLower :: String -> String
    headToLower :: String -> String
headToLower = \case
        []   -> String -> String
forall a. HasCallStack => String -> a
error "Cannot use 'headToLower' on empty Text"
        x :: Char
x:xs :: String
xs -> Char -> Char
toLower Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs

    -- if all lower case then leave field as it is
    leaveIfEmpty :: String -> String
    leaveIfEmpty :: String -> String
leaveIfEmpty rest :: String
rest = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest then String
fieldName else String -> String
headToLower String
rest

typeName :: forall a . Typeable a => String
typeName :: String
typeName = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy @a)

----------------------------------------------------------------------------
-- Generic typeclasses
----------------------------------------------------------------------------

{- | Helper class to derive TOML codecs generically.
-}
class GenericCodec (f :: k -> Type) where
    genericTomlCodec :: GenericOptions -> TomlCodec (f p)

instance GenericCodec f => GenericCodec (D1 d f) where
    genericTomlCodec :: GenericOptions -> TomlCodec (D1 d f p)
genericTomlCodec = (D1 d f p -> f p)
-> (f p -> D1 d f p)
-> Codec Env St (f p) (f p)
-> TomlCodec (D1 d f p)
forall (r :: * -> *) (w :: * -> *) c d a b.
(Functor r, Functor w) =>
(c -> d) -> (a -> b) -> Codec r w d a -> Codec r w c b
Toml.dimap D1 d f p -> f p
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 f p -> D1 d f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Codec Env St (f p) (f p) -> TomlCodec (D1 d f p))
-> (GenericOptions -> Codec Env St (f p) (f p))
-> GenericOptions
-> TomlCodec (D1 d f p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericOptions -> Codec Env St (f p) (f p)
forall k (f :: k -> *) (p :: k).
GenericCodec f =>
GenericOptions -> TomlCodec (f p)
genericTomlCodec
    {-# INLINE genericTomlCodec #-}

type GenericSumTomlNotSupported =
    'Text "Generic TOML deriving for arbitrary sum types is not supported currently."

instance (TypeError GenericSumTomlNotSupported) => GenericCodec (f :+: g) where
    genericTomlCodec :: GenericOptions -> TomlCodec ((:+:) f g p)
genericTomlCodec = String -> GenericOptions -> TomlCodec ((:+:) f g p)
forall a. HasCallStack => String -> a
error "Not supported"

instance GenericCodec f => GenericCodec (C1 c f) where
    genericTomlCodec :: GenericOptions -> TomlCodec (C1 c f p)
genericTomlCodec = (C1 c f p -> f p)
-> (f p -> C1 c f p)
-> Codec Env St (f p) (f p)
-> TomlCodec (C1 c f p)
forall (r :: * -> *) (w :: * -> *) c d a b.
(Functor r, Functor w) =>
(c -> d) -> (a -> b) -> Codec r w d a -> Codec r w c b
Toml.dimap C1 c f p -> f p
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 f p -> C1 c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Codec Env St (f p) (f p) -> TomlCodec (C1 c f p))
-> (GenericOptions -> Codec Env St (f p) (f p))
-> GenericOptions
-> TomlCodec (C1 c f p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericOptions -> Codec Env St (f p) (f p)
forall k (f :: k -> *) (p :: k).
GenericCodec f =>
GenericOptions -> TomlCodec (f p)
genericTomlCodec
    {-# INLINE genericTomlCodec #-}

instance (GenericCodec f, GenericCodec g) => GenericCodec (f :*: g) where
    genericTomlCodec :: GenericOptions -> TomlCodec ((:*:) f g p)
genericTomlCodec options :: GenericOptions
options = f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:)
        (f p -> g p -> (:*:) f g p)
-> Codec Env St ((:*:) f g p) (f p)
-> Codec Env St ((:*:) f g p) (g p -> (:*:) f g p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericOptions -> TomlCodec (f p)
forall k (f :: k -> *) (p :: k).
GenericCodec f =>
GenericOptions -> TomlCodec (f p)
genericTomlCodec GenericOptions
options TomlCodec (f p)
-> ((:*:) f g p -> f p) -> Codec Env St ((:*:) f g p) (f p)
forall (r :: * -> *) (w :: * -> *) field a object.
Codec r w field a -> (object -> field) -> Codec r w object a
.= (:*:) f g p -> f p
forall (p :: k). (:*:) f g p -> f p
fstG
        Codec Env St ((:*:) f g p) (g p -> (:*:) f g p)
-> Codec Env St ((:*:) f g p) (g p) -> TomlCodec ((:*:) f g p)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenericOptions -> TomlCodec (g p)
forall k (f :: k -> *) (p :: k).
GenericCodec f =>
GenericOptions -> TomlCodec (f p)
genericTomlCodec GenericOptions
options TomlCodec (g p)
-> ((:*:) f g p -> g p) -> Codec Env St ((:*:) f g p) (g p)
forall (r :: * -> *) (w :: * -> *) field a object.
Codec r w field a -> (object -> field) -> Codec r w object a
.= (:*:) f g p -> g p
forall (p :: k). (:*:) f g p -> g p
sndG
      where
        fstG :: (f :*: g) p -> f p
        fstG :: (:*:) f g p -> f p
fstG (f :: f p
f :*: _) = f p
f

        sndG :: (f :*: g) p -> g p
        sndG :: (:*:) f g p -> g p
sndG (_ :*: g :: g p
g) = g p
g
    {-# INLINE genericTomlCodec #-}

instance (Selector s, HasCodec a) => GenericCodec (S1 s (Rec0 a)) where
    genericTomlCodec :: GenericOptions -> TomlCodec (S1 s (Rec0 a) p)
genericTomlCodec GenericOptions{..} = TomlCodec a -> TomlCodec (S1 s (Rec0 a) p)
forall k (p :: k). TomlCodec a -> TomlCodec (S1 s (Rec0 a) p)
genericWrap (TomlCodec a -> TomlCodec (S1 s (Rec0 a) p))
-> TomlCodec a -> TomlCodec (S1 s (Rec0 a) p)
forall a b. (a -> b) -> a -> b
$ Key -> TomlCodec a
forall a. HasCodec a => Key -> TomlCodec a
hasCodec @a Key
fieldName
      where
        genericWrap :: TomlCodec a -> TomlCodec (S1 s (Rec0 a) p)
        genericWrap :: TomlCodec a -> TomlCodec (S1 s (Rec0 a) p)
genericWrap = (S1 s (Rec0 a) p -> a)
-> (a -> S1 s (Rec0 a) p)
-> TomlCodec a
-> TomlCodec (S1 s (Rec0 a) p)
forall (r :: * -> *) (w :: * -> *) c d a b.
(Functor r, Functor w) =>
(c -> d) -> (a -> b) -> Codec r w d a -> Codec r w c b
Toml.dimap (K1 R a p -> a
forall i c k (p :: k). K1 i c p -> c
unK1 (K1 R a p -> a)
-> (S1 s (Rec0 a) p -> K1 R a p) -> S1 s (Rec0 a) p -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S1 s (Rec0 a) p -> K1 R a p
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1) (K1 R a p -> S1 s (Rec0 a) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R a p -> S1 s (Rec0 a) p)
-> (a -> K1 R a p) -> a -> S1 s (Rec0 a) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> K1 R a p
forall k i c (p :: k). c -> K1 i c p
K1)

        fieldName :: Key
        fieldName :: Key
fieldName =
            String -> Key
forall a. IsString a => String -> a
fromString
            (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ String -> String
genericOptionsFieldModifier
            (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ M1 S s Proxy () -> String
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
selName (String -> M1 S s Proxy ()
forall a. HasCallStack => String -> a
error "S1" :: S1 s Proxy ())
    {-# INLINE genericTomlCodec #-}

----------------------------------------------------------------------------
-- Helper typeclasses
----------------------------------------------------------------------------

{- | This typeclass tells how the data type should be coded as an item of a
list. Lists in TOML can have two types: __primitive__ and __table of arrays__.

* If 'hasItemCodec' returns 'Left': __primitive__ arrays codec is used.
* If 'hasItemCodec' returns 'Right:' __table of arrays__ codec is used.
-}
class HasItemCodec a where
    hasItemCodec :: Either (TomlBiMap a AnyValue) (TomlCodec a)

instance HasItemCodec Bool      where hasItemCodec :: Either (TomlBiMap Bool AnyValue) (TomlCodec Bool)
hasItemCodec = TomlBiMap Bool AnyValue
-> Either (TomlBiMap Bool AnyValue) (TomlCodec Bool)
forall a b. a -> Either a b
Left TomlBiMap Bool AnyValue
Toml._Bool
instance HasItemCodec Int       where hasItemCodec :: Either (TomlBiMap Int AnyValue) (TomlCodec Int)
hasItemCodec = TomlBiMap Int AnyValue
-> Either (TomlBiMap Int AnyValue) (TomlCodec Int)
forall a b. a -> Either a b
Left TomlBiMap Int AnyValue
Toml._Int
instance HasItemCodec Word      where hasItemCodec :: Either (TomlBiMap Word AnyValue) (TomlCodec Word)
hasItemCodec = TomlBiMap Word AnyValue
-> Either (TomlBiMap Word AnyValue) (TomlCodec Word)
forall a b. a -> Either a b
Left TomlBiMap Word AnyValue
Toml._Word
-- | @since 1.2.0.0
instance HasItemCodec Word8     where hasItemCodec :: Either (TomlBiMap Word8 AnyValue) (TomlCodec Word8)
hasItemCodec = TomlBiMap Word8 AnyValue
-> Either (TomlBiMap Word8 AnyValue) (TomlCodec Word8)
forall a b. a -> Either a b
Left TomlBiMap Word8 AnyValue
Toml._Word8
instance HasItemCodec Integer   where hasItemCodec :: Either (TomlBiMap Integer AnyValue) (TomlCodec Integer)
hasItemCodec = TomlBiMap Integer AnyValue
-> Either (TomlBiMap Integer AnyValue) (TomlCodec Integer)
forall a b. a -> Either a b
Left TomlBiMap Integer AnyValue
Toml._Integer
instance HasItemCodec Natural   where hasItemCodec :: Either (TomlBiMap Natural AnyValue) (TomlCodec Natural)
hasItemCodec = TomlBiMap Natural AnyValue
-> Either (TomlBiMap Natural AnyValue) (TomlCodec Natural)
forall a b. a -> Either a b
Left TomlBiMap Natural AnyValue
Toml._Natural
instance HasItemCodec Double    where hasItemCodec :: Either (TomlBiMap Double AnyValue) (TomlCodec Double)
hasItemCodec = TomlBiMap Double AnyValue
-> Either (TomlBiMap Double AnyValue) (TomlCodec Double)
forall a b. a -> Either a b
Left TomlBiMap Double AnyValue
Toml._Double
instance HasItemCodec Float     where hasItemCodec :: Either (TomlBiMap Float AnyValue) (TomlCodec Float)
hasItemCodec = TomlBiMap Float AnyValue
-> Either (TomlBiMap Float AnyValue) (TomlCodec Float)
forall a b. a -> Either a b
Left TomlBiMap Float AnyValue
Toml._Float
instance HasItemCodec Text      where hasItemCodec :: Either (TomlBiMap Text AnyValue) (TomlCodec Text)
hasItemCodec = TomlBiMap Text AnyValue
-> Either (TomlBiMap Text AnyValue) (TomlCodec Text)
forall a b. a -> Either a b
Left TomlBiMap Text AnyValue
Toml._Text
instance HasItemCodec L.Text    where hasItemCodec :: Either (TomlBiMap Text AnyValue) (TomlCodec Text)
hasItemCodec = TomlBiMap Text AnyValue
-> Either (TomlBiMap Text AnyValue) (TomlCodec Text)
forall a b. a -> Either a b
Left TomlBiMap Text AnyValue
Toml._LText
instance HasItemCodec ZonedTime where hasItemCodec :: Either (TomlBiMap ZonedTime AnyValue) (TomlCodec ZonedTime)
hasItemCodec = TomlBiMap ZonedTime AnyValue
-> Either (TomlBiMap ZonedTime AnyValue) (TomlCodec ZonedTime)
forall a b. a -> Either a b
Left TomlBiMap ZonedTime AnyValue
Toml._ZonedTime
instance HasItemCodec LocalTime where hasItemCodec :: Either (TomlBiMap LocalTime AnyValue) (TomlCodec LocalTime)
hasItemCodec = TomlBiMap LocalTime AnyValue
-> Either (TomlBiMap LocalTime AnyValue) (TomlCodec LocalTime)
forall a b. a -> Either a b
Left TomlBiMap LocalTime AnyValue
Toml._LocalTime
instance HasItemCodec Day       where hasItemCodec :: Either (TomlBiMap Day AnyValue) (TomlCodec Day)
hasItemCodec = TomlBiMap Day AnyValue
-> Either (TomlBiMap Day AnyValue) (TomlCodec Day)
forall a b. a -> Either a b
Left TomlBiMap Day AnyValue
Toml._Day
instance HasItemCodec TimeOfDay where hasItemCodec :: Either (TomlBiMap TimeOfDay AnyValue) (TomlCodec TimeOfDay)
hasItemCodec = TomlBiMap TimeOfDay AnyValue
-> Either (TomlBiMap TimeOfDay AnyValue) (TomlCodec TimeOfDay)
forall a b. a -> Either a b
Left TomlBiMap TimeOfDay AnyValue
Toml._TimeOfDay
instance HasItemCodec IntSet    where hasItemCodec :: Either (TomlBiMap IntSet AnyValue) (TomlCodec IntSet)
hasItemCodec = TomlBiMap IntSet AnyValue
-> Either (TomlBiMap IntSet AnyValue) (TomlCodec IntSet)
forall a b. a -> Either a b
Left TomlBiMap IntSet AnyValue
Toml._IntSet

{- | If data type @a@ is not primitive then this instance returns codec for list
under key equal to @a@ type name.
-}
instance (HasItemCodec a, Typeable a) => HasItemCodec [a] where
    hasItemCodec :: Either (TomlBiMap [a] AnyValue) (TomlCodec [a])
hasItemCodec = case HasItemCodec a => Either (TomlBiMap a AnyValue) (TomlCodec a)
forall a.
HasItemCodec a =>
Either (TomlBiMap a AnyValue) (TomlCodec a)
hasItemCodec @a of
        Left prim :: TomlBiMap a AnyValue
prim   -> TomlBiMap [a] AnyValue
-> Either (TomlBiMap [a] AnyValue) (TomlCodec [a])
forall a b. a -> Either a b
Left (TomlBiMap [a] AnyValue
 -> Either (TomlBiMap [a] AnyValue) (TomlCodec [a]))
-> TomlBiMap [a] AnyValue
-> Either (TomlBiMap [a] AnyValue) (TomlCodec [a])
forall a b. (a -> b) -> a -> b
$ TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue
forall a. TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue
Toml._Array TomlBiMap a AnyValue
prim
        Right codec :: TomlCodec a
codec -> TomlCodec [a] -> Either (TomlBiMap [a] AnyValue) (TomlCodec [a])
forall a b. b -> Either a b
Right (TomlCodec [a] -> Either (TomlBiMap [a] AnyValue) (TomlCodec [a]))
-> TomlCodec [a] -> Either (TomlBiMap [a] AnyValue) (TomlCodec [a])
forall a b. (a -> b) -> a -> b
$ TomlCodec a -> Key -> TomlCodec [a]
forall a. TomlCodec a -> Key -> TomlCodec [a]
Toml.list TomlCodec a
codec (String -> Key
forall a. IsString a => String -> a
fromString (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ Typeable a => String
forall k (a :: k). Typeable a => String
typeName @a)

{- | Helper typeclass for generic deriving. This instance tells how the data
type should be coded if it's a field of another data type.

__NOTE:__ If you implement TOML codecs for your data types manually, prefer more
explicit @Toml.int@ or @Toml.text@ instead of implicit @Toml.hasCodec@.
Implement instances of this typeclass only when using 'genericCodec' and when
your custom data types are not covered here.
-}
class HasCodec a where
    hasCodec :: Key -> TomlCodec a

instance HasCodec Bool      where hasCodec :: Key -> TomlCodec Bool
hasCodec = Key -> TomlCodec Bool
Toml.bool
instance HasCodec Int       where hasCodec :: Key -> TomlCodec Int
hasCodec = Key -> TomlCodec Int
Toml.int
instance HasCodec Word      where hasCodec :: Key -> TomlCodec Word
hasCodec = Key -> TomlCodec Word
Toml.word
-- | @since 1.2.0.0
instance HasCodec Word8     where hasCodec :: Key -> TomlCodec Word8
hasCodec = Key -> TomlCodec Word8
Toml.word8
instance HasCodec Integer   where hasCodec :: Key -> TomlCodec Integer
hasCodec = Key -> TomlCodec Integer
Toml.integer
instance HasCodec Natural   where hasCodec :: Key -> TomlCodec Natural
hasCodec = Key -> TomlCodec Natural
Toml.natural
instance HasCodec Double    where hasCodec :: Key -> TomlCodec Double
hasCodec = Key -> TomlCodec Double
Toml.double
instance HasCodec Float     where hasCodec :: Key -> TomlCodec Float
hasCodec = Key -> TomlCodec Float
Toml.float
instance HasCodec Text      where hasCodec :: Key -> TomlCodec Text
hasCodec = Key -> TomlCodec Text
Toml.text
instance HasCodec L.Text    where hasCodec :: Key -> TomlCodec Text
hasCodec = Key -> TomlCodec Text
Toml.lazyText
instance HasCodec ZonedTime where hasCodec :: Key -> TomlCodec ZonedTime
hasCodec = Key -> TomlCodec ZonedTime
Toml.zonedTime
instance HasCodec LocalTime where hasCodec :: Key -> TomlCodec LocalTime
hasCodec = Key -> TomlCodec LocalTime
Toml.localTime
instance HasCodec Day       where hasCodec :: Key -> TomlCodec Day
hasCodec = Key -> TomlCodec Day
Toml.day
instance HasCodec TimeOfDay where hasCodec :: Key -> TomlCodec TimeOfDay
hasCodec = Key -> TomlCodec TimeOfDay
Toml.timeOfDay
instance HasCodec IntSet    where hasCodec :: Key -> TomlCodec IntSet
hasCodec = Key -> TomlCodec IntSet
Toml.arrayIntSet

instance HasCodec a => HasCodec (Maybe a) where
    hasCodec :: Key -> TomlCodec (Maybe a)
hasCodec = Codec Env St a a -> TomlCodec (Maybe a)
forall (r :: * -> *) (w :: * -> *) c a.
(Alternative r, Applicative w) =>
Codec r w c a -> Codec r w (Maybe c) (Maybe a)
Toml.dioptional (Codec Env St a a -> TomlCodec (Maybe a))
-> (Key -> Codec Env St a a) -> Key -> TomlCodec (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCodec a => Key -> Codec Env St a a
forall a. HasCodec a => Key -> TomlCodec a
hasCodec @a

instance HasItemCodec a => HasCodec [a] where
    hasCodec :: Key -> TomlCodec [a]
hasCodec = case HasItemCodec a => Either (TomlBiMap a AnyValue) (TomlCodec a)
forall a.
HasItemCodec a =>
Either (TomlBiMap a AnyValue) (TomlCodec a)
hasItemCodec @a of
        Left prim :: TomlBiMap a AnyValue
prim   -> TomlBiMap a AnyValue -> Key -> TomlCodec [a]
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec [a]
Toml.arrayOf TomlBiMap a AnyValue
prim
        Right codec :: TomlCodec a
codec -> TomlCodec a -> Key -> TomlCodec [a]
forall a. TomlCodec a -> Key -> TomlCodec [a]
Toml.list TomlCodec a
codec

instance HasItemCodec a => HasCodec (NonEmpty a) where
    hasCodec :: Key -> TomlCodec (NonEmpty a)
hasCodec = case HasItemCodec a => Either (TomlBiMap a AnyValue) (TomlCodec a)
forall a.
HasItemCodec a =>
Either (TomlBiMap a AnyValue) (TomlCodec a)
hasItemCodec @a of
        Left prim :: TomlBiMap a AnyValue
prim   -> TomlBiMap a AnyValue -> Key -> TomlCodec (NonEmpty a)
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec (NonEmpty a)
Toml.arrayNonEmptyOf TomlBiMap a AnyValue
prim
        Right codec :: TomlCodec a
codec -> TomlCodec a -> Key -> TomlCodec (NonEmpty a)
forall a. TomlCodec a -> Key -> TomlCodec (NonEmpty a)
Toml.nonEmpty TomlCodec a
codec

-- | @since 1.2.0.0
instance (Ord a, HasItemCodec a) => HasCodec (Set a) where
    hasCodec :: Key -> TomlCodec (Set a)
hasCodec = case HasItemCodec a => Either (TomlBiMap a AnyValue) (TomlCodec a)
forall a.
HasItemCodec a =>
Either (TomlBiMap a AnyValue) (TomlCodec a)
hasItemCodec @a of
        Left prim :: TomlBiMap a AnyValue
prim   -> TomlBiMap a AnyValue -> Key -> TomlCodec (Set a)
forall a. Ord a => TomlBiMap a AnyValue -> Key -> TomlCodec (Set a)
Toml.arraySetOf TomlBiMap a AnyValue
prim
        Right codec :: TomlCodec a
codec -> TomlCodec a -> Key -> TomlCodec (Set a)
forall a. Ord a => TomlCodec a -> Key -> TomlCodec (Set a)
Toml.set TomlCodec a
codec

-- | @since 1.2.0.0
instance (Hashable a, Eq a, HasItemCodec a) => HasCodec (HashSet a) where
    hasCodec :: Key -> TomlCodec (HashSet a)
hasCodec = case HasItemCodec a => Either (TomlBiMap a AnyValue) (TomlCodec a)
forall a.
HasItemCodec a =>
Either (TomlBiMap a AnyValue) (TomlCodec a)
hasItemCodec @a of
        Left prim :: TomlBiMap a AnyValue
prim   -> TomlBiMap a AnyValue -> Key -> TomlCodec (HashSet a)
forall a.
(Hashable a, Eq a) =>
TomlBiMap a AnyValue -> Key -> TomlCodec (HashSet a)
Toml.arrayHashSetOf TomlBiMap a AnyValue
prim
        Right codec :: TomlCodec a
codec -> TomlCodec a -> Key -> TomlCodec (HashSet a)
forall a.
(Hashable a, Eq a) =>
TomlCodec a -> Key -> TomlCodec (HashSet a)
Toml.hashSet TomlCodec a
codec

{-
TODO: uncomment when higher-kinded roles will be implemented
* https://github.com/ghc-proposals/ghc-proposals/pull/233

{- | @newtype@ for generic deriving of 'HasCodec' typeclass for custom data
types that should we wrapped into separate table. Use it only for data types
that are fields of another data types.

@
data Person = Person
    { personName    :: Text
    , personAddress :: Address
    } deriving (Generic)

data Address = Address
    { addressStreet :: Text
    , addressHouse  :: Int
    } deriving (Generic)
      deriving HasCodec via TomlTable Address

personCodec :: TomlCodec Person
personCodec = genericCodec
@

@personCodec@ corresponds to the TOML of the following structure:

@
name = "foo"
[address]
    street = \"Bar\"
    house = 42
@
-}
newtype TomlTable a = TomlTable
    { unTomlTable :: a
    }

instance (Generic a, GenericCodec (Rep a)) => HasCodec (TomlTable a) where
    hasCodec :: Key -> TomlCodec (TomlTable a)
    hasCodec = Toml.diwrap . Toml.table (genericCodec @a)

instance (Generic a, GenericCodec (Rep a)) => HasItemCodec (TomlTable a) where
    hasItemCodec = Right $ Toml.diwrap $ genericCodec @a
-}