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

{- |
Module                  : Toml.Codec.Generic
Copyright               : (c) 2018-2021 Kowainik
SPDX-License-Identifier : MPL-2.0
Maintainer              : Kowainik <xrom.xkov@gmail.com>
Stability               : Stable
Portability             : Portable

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.0.0
-}

module Toml.Codec.Generic
       ( genericCodec
       , genericCodecWithOptions
       , stripTypeNameCodec

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

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

         -- * 'ByteString' newtypes
         -- $bytestring
       , ByteStringAsText (..)
       , ByteStringAsBytes (..)
       , LByteStringAsText (..)
       , LByteStringAsBytes (..)

         -- * Deriving Via
       , TomlTable (..)
       , TomlTableStrip (..)
       ) where

import Data.ByteString (ByteString)
import Data.Char (isLower, toLower)
import Data.Coerce (coerce)
import Data.HashMap.Strict (HashMap)
import Data.HashSet (HashSet)
import Data.Hashable (Hashable)
import Data.IntMap.Strict (IntMap)
import Data.IntSet (IntSet)
import Data.Kind (Type)
import Data.List (stripPrefix)
import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import Data.Monoid (All (..), Any (..), First (..), Last (..), Product (..), Sum (..))
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.Codec.BiMap (TomlBiMap)
import Toml.Codec.Di (diwrap, (.=))
import Toml.Codec.Types (TomlCodec)
import Toml.Type.AnyValue (AnyValue)
import Toml.Type.Key (Key)

import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text.Lazy as L

import qualified Toml.Codec.BiMap.Conversion as Toml
import qualified Toml.Codec.Combinator as Toml
import qualified Toml.Codec.Di as Toml


{- | Generic codec for arbitrary data types. Uses field names as keys.

@since 1.1.0.0
-}
genericCodec :: (Generic a, GenericCodec (Rep a)) => TomlCodec a
genericCodec :: forall a. (Generic a, GenericCodec (Rep a)) => TomlCodec a
genericCodec = (a -> Rep a Any)
-> (Rep a Any -> a) -> TomlCodec (Rep a Any) -> TomlCodec a
forall b a. (b -> a) -> (a -> b) -> TomlCodec a -> TomlCodec 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 (TomlCodec (Rep a Any) -> TomlCodec a)
-> TomlCodec (Rep a Any) -> TomlCodec a
forall a b. (a -> b) -> a -> b
$ GenericOptions -> TomlCodec (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.

@since 1.1.0.0
-}
genericCodecWithOptions
    :: forall a
     . (Generic a, GenericCodec (Rep a), Typeable a)
    => TomlOptions a
    -> TomlCodec a
genericCodecWithOptions :: forall a.
(Generic a, GenericCodec (Rep a), Typeable a) =>
TomlOptions a -> TomlCodec a
genericCodecWithOptions = (a -> Rep a Any)
-> (Rep a Any -> a) -> TomlCodec (Rep a Any) -> TomlCodec a
forall b a. (b -> a) -> (a -> b) -> TomlCodec a -> TomlCodec 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 (TomlCodec (Rep a Any) -> TomlCodec a)
-> (TomlOptions a -> TomlCodec (Rep a Any))
-> TomlOptions a
-> TomlCodec a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericOptions -> TomlCodec (Rep a Any)
forall k (f :: k -> *) (p :: k).
GenericCodec f =>
GenericOptions -> TomlCodec (f p)
genericTomlCodec (GenericOptions -> TomlCodec (Rep a Any))
-> (TomlOptions a -> GenericOptions)
-> TomlOptions a
-> TomlCodec (Rep a Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => TomlOptions a -> GenericOptions
forall {k} (a :: k). Typeable a => TomlOptions a -> GenericOptions
toGenericOptions @a
{-# INLINE genericCodecWithOptions #-}

{- | Generic codec that uses 'stripTypeNameOptions'.

@since 1.1.0.0
-}
stripTypeNameCodec
    :: forall a
     . (Generic a, GenericCodec (Rep a), Typeable a)
    => TomlCodec a
stripTypeNameCodec :: forall a.
(Generic a, GenericCodec (Rep a), Typeable a) =>
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
$ forall a. 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?

@since 1.1.0.0
-}
data TomlOptions a = TomlOptions
    { forall {k} (a :: k).
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.

@since 1.1.0.0
-}
newtype GenericOptions = GenericOptions
    { GenericOptions -> String -> String
genericOptionsFieldModifier :: String -> String
    }

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

{- | Options that use 'stripTypeNamePrefix' as 'tomlOptionsFieldModifier'.

@since 1.1.0.0
-}
stripTypeNameOptions :: Typeable a => TomlOptions a
stripTypeNameOptions :: forall {k} (a :: k). Typeable a => 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"

@since 1.1.0.0
-}
stripTypeNamePrefix :: forall a . Typeable a => Proxy a -> String -> String
stripTypeNamePrefix :: forall {k} (a :: k). Typeable a => Proxy a -> String -> String
stripTypeNamePrefix Proxy a
_ 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
$ forall (a :: k). Typeable a => String
forall {k} (a :: k). Typeable a => String
typeName @a) String
fieldName of
        Just String
rest -> String -> String
leaveIfEmpty String
rest
        Maybe String
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 String
"Cannot use 'headToLower' on empty Text"
        Char
x: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 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 :: forall {k} (a :: k). Typeable a => 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 (forall {t :: k}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)

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

{- | Helper class to derive TOML codecs generically.

@since 1.1.0.0
-}
class GenericCodec (f :: k -> Type) where
    genericTomlCodec :: GenericOptions -> TomlCodec (f p)

-- | @since 1.1.0.0
instance GenericCodec f => GenericCodec (D1 d f) where
    genericTomlCodec :: forall (p :: k). GenericOptions -> TomlCodec (D1 d f p)
genericTomlCodec = (M1 D d f p -> f p)
-> (f p -> M1 D d f p) -> TomlCodec (f p) -> TomlCodec (M1 D d f p)
forall b a. (b -> a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimap M1 D d f p -> f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 f p -> M1 D d f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (TomlCodec (f p) -> TomlCodec (M1 D d f p))
-> (GenericOptions -> TomlCodec (f p))
-> GenericOptions
-> TomlCodec (M1 D d f p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericOptions -> TomlCodec (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."

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

-- | @since 1.1.0.0
instance GenericCodec f => GenericCodec (C1 c f) where
    genericTomlCodec :: forall (p :: k). GenericOptions -> TomlCodec (C1 c f p)
genericTomlCodec = (M1 C c f p -> f p)
-> (f p -> M1 C c f p) -> TomlCodec (f p) -> TomlCodec (M1 C c f p)
forall b a. (b -> a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimap M1 C c f p -> f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 f p -> M1 C c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (TomlCodec (f p) -> TomlCodec (M1 C c f p))
-> (GenericOptions -> TomlCodec (f p))
-> GenericOptions
-> TomlCodec (M1 C c f p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericOptions -> TomlCodec (f p)
forall k (f :: k -> *) (p :: k).
GenericCodec f =>
GenericOptions -> TomlCodec (f p)
genericTomlCodec
    {-# INLINE genericTomlCodec #-}

-- | @since 1.1.0.0
instance (GenericCodec f, GenericCodec g) => GenericCodec (f :*: g) where
    genericTomlCodec :: forall (p :: k). GenericOptions -> TomlCodec ((:*:) f g p)
genericTomlCodec 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 ((:*:) f g p) (f p)
-> Codec ((:*:) 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 ((:*:) f g p) (f p)
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= (:*:) f g p -> f p
forall (p :: k). (:*:) f g p -> f p
fstG
        Codec ((:*:) f g p) (g p -> (:*:) f g p)
-> Codec ((:*:) f g p) (g p) -> Codec ((:*:) f g p) ((:*:) 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 ((:*:) f g p) (g p)
forall field a object.
Codec field a -> (object -> field) -> Codec object a
.= (:*:) f g p -> g p
forall (p :: k). (:*:) f g p -> g p
sndG
      where
        fstG :: (f :*: g) p -> f p
        fstG :: forall (p :: k). (:*:) f g p -> f p
fstG (f p
f :*: g p
_) = f p
f

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

-- | @since 1.1.0.0
instance (Selector s, HasCodec a) => GenericCodec (S1 s (Rec0 a)) where
    genericTomlCodec :: forall (p :: k). GenericOptions -> TomlCodec (S1 s (Rec0 a) p)
genericTomlCodec GenericOptions{String -> String
genericOptionsFieldModifier :: String -> String
genericOptionsFieldModifier :: GenericOptions -> String -> String
..} = 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
$ forall a. HasCodec a => Key -> TomlCodec a
hasCodec @a Key
fieldName
      where
        genericWrap :: TomlCodec a -> TomlCodec (S1 s (Rec0 a) p)
        genericWrap :: forall {k} (p :: k). TomlCodec a -> TomlCodec (S1 s (Rec0 a) p)
genericWrap = (M1 S s (K1 R a) p -> a)
-> (a -> M1 S s (K1 R a) p)
-> TomlCodec a
-> TomlCodec (M1 S s (K1 R a) p)
forall b a. (b -> a) -> (a -> b) -> TomlCodec a -> TomlCodec b
Toml.dimap (K1 R a p -> a
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R a p -> a)
-> (M1 S s (K1 R a) p -> K1 R a p) -> M1 S s (K1 R a) p -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 S s (K1 R a) p -> K1 R a p
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1) (K1 R a p -> M1 S s (K1 R a) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R a p -> M1 S s (K1 R a) p)
-> (a -> K1 R a p) -> a -> M1 S s (K1 R 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 String
"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.

@since 1.1.0.0
-}
class HasItemCodec a where
    hasItemCodec :: Either (TomlBiMap a AnyValue) (TomlCodec a)

-- | @since 1.1.0.0
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
    {-# INLINE hasItemCodec #-}

-- | @since 1.1.0.0
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
    {-# INLINE hasItemCodec #-}

-- | @since 1.1.0.0
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
    {-# INLINE hasItemCodec #-}

-- | @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
    {-# INLINE hasItemCodec #-}

-- | @since 1.1.0.0
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
    {-# INLINE hasItemCodec #-}

-- | @since 1.1.0.0
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
    {-# INLINE hasItemCodec #-}

-- | @since 1.1.0.0
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
    {-# INLINE hasItemCodec #-}

-- | @since 1.1.0.0
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
    {-# INLINE hasItemCodec #-}

-- | @since 1.1.0.0
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
    {-# INLINE hasItemCodec #-}

-- | @since 1.1.0.0
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
    {-# INLINE hasItemCodec #-}

-- | @since 1.3.0.0
instance HasItemCodec ByteStringAsText where
    hasItemCodec :: Either
  (TomlBiMap ByteStringAsText AnyValue) (TomlCodec ByteStringAsText)
hasItemCodec = TomlBiMap ByteStringAsText AnyValue
-> Either
     (TomlBiMap ByteStringAsText AnyValue) (TomlCodec ByteStringAsText)
forall a b. a -> Either a b
Left (TomlBiMap ByteStringAsText AnyValue
 -> Either
      (TomlBiMap ByteStringAsText AnyValue) (TomlCodec ByteStringAsText))
-> TomlBiMap ByteStringAsText AnyValue
-> Either
     (TomlBiMap ByteStringAsText AnyValue) (TomlCodec ByteStringAsText)
forall a b. (a -> b) -> a -> b
$ TomlBiMap ByteString AnyValue
-> TomlBiMap ByteStringAsText AnyValue
coerce TomlBiMap ByteString AnyValue
Toml._ByteString
    {-# INLINE hasItemCodec #-}

-- | @since 1.3.0.0
instance HasItemCodec ByteStringAsBytes where
    hasItemCodec :: Either
  (TomlBiMap ByteStringAsBytes AnyValue)
  (TomlCodec ByteStringAsBytes)
hasItemCodec = TomlBiMap ByteStringAsBytes AnyValue
-> Either
     (TomlBiMap ByteStringAsBytes AnyValue)
     (TomlCodec ByteStringAsBytes)
forall a b. a -> Either a b
Left (TomlBiMap ByteStringAsBytes AnyValue
 -> Either
      (TomlBiMap ByteStringAsBytes AnyValue)
      (TomlCodec ByteStringAsBytes))
-> TomlBiMap ByteStringAsBytes AnyValue
-> Either
     (TomlBiMap ByteStringAsBytes AnyValue)
     (TomlCodec ByteStringAsBytes)
forall a b. (a -> b) -> a -> b
$ TomlBiMap ByteString AnyValue
-> TomlBiMap ByteStringAsBytes AnyValue
coerce TomlBiMap ByteString AnyValue
Toml._ByteStringArray
    {-# INLINE hasItemCodec #-}

-- | @since 1.3.0.0
instance HasItemCodec LByteStringAsText where
    hasItemCodec :: Either
  (TomlBiMap LByteStringAsText AnyValue)
  (TomlCodec LByteStringAsText)
hasItemCodec = TomlBiMap LByteStringAsText AnyValue
-> Either
     (TomlBiMap LByteStringAsText AnyValue)
     (TomlCodec LByteStringAsText)
forall a b. a -> Either a b
Left (TomlBiMap LByteStringAsText AnyValue
 -> Either
      (TomlBiMap LByteStringAsText AnyValue)
      (TomlCodec LByteStringAsText))
-> TomlBiMap LByteStringAsText AnyValue
-> Either
     (TomlBiMap LByteStringAsText AnyValue)
     (TomlCodec LByteStringAsText)
forall a b. (a -> b) -> a -> b
$ TomlBiMap ByteString AnyValue
-> TomlBiMap LByteStringAsText AnyValue
coerce TomlBiMap ByteString AnyValue
Toml._LByteString
    {-# INLINE hasItemCodec #-}

-- | @since 1.3.0.0
instance HasItemCodec LByteStringAsBytes where
    hasItemCodec :: Either
  (TomlBiMap LByteStringAsBytes AnyValue)
  (TomlCodec LByteStringAsBytes)
hasItemCodec = TomlBiMap LByteStringAsBytes AnyValue
-> Either
     (TomlBiMap LByteStringAsBytes AnyValue)
     (TomlCodec LByteStringAsBytes)
forall a b. a -> Either a b
Left (TomlBiMap LByteStringAsBytes AnyValue
 -> Either
      (TomlBiMap LByteStringAsBytes AnyValue)
      (TomlCodec LByteStringAsBytes))
-> TomlBiMap LByteStringAsBytes AnyValue
-> Either
     (TomlBiMap LByteStringAsBytes AnyValue)
     (TomlCodec LByteStringAsBytes)
forall a b. (a -> b) -> a -> b
$ TomlBiMap ByteString AnyValue
-> TomlBiMap LByteStringAsBytes AnyValue
coerce TomlBiMap ByteString AnyValue
Toml._LByteStringArray
    {-# INLINE hasItemCodec #-}

-- | @since 1.1.0.0
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
    {-# INLINE hasItemCodec #-}

-- | @since 1.1.0.0
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
    {-# INLINE hasItemCodec #-}

-- | @since 1.1.0.0
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
    {-# INLINE hasItemCodec #-}

-- | @since 1.1.0.0
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
    {-# INLINE hasItemCodec #-}

-- | @since 1.1.0.0
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
    {-# INLINE hasItemCodec #-}

{- | If data type @a@ is not primitive then this instance returns codec for list
under key equal to @a@ type name.

@since 1.1.0.0
-}
instance (HasItemCodec a, Typeable a) => HasItemCodec [a] where
    hasItemCodec :: Either (TomlBiMap [a] AnyValue) (TomlCodec [a])
hasItemCodec = case forall a.
HasItemCodec a =>
Either (TomlBiMap a AnyValue) (TomlCodec a)
hasItemCodec @a of
        Left 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 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
$ forall a. Typeable a => String
forall {k} (a :: k). Typeable a => String
typeName @a)
    {-# INLINE hasItemCodec #-}

{- | 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.

@since 1.1.0.0
-}
class HasCodec a where
    hasCodec :: Key -> TomlCodec a

-- | @since 1.1.0.0
instance HasCodec Bool where
    hasCodec :: Key -> TomlCodec Bool
hasCodec = Key -> TomlCodec Bool
Toml.bool
    {-# INLINE hasCodec #-}

-- | @since 1.1.0.0
instance HasCodec Int where
    hasCodec :: Key -> TomlCodec Int
hasCodec = Key -> TomlCodec Int
Toml.int
    {-# INLINE hasCodec #-}

-- | @since 1.1.0.0
instance HasCodec Word where
    hasCodec :: Key -> TomlCodec Word
hasCodec = Key -> TomlCodec Word
Toml.word
    {-# INLINE hasCodec #-}

-- | @since 1.2.0.0
instance HasCodec Word8 where
    hasCodec :: Key -> TomlCodec Word8
hasCodec = Key -> TomlCodec Word8
Toml.word8
    {-# INLINE hasCodec #-}

-- | @since 1.1.0.0
instance HasCodec Integer where
    hasCodec :: Key -> TomlCodec Integer
hasCodec = Key -> TomlCodec Integer
Toml.integer
    {-# INLINE hasCodec #-}

-- | @since 1.1.0.0
instance HasCodec Natural where
    hasCodec :: Key -> TomlCodec Natural
hasCodec = Key -> TomlCodec Natural
Toml.natural
    {-# INLINE hasCodec #-}

-- | @since 1.1.0.0
instance HasCodec Double where
    hasCodec :: Key -> TomlCodec Double
hasCodec = Key -> TomlCodec Double
Toml.double
    {-# INLINE hasCodec #-}

-- | @since 1.1.0.0
instance HasCodec Float where
    hasCodec :: Key -> TomlCodec Float
hasCodec = Key -> TomlCodec Float
Toml.float
    {-# INLINE hasCodec #-}

-- | @since 1.1.0.0
instance HasCodec Text where
    hasCodec :: Key -> TomlCodec Text
hasCodec = Key -> TomlCodec Text
Toml.text
    {-# INLINE hasCodec #-}

-- | @since 1.1.0.0
instance HasCodec L.Text where
    hasCodec :: Key -> TomlCodec Text
hasCodec = Key -> TomlCodec Text
Toml.lazyText
    {-# INLINE hasCodec #-}

-- | @since 1.3.0.0
instance HasCodec ByteStringAsText where
    hasCodec :: Key -> TomlCodec ByteStringAsText
hasCodec = TomlCodec ByteString -> TomlCodec ByteStringAsText
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
diwrap (TomlCodec ByteString -> TomlCodec ByteStringAsText)
-> (Key -> TomlCodec ByteString)
-> Key
-> TomlCodec ByteStringAsText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> TomlCodec ByteString
Toml.byteString
    {-# INLINE hasCodec #-}

-- | @since 1.3.0.0
instance HasCodec ByteStringAsBytes where
    hasCodec :: Key -> TomlCodec ByteStringAsBytes
hasCodec = TomlCodec ByteString -> TomlCodec ByteStringAsBytes
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
diwrap (TomlCodec ByteString -> TomlCodec ByteStringAsBytes)
-> (Key -> TomlCodec ByteString)
-> Key
-> TomlCodec ByteStringAsBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> TomlCodec ByteString
Toml.byteStringArray
    {-# INLINE hasCodec #-}

-- | @since 1.3.0.0
instance HasCodec LByteStringAsText where
    hasCodec :: Key -> TomlCodec LByteStringAsText
hasCodec = TomlCodec ByteString -> TomlCodec LByteStringAsText
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
diwrap (TomlCodec ByteString -> TomlCodec LByteStringAsText)
-> (Key -> TomlCodec ByteString)
-> Key
-> TomlCodec LByteStringAsText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> TomlCodec ByteString
Toml.lazyByteString
    {-# INLINE hasCodec #-}

-- | @since 1.3.0.0
instance HasCodec LByteStringAsBytes where
    hasCodec :: Key -> TomlCodec LByteStringAsBytes
hasCodec = TomlCodec ByteString -> TomlCodec LByteStringAsBytes
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
diwrap (TomlCodec ByteString -> TomlCodec LByteStringAsBytes)
-> (Key -> TomlCodec ByteString)
-> Key
-> TomlCodec LByteStringAsBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> TomlCodec ByteString
Toml.lazyByteStringArray
    {-# INLINE hasCodec #-}

-- | @since 1.1.0.0
instance HasCodec ZonedTime where
    hasCodec :: Key -> TomlCodec ZonedTime
hasCodec = Key -> TomlCodec ZonedTime
Toml.zonedTime
    {-# INLINE hasCodec #-}

-- | @since 1.1.0.0
instance HasCodec LocalTime where
    hasCodec :: Key -> TomlCodec LocalTime
hasCodec = Key -> TomlCodec LocalTime
Toml.localTime
    {-# INLINE hasCodec #-}

-- | @since 1.1.0.0
instance HasCodec Day where
    hasCodec :: Key -> TomlCodec Day
hasCodec = Key -> TomlCodec Day
Toml.day
    {-# INLINE hasCodec #-}

-- | @since 1.1.0.0
instance HasCodec TimeOfDay where
    hasCodec :: Key -> TomlCodec TimeOfDay
hasCodec = Key -> TomlCodec TimeOfDay
Toml.timeOfDay
    {-# INLINE hasCodec #-}

-- | @since 1.1.0.0
instance HasCodec IntSet where
    hasCodec :: Key -> TomlCodec IntSet
hasCodec = Key -> TomlCodec IntSet
Toml.arrayIntSet
    {-# INLINE hasCodec #-}

-- | @since 1.1.0.0
instance HasCodec a => HasCodec (Maybe a) where
    hasCodec :: Key -> TomlCodec (Maybe a)
hasCodec = TomlCodec a -> TomlCodec (Maybe a)
forall a. TomlCodec a -> TomlCodec (Maybe a)
Toml.dioptional (TomlCodec a -> TomlCodec (Maybe a))
-> (Key -> TomlCodec a) -> Key -> TomlCodec (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCodec a => Key -> TomlCodec a
hasCodec @a
    {-# INLINE hasCodec #-}

-- | @since 1.1.0.0
instance HasItemCodec a => HasCodec [a] where
    hasCodec :: Key -> TomlCodec [a]
hasCodec = case forall a.
HasItemCodec a =>
Either (TomlBiMap a AnyValue) (TomlCodec a)
hasItemCodec @a of
        Left 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 TomlCodec a
codec -> TomlCodec a -> Key -> TomlCodec [a]
forall a. TomlCodec a -> Key -> TomlCodec [a]
Toml.list TomlCodec a
codec
    {-# INLINE hasCodec #-}

-- | @since 1.1.0.0
instance HasItemCodec a => HasCodec (NonEmpty a) where
    hasCodec :: Key -> TomlCodec (NonEmpty a)
hasCodec = case forall a.
HasItemCodec a =>
Either (TomlBiMap a AnyValue) (TomlCodec a)
hasItemCodec @a of
        Left 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 TomlCodec a
codec -> TomlCodec a -> Key -> TomlCodec (NonEmpty a)
forall a. TomlCodec a -> Key -> TomlCodec (NonEmpty a)
Toml.nonEmpty TomlCodec a
codec
    {-# INLINE hasCodec #-}

-- | @since 1.2.0.0
instance (Ord a, HasItemCodec a) => HasCodec (Set a) where
    hasCodec :: Key -> TomlCodec (Set a)
hasCodec = case forall a.
HasItemCodec a =>
Either (TomlBiMap a AnyValue) (TomlCodec a)
hasItemCodec @a of
        Left 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 TomlCodec a
codec -> TomlCodec a -> Key -> TomlCodec (Set a)
forall a. Ord a => TomlCodec a -> Key -> TomlCodec (Set a)
Toml.set TomlCodec a
codec
    {-# INLINE hasCodec #-}

-- | @since 1.2.0.0
instance (Hashable a, Eq a, HasItemCodec a) => HasCodec (HashSet a) where
    hasCodec :: Key -> TomlCodec (HashSet a)
hasCodec = case forall a.
HasItemCodec a =>
Either (TomlBiMap a AnyValue) (TomlCodec a)
hasItemCodec @a of
        Left 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 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
    {-# INLINE hasCodec #-}

{- | Encodes 'Map' as array of tables with the @key@ and @val@ TOML
key names for 'Map' keys and values. E.g. if you have a type
@'Map' 'Int' 'Text'@, the 'HasCodec' instance for 'Generic' deriving
will work with the following TOML representation:

@
fieldName =
    [ { key = 10, val = "book" }
    , { key = 42, val = "food" }
    ]
@

@since 1.3.0.0
-}
instance (Ord k, HasCodec k, HasCodec v) => HasCodec (Map k v) where
    hasCodec :: Key -> TomlCodec (Map k v)
hasCodec = TomlCodec k -> TomlCodec v -> Key -> TomlCodec (Map k v)
forall k v.
Ord k =>
TomlCodec k -> TomlCodec v -> Key -> TomlCodec (Map k v)
Toml.map (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @k Key
"key") (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @v Key
"val")
    {-# INLINE hasCodec #-}

{- | Encodes 'HashMap' as array of tables with the @key@ and @val@ TOML
key names for 'HashMap' keys and values. E.g. if you have a type
@'HashMap' 'Text' 'Int'@, the 'HasCodec' instance for 'Generic'
deriving will work with the following TOML representation:

@
fieldName =
    [ { key = "foo", val = 15 }
    , { key = "bar", val = 7  }
    ]
@

@since 1.3.0.0
-}
instance (Hashable k, Eq k, HasCodec k, HasCodec v) => HasCodec (HashMap k v) where
    hasCodec :: Key -> TomlCodec (HashMap k v)
hasCodec = TomlCodec k -> TomlCodec v -> Key -> TomlCodec (HashMap k v)
forall k v.
(Eq k, Hashable k) =>
TomlCodec k -> TomlCodec v -> Key -> TomlCodec (HashMap k v)
Toml.hashMap (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @k Key
"key") (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @v Key
"val")
    {-# INLINE hasCodec #-}

{- | Encodes 'IntMap' as array of tables with the @key@ and @val@ TOML
key names for 'IntMap' keys and values. E.g. if you have a type
@'IntMap' 'Text'@, the 'HasCodec' instance for 'Generic' deriving will
work with the following TOML representation:

@
fieldName =
    [ { key = 10, val = "foo" }
    , { key = 42, val = "bar" }
    ]
@

@since 1.3.0.0
-}
instance (HasCodec v) => HasCodec (IntMap v) where
    hasCodec :: Key -> TomlCodec (IntMap v)
hasCodec = TomlCodec Int -> TomlCodec v -> Key -> TomlCodec (IntMap v)
forall v.
TomlCodec Int -> TomlCodec v -> Key -> TomlCodec (IntMap v)
Toml.intMap (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @Int Key
"key") (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @v Key
"val")
    {-# INLINE hasCodec #-}

-- | @since 1.3.0.0
instance HasCodec All where
    hasCodec :: Key -> TomlCodec All
hasCodec = Key -> TomlCodec All
Toml.all
    {-# INLINE hasCodec #-}

-- | @since 1.3.0.0
instance HasCodec Any where
    hasCodec :: Key -> TomlCodec Any
hasCodec = Key -> TomlCodec Any
Toml.any
    {-# INLINE hasCodec #-}

-- | @since 1.3.0.0
instance (Num a, HasCodec a) => HasCodec (Sum a) where
    hasCodec :: Key -> TomlCodec (Sum a)
hasCodec = (Key -> TomlCodec a) -> Key -> TomlCodec (Sum a)
forall a. Num a => (Key -> TomlCodec a) -> Key -> TomlCodec (Sum a)
Toml.sum (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @a)
    {-# INLINE hasCodec #-}

-- | @since 1.3.0.0
instance (Num a, HasCodec a) => HasCodec (Product a) where
    hasCodec :: Key -> TomlCodec (Product a)
hasCodec = (Key -> TomlCodec a) -> Key -> TomlCodec (Product a)
forall a.
Num a =>
(Key -> TomlCodec a) -> Key -> TomlCodec (Product a)
Toml.product (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @a)
    {-# INLINE hasCodec #-}

-- | @since 1.3.0.0
instance HasCodec a => HasCodec (First a) where
    hasCodec :: Key -> TomlCodec (First a)
hasCodec = (Key -> TomlCodec a) -> Key -> TomlCodec (First a)
forall a. (Key -> TomlCodec a) -> Key -> TomlCodec (First a)
Toml.first (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @a)
    {-# INLINE hasCodec #-}

-- | @since 1.3.0.0
instance HasCodec a => HasCodec (Last a) where
    hasCodec :: Key -> TomlCodec (Last a)
hasCodec = (Key -> TomlCodec a) -> Key -> TomlCodec (Last a)
forall a. (Key -> TomlCodec a) -> Key -> TomlCodec (Last a)
Toml.last (forall a. HasCodec a => Key -> TomlCodec a
hasCodec @a)
    {-# INLINE hasCodec #-}

{- | @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 = 'stripTypeNameCodec'
@

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

@
name = "foo"
[address]
    addressStreet = \"Bar\"
    addressHouse = 42
@

@since 1.3.0.0
-}
newtype TomlTable a = TomlTable
    { forall a. TomlTable a -> a
unTomlTable :: a
    }

-- | @since 1.3.0.0
instance (Generic a, GenericCodec (Rep a)) => HasCodec (TomlTable a) where
    hasCodec :: Key -> TomlCodec (TomlTable a)
    hasCodec :: Key -> TomlCodec (TomlTable a)
hasCodec = TomlCodec a -> TomlCodec (TomlTable a)
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
Toml.diwrap (TomlCodec a -> TomlCodec (TomlTable a))
-> (Key -> TomlCodec a) -> Key -> TomlCodec (TomlTable a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlCodec a -> Key -> TomlCodec a
forall a. TomlCodec a -> Key -> TomlCodec a
Toml.table (forall a. (Generic a, GenericCodec (Rep a)) => TomlCodec a
genericCodec @a)
    {-# INLINE hasCodec #-}

-- | @since 1.3.0.0
instance (Generic a, GenericCodec (Rep a)) => HasItemCodec (TomlTable a) where
    hasItemCodec :: Either (TomlBiMap (TomlTable a) AnyValue) (TomlCodec (TomlTable a))
hasItemCodec = TomlCodec (TomlTable a)
-> Either
     (TomlBiMap (TomlTable a) AnyValue) (TomlCodec (TomlTable a))
forall a b. b -> Either a b
Right (TomlCodec (TomlTable a)
 -> Either
      (TomlBiMap (TomlTable a) AnyValue) (TomlCodec (TomlTable a)))
-> TomlCodec (TomlTable a)
-> Either
     (TomlBiMap (TomlTable a) AnyValue) (TomlCodec (TomlTable a))
forall a b. (a -> b) -> a -> b
$ TomlCodec a -> TomlCodec (TomlTable a)
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
Toml.diwrap (TomlCodec a -> TomlCodec (TomlTable a))
-> TomlCodec a -> TomlCodec (TomlTable a)
forall a b. (a -> b) -> a -> b
$ forall a. (Generic a, GenericCodec (Rep a)) => TomlCodec a
genericCodec @a
    {-# INLINE hasItemCodec #-}

{- | @newtype@ for generic deriving of 'HasCodec' typeclass for custom data
types that should be wrapped into a separate table.

Similar to 'TomlTable' but also strips the data type name prefix from
TOML keys.

@personCodec@ from the 'TomlTable' comment corresponds to the TOML of
the following structure:

@
name = "foo"
[address]
    street = \"Bar\"
    house = 42
@

@since 1.3.2.0
-}
newtype TomlTableStrip a = TomlTableStrip
    { forall a. TomlTableStrip a -> a
unTomlTableStrip :: a
    }

-- | @since 1.3.2.0
instance (Generic a, GenericCodec (Rep a), Typeable a) => HasCodec (TomlTableStrip a) where
    hasCodec :: Key -> TomlCodec (TomlTableStrip a)
    hasCodec :: Key -> TomlCodec (TomlTableStrip a)
hasCodec = TomlCodec a -> TomlCodec (TomlTableStrip a)
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
Toml.diwrap (TomlCodec a -> TomlCodec (TomlTableStrip a))
-> (Key -> TomlCodec a) -> Key -> TomlCodec (TomlTableStrip a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlCodec a -> Key -> TomlCodec a
forall a. TomlCodec a -> Key -> TomlCodec a
Toml.table (forall a.
(Generic a, GenericCodec (Rep a), Typeable a) =>
TomlCodec a
stripTypeNameCodec @a)
    {-# INLINE hasCodec #-}

-- | @since 1.3.2.0
instance (Generic a, GenericCodec (Rep a), Typeable a) => HasItemCodec (TomlTableStrip a) where
    hasItemCodec :: Either
  (TomlBiMap (TomlTableStrip a) AnyValue)
  (TomlCodec (TomlTableStrip a))
hasItemCodec = TomlCodec (TomlTableStrip a)
-> Either
     (TomlBiMap (TomlTableStrip a) AnyValue)
     (TomlCodec (TomlTableStrip a))
forall a b. b -> Either a b
Right (TomlCodec (TomlTableStrip a)
 -> Either
      (TomlBiMap (TomlTableStrip a) AnyValue)
      (TomlCodec (TomlTableStrip a)))
-> TomlCodec (TomlTableStrip a)
-> Either
     (TomlBiMap (TomlTableStrip a) AnyValue)
     (TomlCodec (TomlTableStrip a))
forall a b. (a -> b) -> a -> b
$ TomlCodec a -> TomlCodec (TomlTableStrip a)
forall b a. Coercible a b => TomlCodec a -> TomlCodec b
Toml.diwrap (TomlCodec a -> TomlCodec (TomlTableStrip a))
-> TomlCodec a -> TomlCodec (TomlTableStrip a)
forall a b. (a -> b) -> a -> b
$ forall a.
(Generic a, GenericCodec (Rep a), Typeable a) =>
TomlCodec a
stripTypeNameCodec @a
    {-# INLINE hasItemCodec #-}

{- $bytestring
There are two ways to encode 'ByteString' in TOML:

1. Via text.
2. Via an array of integers (aka array of bytes).

To handle all these cases, @tomland@ provides helpful newtypes, specifically:

* 'ByteStringAsText'
* 'ByteStringAsBytes'
* 'LByteStringAsText'
* 'LByteStringAsBytes'

As a bonus, on GHC >= 8.6 you can use these newtypes with the @DerivingVia@
extensions for your own 'ByteString' types.

@
__newtype__ MyByteString = MyByteString
    { unMyByteString :: 'ByteString'
    } __deriving__ 'HasCodec' __via__ 'ByteStringAsBytes'
@
-}

{- | Newtype wrapper over 'ByteString' to be used for text values.

@since 1.3.0.0
-}
newtype ByteStringAsText = ByteStringAsText
    { ByteStringAsText -> ByteString
unByteStringAsText :: ByteString
    } deriving newtype (Int -> ByteStringAsText -> String -> String
[ByteStringAsText] -> String -> String
ByteStringAsText -> String
(Int -> ByteStringAsText -> String -> String)
-> (ByteStringAsText -> String)
-> ([ByteStringAsText] -> String -> String)
-> Show ByteStringAsText
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ByteStringAsText] -> String -> String
$cshowList :: [ByteStringAsText] -> String -> String
show :: ByteStringAsText -> String
$cshow :: ByteStringAsText -> String
showsPrec :: Int -> ByteStringAsText -> String -> String
$cshowsPrec :: Int -> ByteStringAsText -> String -> String
Show, ByteStringAsText -> ByteStringAsText -> Bool
(ByteStringAsText -> ByteStringAsText -> Bool)
-> (ByteStringAsText -> ByteStringAsText -> Bool)
-> Eq ByteStringAsText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ByteStringAsText -> ByteStringAsText -> Bool
$c/= :: ByteStringAsText -> ByteStringAsText -> Bool
== :: ByteStringAsText -> ByteStringAsText -> Bool
$c== :: ByteStringAsText -> ByteStringAsText -> Bool
Eq)

{- | Newtype wrapper over 'ByteString' to be used for array of integers
representation.

@since 1.3.0.0
-}
newtype ByteStringAsBytes = ByteStringAsBytes
    { ByteStringAsBytes -> ByteString
unByteStringAsBytes :: ByteString
    } deriving newtype (Int -> ByteStringAsBytes -> String -> String
[ByteStringAsBytes] -> String -> String
ByteStringAsBytes -> String
(Int -> ByteStringAsBytes -> String -> String)
-> (ByteStringAsBytes -> String)
-> ([ByteStringAsBytes] -> String -> String)
-> Show ByteStringAsBytes
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ByteStringAsBytes] -> String -> String
$cshowList :: [ByteStringAsBytes] -> String -> String
show :: ByteStringAsBytes -> String
$cshow :: ByteStringAsBytes -> String
showsPrec :: Int -> ByteStringAsBytes -> String -> String
$cshowsPrec :: Int -> ByteStringAsBytes -> String -> String
Show, ByteStringAsBytes -> ByteStringAsBytes -> Bool
(ByteStringAsBytes -> ByteStringAsBytes -> Bool)
-> (ByteStringAsBytes -> ByteStringAsBytes -> Bool)
-> Eq ByteStringAsBytes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ByteStringAsBytes -> ByteStringAsBytes -> Bool
$c/= :: ByteStringAsBytes -> ByteStringAsBytes -> Bool
== :: ByteStringAsBytes -> ByteStringAsBytes -> Bool
$c== :: ByteStringAsBytes -> ByteStringAsBytes -> Bool
Eq)

{- | Newtype wrapper over lazy 'LBS.ByteString' to be used for text values.

@since 1.3.0.0
-}
newtype LByteStringAsText = LByteStringAsText
    { LByteStringAsText -> ByteString
unLByteStringAsText :: LBS.ByteString
    } deriving newtype (Int -> LByteStringAsText -> String -> String
[LByteStringAsText] -> String -> String
LByteStringAsText -> String
(Int -> LByteStringAsText -> String -> String)
-> (LByteStringAsText -> String)
-> ([LByteStringAsText] -> String -> String)
-> Show LByteStringAsText
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LByteStringAsText] -> String -> String
$cshowList :: [LByteStringAsText] -> String -> String
show :: LByteStringAsText -> String
$cshow :: LByteStringAsText -> String
showsPrec :: Int -> LByteStringAsText -> String -> String
$cshowsPrec :: Int -> LByteStringAsText -> String -> String
Show, LByteStringAsText -> LByteStringAsText -> Bool
(LByteStringAsText -> LByteStringAsText -> Bool)
-> (LByteStringAsText -> LByteStringAsText -> Bool)
-> Eq LByteStringAsText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LByteStringAsText -> LByteStringAsText -> Bool
$c/= :: LByteStringAsText -> LByteStringAsText -> Bool
== :: LByteStringAsText -> LByteStringAsText -> Bool
$c== :: LByteStringAsText -> LByteStringAsText -> Bool
Eq)

{- | Newtype wrapper over lazy 'LBS.ByteString' to be used for array of integers
representation.

@since 1.3.0.0
-}
newtype LByteStringAsBytes = LByteStringAsBytes
    { LByteStringAsBytes -> ByteString
unLByteStringAsBytes :: LBS.ByteString
    } deriving newtype (Int -> LByteStringAsBytes -> String -> String
[LByteStringAsBytes] -> String -> String
LByteStringAsBytes -> String
(Int -> LByteStringAsBytes -> String -> String)
-> (LByteStringAsBytes -> String)
-> ([LByteStringAsBytes] -> String -> String)
-> Show LByteStringAsBytes
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LByteStringAsBytes] -> String -> String
$cshowList :: [LByteStringAsBytes] -> String -> String
show :: LByteStringAsBytes -> String
$cshow :: LByteStringAsBytes -> String
showsPrec :: Int -> LByteStringAsBytes -> String -> String
$cshowsPrec :: Int -> LByteStringAsBytes -> String -> String
Show, LByteStringAsBytes -> LByteStringAsBytes -> Bool
(LByteStringAsBytes -> LByteStringAsBytes -> Bool)
-> (LByteStringAsBytes -> LByteStringAsBytes -> Bool)
-> Eq LByteStringAsBytes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LByteStringAsBytes -> LByteStringAsBytes -> Bool
$c/= :: LByteStringAsBytes -> LByteStringAsBytes -> Bool
== :: LByteStringAsBytes -> LByteStringAsBytes -> Bool
$c== :: LByteStringAsBytes -> LByteStringAsBytes -> Bool
Eq)