{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}

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

Contains TOML-specific combinators for converting between TOML and user data types.
-}

module Toml.Bi.Combinators
       ( -- * Basic codecs for primitive values
         -- ** Boolean
         bool
         -- ** Integral numbers
       , integer
       , natural
       , int
       , word
       , word8
         -- ** Floating point numbers
       , double
       , float
         -- ** Text types
       , text
       , lazyText
       , byteString
       , lazyByteString
       , byteStringArray
       , lazyByteStringArray
       , string
         -- ** Time types
       , zonedTime
       , localTime
       , day
       , timeOfDay

         -- * Codecs for containers of primitives
       , arrayOf
       , arraySetOf
       , arrayIntSet
       , arrayHashSetOf
       , arrayNonEmptyOf

         -- * Codecs for 'Monoid's
         -- ** Bool wrappers
       , all
       , any
         -- ** 'Num' wrappers
       , sum
       , product
         -- ** 'Maybe' wrappers
       , first
       , last

         -- * Additional codecs for custom types
       , textBy
       , read
       , enumBounded

         -- * Combinators for tables
       , table
       , nonEmpty
       , list
       , set
       , hashSet

         -- * Combinators for Maps
       , map

         -- * General construction of codecs
       , match
       ) where

import Prelude hiding (all, any, last, map, product, read, sum)

import Control.Monad (forM)
import Control.Monad.Except (catchError, throwError)
import Control.Monad.Reader (asks, local)
import Control.Monad.State (execState, gets, modify)
import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import Data.ByteString (ByteString)
import Data.Hashable (Hashable)
import Data.HashSet (HashSet)
import Data.IntSet (IntSet)
import Data.List.NonEmpty (NonEmpty (..), toList)
import Data.Map.Strict (Map)
import Data.Maybe (fromMaybe)
import Data.Monoid (All (..), Any (..), First (..), Last (..), Product (..), Sum (..))
import Data.Semigroup ((<>))
import Data.Set (Set)
import Data.Text (Text)
import Data.Time (Day, LocalTime, TimeOfDay, ZonedTime)
import Data.Word (Word8)
import Numeric.Natural (Natural)

import Toml.Bi.Code (DecodeException (..), Env, St, TomlCodec, execTomlCodec)
import Toml.Bi.Map (BiMap (..), TomlBiMap, _Array, _Bool, _ByteString, _ByteStringArray, _Day,
                    _Double, _EnumBounded, _Float, _HashSet, _Int, _IntSet, _Integer, _LByteString,
                    _LByteStringArray, _LText, _LocalTime, _Natural, _NonEmpty, _Read, _Set,
                    _String, _Text, _TextBy, _TimeOfDay, _Word, _Word8, _ZonedTime)
import Toml.Bi.Monad (Codec (..), dimap, dioptional)
import Toml.PrefixTree (Key)
import Toml.Type (AnyValue (..), TOML (..), insertKeyAnyVal, insertTable, insertTableArrays)

import qualified Data.ByteString.Lazy as BL
import qualified Data.HashMap.Strict as HashMap
import qualified Data.HashSet as HS
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import qualified Data.Set as S
import qualified Data.Text.Lazy as L
import qualified Toml.PrefixTree as Prefix


{- | General function to create bidirectional converters for key-value pairs. In
order to use this function you need to create 'TomlBiMap' for your type and
'AnyValue':

@
_MyType :: 'TomlBiMap' MyType 'AnyValue'
@

And then you can create codec for your type using 'match' function:

@
myType :: 'Key' -> 'TomlCodec' MyType
myType = 'match' _MyType
@
-}
match :: forall a . TomlBiMap a AnyValue -> Key -> TomlCodec a
match :: TomlBiMap a AnyValue -> Key -> TomlCodec a
match BiMap{..} key :: Key
key = ExceptT DecodeException (Reader TOML) a
-> (a -> MaybeT (State TOML) a) -> TomlCodec a
forall (r :: * -> *) (w :: * -> *) c a.
r a -> (c -> w a) -> Codec r w c a
Codec ExceptT DecodeException (Reader TOML) a
input a -> MaybeT (State TOML) a
output
  where
    input :: Env a
    input :: ExceptT DecodeException (Reader TOML) a
input = do
        Maybe AnyValue
mVal <- (TOML -> Maybe AnyValue)
-> ExceptT DecodeException (Reader TOML) (Maybe AnyValue)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((TOML -> Maybe AnyValue)
 -> ExceptT DecodeException (Reader TOML) (Maybe AnyValue))
-> (TOML -> Maybe AnyValue)
-> ExceptT DecodeException (Reader TOML) (Maybe AnyValue)
forall a b. (a -> b) -> a -> b
$ Key -> HashMap Key AnyValue -> Maybe AnyValue
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key (HashMap Key AnyValue -> Maybe AnyValue)
-> (TOML -> HashMap Key AnyValue) -> TOML -> Maybe AnyValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TOML -> HashMap Key AnyValue
tomlPairs
        case Maybe AnyValue
mVal of
            Nothing -> DecodeException -> ExceptT DecodeException (Reader TOML) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DecodeException -> ExceptT DecodeException (Reader TOML) a)
-> DecodeException -> ExceptT DecodeException (Reader TOML) a
forall a b. (a -> b) -> a -> b
$ Key -> DecodeException
KeyNotFound Key
key
            Just anyVal :: AnyValue
anyVal -> case AnyValue -> Either TomlBiMapError a
backward AnyValue
anyVal of
                Right v :: a
v  -> a -> ExceptT DecodeException (Reader TOML) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
                Left err :: TomlBiMapError
err -> DecodeException -> ExceptT DecodeException (Reader TOML) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DecodeException -> ExceptT DecodeException (Reader TOML) a)
-> DecodeException -> ExceptT DecodeException (Reader TOML) a
forall a b. (a -> b) -> a -> b
$ TomlBiMapError -> DecodeException
BiMapError TomlBiMapError
err

    output :: a -> St a
    output :: a -> MaybeT (State TOML) a
output a :: a
a = do
        AnyValue
anyVal <- State TOML (Maybe AnyValue) -> MaybeT (State TOML) AnyValue
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (State TOML (Maybe AnyValue) -> MaybeT (State TOML) AnyValue)
-> State TOML (Maybe AnyValue) -> MaybeT (State TOML) AnyValue
forall a b. (a -> b) -> a -> b
$ Maybe AnyValue -> State TOML (Maybe AnyValue)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe AnyValue -> State TOML (Maybe AnyValue))
-> Maybe AnyValue -> State TOML (Maybe AnyValue)
forall a b. (a -> b) -> a -> b
$ (TomlBiMapError -> Maybe AnyValue)
-> (AnyValue -> Maybe AnyValue)
-> Either TomlBiMapError AnyValue
-> Maybe AnyValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe AnyValue -> TomlBiMapError -> Maybe AnyValue
forall a b. a -> b -> a
const Maybe AnyValue
forall a. Maybe a
Nothing) AnyValue -> Maybe AnyValue
forall a. a -> Maybe a
Just (Either TomlBiMapError AnyValue -> Maybe AnyValue)
-> Either TomlBiMapError AnyValue -> Maybe AnyValue
forall a b. (a -> b) -> a -> b
$ a -> Either TomlBiMapError AnyValue
forward a
a
        a
a a -> MaybeT (State TOML) () -> MaybeT (State TOML) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (TOML -> TOML) -> MaybeT (State TOML) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Key -> AnyValue -> TOML -> TOML
insertKeyAnyVal Key
key AnyValue
anyVal)

-- | Codec for boolean values.
bool :: Key -> TomlCodec Bool
bool :: Key -> TomlCodec Bool
bool = TomlBiMap Bool AnyValue -> Key -> TomlCodec Bool
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap Bool AnyValue
_Bool
{-# INLINE bool #-}

-- | Codec for integer values.
integer :: Key -> TomlCodec Integer
integer :: Key -> TomlCodec Integer
integer = TomlBiMap Integer AnyValue -> Key -> TomlCodec Integer
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap Integer AnyValue
_Integer
{-# INLINE integer #-}

-- | Codec for integer values.
int :: Key -> TomlCodec Int
int :: Key -> TomlCodec Int
int = TomlBiMap Int AnyValue -> Key -> TomlCodec Int
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap Int AnyValue
_Int
{-# INLINE int #-}

-- | Codec for natural values.
natural :: Key -> TomlCodec Natural
natural :: Key -> TomlCodec Natural
natural = TomlBiMap Natural AnyValue -> Key -> TomlCodec Natural
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap Natural AnyValue
_Natural
{-# INLINE natural #-}

-- | Codec for word values.
word :: Key -> TomlCodec Word
word :: Key -> TomlCodec Word
word = TomlBiMap Word AnyValue -> Key -> TomlCodec Word
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap Word AnyValue
_Word
{-# INLINE word #-}

{- | Codec for word8 values.

@since 1.2.0.0
-}
word8 :: Key -> TomlCodec Word8
word8 :: Key -> TomlCodec Word8
word8 = TomlBiMap Word8 AnyValue -> Key -> TomlCodec Word8
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap Word8 AnyValue
_Word8
{-# INLINE word8 #-}

-- | Codec for floating point values with double precision.
double :: Key -> TomlCodec Double
double :: Key -> TomlCodec Double
double = TomlBiMap Double AnyValue -> Key -> TomlCodec Double
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap Double AnyValue
_Double
{-# INLINE double #-}

-- | Codec for floating point values.
float :: Key -> TomlCodec Float
float :: Key -> TomlCodec Float
float = TomlBiMap Float AnyValue -> Key -> TomlCodec Float
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap Float AnyValue
_Float
{-# INLINE float #-}

-- | Codec for text values.
text :: Key -> TomlCodec Text
text :: Key -> TomlCodec Text
text = TomlBiMap Text AnyValue -> Key -> TomlCodec Text
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap Text AnyValue
_Text
{-# INLINE text #-}

-- | Codec for lazy text values.
lazyText :: Key -> TomlCodec L.Text
lazyText :: Key -> TomlCodec Text
lazyText = TomlBiMap Text AnyValue -> Key -> TomlCodec Text
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap Text AnyValue
_LText
{-# INLINE lazyText #-}

-- | Codec for text values with custom error messages for parsing.
textBy :: (a -> Text) -> (Text -> Either Text a) -> Key -> TomlCodec a
textBy :: (a -> Text) -> (Text -> Either Text a) -> Key -> TomlCodec a
textBy to :: a -> Text
to from :: Text -> Either Text a
from = TomlBiMap a AnyValue -> Key -> TomlCodec a
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match ((a -> Text) -> (Text -> Either Text a) -> TomlBiMap a AnyValue
forall a.
(a -> Text) -> (Text -> Either Text a) -> TomlBiMap a AnyValue
_TextBy a -> Text
to Text -> Either Text a
from)
{-# INLINE textBy #-}

-- | Codec for string values.
string :: Key -> TomlCodec String
string :: Key -> TomlCodec String
string = TomlBiMap String AnyValue -> Key -> TomlCodec String
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap String AnyValue
_String
{-# INLINE string #-}

-- | Codec for values with a 'Read' and 'Show' instance.
read :: (Show a, Read a) => Key -> TomlCodec a
read :: Key -> TomlCodec a
read = TomlBiMap a AnyValue -> Key -> TomlCodec a
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap a AnyValue
forall a. (Show a, Read a) => TomlBiMap a AnyValue
_Read
{-# INLINE read #-}

{- | Codec for general nullary sum data types with a 'Bounded', 'Enum', and
'Show' instance. This codec provides much better error messages than 'read' for
nullary sum types.

@since 1.1.1.0
-}
enumBounded :: (Bounded a, Enum a, Show a) => Key -> TomlCodec a
enumBounded :: Key -> TomlCodec a
enumBounded = TomlBiMap a AnyValue -> Key -> TomlCodec a
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap a AnyValue
forall a. (Show a, Enum a, Bounded a) => TomlBiMap a AnyValue
_EnumBounded
{-# INLINE enumBounded #-}

-- | Codec for text values as 'ByteString'.
byteString :: Key -> TomlCodec ByteString
byteString :: Key -> TomlCodec ByteString
byteString = TomlBiMap ByteString AnyValue -> Key -> TomlCodec ByteString
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap ByteString AnyValue
_ByteString
{-# INLINE byteString #-}

-- | Codec for text values as 'BL.ByteString'.
lazyByteString :: Key -> TomlCodec BL.ByteString
lazyByteString :: Key -> TomlCodec ByteString
lazyByteString = TomlBiMap ByteString AnyValue -> Key -> TomlCodec ByteString
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap ByteString AnyValue
_LByteString
{-# INLINE lazyByteString #-}

{- | Codec for positive integer array values as 'ByteString'.

@since 1.2.0.0
-}
byteStringArray :: Key -> TomlCodec ByteString
byteStringArray :: Key -> TomlCodec ByteString
byteStringArray = TomlBiMap ByteString AnyValue -> Key -> TomlCodec ByteString
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap ByteString AnyValue
_ByteStringArray
{-# INLINE byteStringArray #-}

{- | Codec for positive integer array values as lazy 'ByteString'.

@since 1.2.0.0
-}
lazyByteStringArray :: Key -> TomlCodec BL.ByteString
lazyByteStringArray :: Key -> TomlCodec ByteString
lazyByteStringArray = TomlBiMap ByteString AnyValue -> Key -> TomlCodec ByteString
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap ByteString AnyValue
_LByteStringArray
{-# INLINE lazyByteStringArray #-}

-- | Codec for zoned time values.
zonedTime :: Key -> TomlCodec ZonedTime
zonedTime :: Key -> TomlCodec ZonedTime
zonedTime = TomlBiMap ZonedTime AnyValue -> Key -> TomlCodec ZonedTime
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap ZonedTime AnyValue
_ZonedTime
{-# INLINE zonedTime #-}

-- | Codec for local time values.
localTime :: Key -> TomlCodec LocalTime
localTime :: Key -> TomlCodec LocalTime
localTime = TomlBiMap LocalTime AnyValue -> Key -> TomlCodec LocalTime
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap LocalTime AnyValue
_LocalTime
{-# INLINE localTime #-}

-- | Codec for day values.
day :: Key -> TomlCodec Day
day :: Key -> TomlCodec Day
day = TomlBiMap Day AnyValue -> Key -> TomlCodec Day
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap Day AnyValue
_Day
{-# INLINE day #-}

-- | Codec for time of day values.
timeOfDay :: Key -> TomlCodec TimeOfDay
timeOfDay :: Key -> TomlCodec TimeOfDay
timeOfDay = TomlBiMap TimeOfDay AnyValue -> Key -> TomlCodec TimeOfDay
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap TimeOfDay AnyValue
_TimeOfDay
{-# INLINE timeOfDay #-}

-- | Codec for list of values. Takes converter for single value and
-- returns a list of values.
arrayOf :: TomlBiMap a AnyValue -> Key -> TomlCodec [a]
arrayOf :: TomlBiMap a AnyValue -> Key -> TomlCodec [a]
arrayOf = TomlBiMap [a] AnyValue -> Key -> TomlCodec [a]
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match (TomlBiMap [a] AnyValue -> Key -> TomlCodec [a])
-> (TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue)
-> TomlBiMap a AnyValue
-> Key
-> TomlCodec [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue
forall a. TomlBiMap a AnyValue -> TomlBiMap [a] AnyValue
_Array
{-# INLINE arrayOf #-}

-- | Codec for sets. Takes converter for single value and
-- returns a set of values.
arraySetOf :: Ord a => TomlBiMap a AnyValue -> Key -> TomlCodec (Set a)
arraySetOf :: TomlBiMap a AnyValue -> Key -> TomlCodec (Set a)
arraySetOf = TomlBiMap (Set a) AnyValue -> Key -> TomlCodec (Set a)
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match (TomlBiMap (Set a) AnyValue -> Key -> TomlCodec (Set a))
-> (TomlBiMap a AnyValue -> TomlBiMap (Set a) AnyValue)
-> TomlBiMap a AnyValue
-> Key
-> TomlCodec (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlBiMap a AnyValue -> TomlBiMap (Set a) AnyValue
forall a.
Ord a =>
TomlBiMap a AnyValue -> TomlBiMap (Set a) AnyValue
_Set
{-# INLINE arraySetOf #-}

-- | Codec for sets of ints. Takes converter for single value and
-- returns a set of ints.
arrayIntSet :: Key -> TomlCodec IntSet
arrayIntSet :: Key -> TomlCodec IntSet
arrayIntSet = TomlBiMap IntSet AnyValue -> Key -> TomlCodec IntSet
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match TomlBiMap IntSet AnyValue
_IntSet
{-# INLINE arrayIntSet #-}

-- | Codec for hash sets. Takes converter for single hashable value and
-- returns a set of hashable values.
arrayHashSetOf
    :: (Hashable a, Eq a)
    => TomlBiMap a AnyValue
    -> Key
    -> TomlCodec (HashSet a)
arrayHashSetOf :: TomlBiMap a AnyValue -> Key -> TomlCodec (HashSet a)
arrayHashSetOf = TomlBiMap (HashSet a) AnyValue -> Key -> TomlCodec (HashSet a)
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match (TomlBiMap (HashSet a) AnyValue -> Key -> TomlCodec (HashSet a))
-> (TomlBiMap a AnyValue -> TomlBiMap (HashSet a) AnyValue)
-> TomlBiMap a AnyValue
-> Key
-> TomlCodec (HashSet a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlBiMap a AnyValue -> TomlBiMap (HashSet a) AnyValue
forall a.
(Eq a, Hashable a) =>
TomlBiMap a AnyValue -> TomlBiMap (HashSet a) AnyValue
_HashSet
{-# INLINE arrayHashSetOf #-}

-- | Codec for non- empty lists of values. Takes converter for single value and
-- returns a non-empty list of values.
arrayNonEmptyOf :: TomlBiMap a AnyValue -> Key -> TomlCodec (NonEmpty a)
arrayNonEmptyOf :: TomlBiMap a AnyValue -> Key -> TomlCodec (NonEmpty a)
arrayNonEmptyOf = TomlBiMap (NonEmpty a) AnyValue -> Key -> TomlCodec (NonEmpty a)
forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match (TomlBiMap (NonEmpty a) AnyValue -> Key -> TomlCodec (NonEmpty a))
-> (TomlBiMap a AnyValue -> TomlBiMap (NonEmpty a) AnyValue)
-> TomlBiMap a AnyValue
-> Key
-> TomlCodec (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlBiMap a AnyValue -> TomlBiMap (NonEmpty a) AnyValue
forall a. TomlBiMap a AnyValue -> TomlBiMap (NonEmpty a) AnyValue
_NonEmpty
{-# INLINE arrayNonEmptyOf #-}

----------------------------------------------------------------------------
-- Monoid codecs
----------------------------------------------------------------------------

{- | Codec for 'All' wrapper for boolean values.
Returns @'All' 'True'@ on missing fields.

@since 1.2.1.0
-}
all :: Key -> TomlCodec All
all :: Key -> TomlCodec All
all = (All -> Maybe Bool)
-> (Maybe Bool -> All)
-> Codec Env St (Maybe Bool) (Maybe Bool)
-> TomlCodec All
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
dimap (Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> (All -> Bool) -> All -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. All -> Bool
getAll) (Bool -> All
All (Bool -> All) -> (Maybe Bool -> Bool) -> Maybe Bool -> All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True) (Codec Env St (Maybe Bool) (Maybe Bool) -> TomlCodec All)
-> (Key -> Codec Env St (Maybe Bool) (Maybe Bool))
-> Key
-> TomlCodec All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlCodec Bool -> Codec Env St (Maybe Bool) (Maybe Bool)
forall (r :: * -> *) (w :: * -> *) c a.
(Alternative r, Applicative w) =>
Codec r w c a -> Codec r w (Maybe c) (Maybe a)
dioptional (TomlCodec Bool -> Codec Env St (Maybe Bool) (Maybe Bool))
-> (Key -> TomlCodec Bool)
-> Key
-> Codec Env St (Maybe Bool) (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> TomlCodec Bool
bool
{-# INLINE all #-}

{- | Codec for 'Any' wrapper for boolean values.
Returns @'Any' 'False'@ on missing fields.

@since 1.2.1.0
-}
any :: Key -> TomlCodec Any
any :: Key -> TomlCodec Any
any = (Any -> Maybe Bool)
-> (Maybe Bool -> Any)
-> Codec Env St (Maybe Bool) (Maybe Bool)
-> TomlCodec Any
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
dimap (Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> (Any -> Bool) -> Any -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Any -> Bool
getAny) (Bool -> Any
Any (Bool -> Any) -> (Maybe Bool -> Bool) -> Maybe Bool -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False) (Codec Env St (Maybe Bool) (Maybe Bool) -> TomlCodec Any)
-> (Key -> Codec Env St (Maybe Bool) (Maybe Bool))
-> Key
-> TomlCodec Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlCodec Bool -> Codec Env St (Maybe Bool) (Maybe Bool)
forall (r :: * -> *) (w :: * -> *) c a.
(Alternative r, Applicative w) =>
Codec r w c a -> Codec r w (Maybe c) (Maybe a)
dioptional (TomlCodec Bool -> Codec Env St (Maybe Bool) (Maybe Bool))
-> (Key -> TomlCodec Bool)
-> Key
-> Codec Env St (Maybe Bool) (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> TomlCodec Bool
bool
{-# INLINE any #-}

{- | Codec for 'Sum' wrapper for given converter's values.

@since 1.2.1.0
-}
sum :: (Key -> TomlCodec a) -> Key -> TomlCodec (Sum a)
sum :: (Key -> TomlCodec a) -> Key -> TomlCodec (Sum a)
sum codec :: Key -> TomlCodec a
codec = (Sum a -> a) -> (a -> Sum a) -> TomlCodec a -> TomlCodec (Sum 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
dimap Sum a -> a
forall a. Sum a -> a
getSum a -> Sum a
forall a. a -> Sum a
Sum (TomlCodec a -> TomlCodec (Sum a))
-> (Key -> TomlCodec a) -> Key -> TomlCodec (Sum a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> TomlCodec a
codec
{-# INLINE sum #-}

{- | Codec for 'Product' wrapper for given converter's values.

@since 1.2.1.0
-}
product :: (Key -> TomlCodec a) -> Key -> TomlCodec (Product a)
product :: (Key -> TomlCodec a) -> Key -> TomlCodec (Product a)
product codec :: Key -> TomlCodec a
codec = (Product a -> a)
-> (a -> Product a) -> TomlCodec a -> TomlCodec (Product 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
dimap Product a -> a
forall a. Product a -> a
getProduct a -> Product a
forall a. a -> Product a
Product (TomlCodec a -> TomlCodec (Product a))
-> (Key -> TomlCodec a) -> Key -> TomlCodec (Product a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> TomlCodec a
codec
{-# INLINE product #-}

{- | Codec for 'First' wrapper for given converter's values.

@since 1.2.1.0
-}
first :: (Key -> TomlCodec a) -> Key -> TomlCodec (First a)
first :: (Key -> TomlCodec a) -> Key -> TomlCodec (First a)
first codec :: Key -> TomlCodec a
codec = (First a -> Maybe a)
-> (Maybe a -> First a)
-> Codec Env St (Maybe a) (Maybe a)
-> TomlCodec (First 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
dimap First a -> Maybe a
forall a. First a -> Maybe a
getFirst Maybe a -> First a
forall a. Maybe a -> First a
First (Codec Env St (Maybe a) (Maybe a) -> TomlCodec (First a))
-> (Key -> Codec Env St (Maybe a) (Maybe a))
-> Key
-> TomlCodec (First a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlCodec a -> Codec Env St (Maybe a) (Maybe a)
forall (r :: * -> *) (w :: * -> *) c a.
(Alternative r, Applicative w) =>
Codec r w c a -> Codec r w (Maybe c) (Maybe a)
dioptional (TomlCodec a -> Codec Env St (Maybe a) (Maybe a))
-> (Key -> TomlCodec a) -> Key -> Codec Env St (Maybe a) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> TomlCodec a
codec
{-# INLINE first #-}

{- | Codec for 'Last' wrapper for given converter's values.

@since 1.2.1.0
-}
last :: (Key -> TomlCodec a) -> Key -> TomlCodec (Last a)
last :: (Key -> TomlCodec a) -> Key -> TomlCodec (Last a)
last codec :: Key -> TomlCodec a
codec = (Last a -> Maybe a)
-> (Maybe a -> Last a)
-> Codec Env St (Maybe a) (Maybe a)
-> TomlCodec (Last 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
dimap Last a -> Maybe a
forall a. Last a -> Maybe a
getLast Maybe a -> Last a
forall a. Maybe a -> Last a
Last (Codec Env St (Maybe a) (Maybe a) -> TomlCodec (Last a))
-> (Key -> Codec Env St (Maybe a) (Maybe a))
-> Key
-> TomlCodec (Last a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlCodec a -> Codec Env St (Maybe a) (Maybe a)
forall (r :: * -> *) (w :: * -> *) c a.
(Alternative r, Applicative w) =>
Codec r w c a -> Codec r w (Maybe c) (Maybe a)
dioptional (TomlCodec a -> Codec Env St (Maybe a) (Maybe a))
-> (Key -> TomlCodec a) -> Key -> Codec Env St (Maybe a) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> TomlCodec a
codec
{-# INLINE last #-}

----------------------------------------------------------------------------
-- Tables and arrays of tables
----------------------------------------------------------------------------

{- | Prepends given key to all errors that contain key. This function is used to
give better error messages. So when error happens we know all pieces of table
key, not only the last one.
-}
handleErrorInTable :: Key -> DecodeException -> Env a
handleErrorInTable :: Key -> DecodeException -> Env a
handleErrorInTable key :: Key
key = \case
    KeyNotFound name :: Key
name        -> DecodeException -> Env a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DecodeException -> Env a) -> DecodeException -> Env a
forall a b. (a -> b) -> a -> b
$ Key -> DecodeException
KeyNotFound (Key
key Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
name)
    TableNotFound name :: Key
name      -> DecodeException -> Env a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DecodeException -> Env a) -> DecodeException -> Env a
forall a b. (a -> b) -> a -> b
$ Key -> DecodeException
TableNotFound (Key
key Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
name)
    TypeMismatch name :: Key
name t1 :: Text
t1 t2 :: TValue
t2 -> DecodeException -> Env a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DecodeException -> Env a) -> DecodeException -> Env a
forall a b. (a -> b) -> a -> b
$ Key -> Text -> TValue -> DecodeException
TypeMismatch (Key
key Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
name) Text
t1 TValue
t2
    e :: DecodeException
e                       -> DecodeException -> Env a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DecodeException
e

-- | Run 'codecRead' function with given 'TOML' inside 'Control.Monad.Reader.ReaderT' context.
codecReadTOML :: TOML -> TomlCodec a -> Env a
codecReadTOML :: TOML -> TomlCodec a -> Env a
codecReadTOML toml :: TOML
toml codec :: TomlCodec a
codec = (TOML -> TOML) -> Env a -> Env a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (TOML -> TOML -> TOML
forall a b. a -> b -> a
const TOML
toml) (TomlCodec a -> Env a
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> r a
codecRead TomlCodec a
codec)

-- | Codec for tables. Use it when when you have nested objects.
table :: forall a . TomlCodec a -> Key -> TomlCodec a
table :: TomlCodec a -> Key -> TomlCodec a
table codec :: TomlCodec a
codec key :: Key
key = ExceptT DecodeException (Reader TOML) a
-> (a -> MaybeT (State TOML) a) -> TomlCodec a
forall (r :: * -> *) (w :: * -> *) c a.
r a -> (c -> w a) -> Codec r w c a
Codec ExceptT DecodeException (Reader TOML) a
input a -> MaybeT (State TOML) a
output
  where
    input :: Env a
    input :: ExceptT DecodeException (Reader TOML) a
input = do
        Maybe TOML
mTable <- (TOML -> Maybe TOML)
-> ExceptT DecodeException (Reader TOML) (Maybe TOML)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((TOML -> Maybe TOML)
 -> ExceptT DecodeException (Reader TOML) (Maybe TOML))
-> (TOML -> Maybe TOML)
-> ExceptT DecodeException (Reader TOML) (Maybe TOML)
forall a b. (a -> b) -> a -> b
$ Key -> PrefixMap TOML -> Maybe TOML
forall a. Key -> PrefixMap a -> Maybe a
Prefix.lookup Key
key (PrefixMap TOML -> Maybe TOML)
-> (TOML -> PrefixMap TOML) -> TOML -> Maybe TOML
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TOML -> PrefixMap TOML
tomlTables
        case Maybe TOML
mTable of
            Nothing   -> DecodeException -> ExceptT DecodeException (Reader TOML) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DecodeException -> ExceptT DecodeException (Reader TOML) a)
-> DecodeException -> ExceptT DecodeException (Reader TOML) a
forall a b. (a -> b) -> a -> b
$ Key -> DecodeException
TableNotFound Key
key
            Just toml :: TOML
toml -> TOML -> TomlCodec a -> ExceptT DecodeException (Reader TOML) a
forall a. TOML -> TomlCodec a -> Env a
codecReadTOML TOML
toml TomlCodec a
codec ExceptT DecodeException (Reader TOML) a
-> (DecodeException -> ExceptT DecodeException (Reader TOML) a)
-> ExceptT DecodeException (Reader TOML) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` Key -> DecodeException -> ExceptT DecodeException (Reader TOML) a
forall a. Key -> DecodeException -> Env a
handleErrorInTable Key
key

    output :: a -> St a
    output :: a -> MaybeT (State TOML) a
output a :: a
a = do
        Maybe TOML
mTable <- (TOML -> Maybe TOML) -> MaybeT (State TOML) (Maybe TOML)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((TOML -> Maybe TOML) -> MaybeT (State TOML) (Maybe TOML))
-> (TOML -> Maybe TOML) -> MaybeT (State TOML) (Maybe TOML)
forall a b. (a -> b) -> a -> b
$ Key -> PrefixMap TOML -> Maybe TOML
forall a. Key -> PrefixMap a -> Maybe a
Prefix.lookup Key
key (PrefixMap TOML -> Maybe TOML)
-> (TOML -> PrefixMap TOML) -> TOML -> Maybe TOML
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TOML -> PrefixMap TOML
tomlTables
        let toml :: TOML
toml = TOML -> Maybe TOML -> TOML
forall a. a -> Maybe a -> a
fromMaybe TOML
forall a. Monoid a => a
mempty Maybe TOML
mTable
        let newToml :: TOML
newToml = State TOML (Maybe a) -> TOML -> TOML
forall s a. State s a -> s -> s
execState (MaybeT (State TOML) a -> State TOML (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (State TOML) a -> State TOML (Maybe a))
-> MaybeT (State TOML) a -> State TOML (Maybe a)
forall a b. (a -> b) -> a -> b
$ TomlCodec a -> a -> MaybeT (State TOML) a
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> c -> w a
codecWrite TomlCodec a
codec a
a) TOML
toml
        a
a a -> MaybeT (State TOML) () -> MaybeT (State TOML) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (TOML -> TOML) -> MaybeT (State TOML) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Key -> TOML -> TOML -> TOML
insertTable Key
key TOML
newToml)

{- | 'Codec' for 'NonEmpty' list of values. Represented in TOML as array of
tables.
-}
nonEmpty :: forall a . TomlCodec a -> Key -> TomlCodec (NonEmpty a)
nonEmpty :: TomlCodec a -> Key -> TomlCodec (NonEmpty a)
nonEmpty codec :: TomlCodec a
codec key :: Key
key = ExceptT DecodeException (Reader TOML) (NonEmpty a)
-> (NonEmpty a -> MaybeT (State TOML) (NonEmpty a))
-> TomlCodec (NonEmpty a)
forall (r :: * -> *) (w :: * -> *) c a.
r a -> (c -> w a) -> Codec r w c a
Codec ExceptT DecodeException (Reader TOML) (NonEmpty a)
input NonEmpty a -> MaybeT (State TOML) (NonEmpty a)
output
  where
    input :: Env (NonEmpty a)
    input :: ExceptT DecodeException (Reader TOML) (NonEmpty a)
input = do
        Maybe (NonEmpty TOML)
mTables <- (TOML -> Maybe (NonEmpty TOML))
-> ExceptT DecodeException (Reader TOML) (Maybe (NonEmpty TOML))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((TOML -> Maybe (NonEmpty TOML))
 -> ExceptT DecodeException (Reader TOML) (Maybe (NonEmpty TOML)))
-> (TOML -> Maybe (NonEmpty TOML))
-> ExceptT DecodeException (Reader TOML) (Maybe (NonEmpty TOML))
forall a b. (a -> b) -> a -> b
$ Key -> HashMap Key (NonEmpty TOML) -> Maybe (NonEmpty TOML)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key (HashMap Key (NonEmpty TOML) -> Maybe (NonEmpty TOML))
-> (TOML -> HashMap Key (NonEmpty TOML))
-> TOML
-> Maybe (NonEmpty TOML)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TOML -> HashMap Key (NonEmpty TOML)
tomlTableArrays
        case Maybe (NonEmpty TOML)
mTables of
            Nothing    -> DecodeException
-> ExceptT DecodeException (Reader TOML) (NonEmpty a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (DecodeException
 -> ExceptT DecodeException (Reader TOML) (NonEmpty a))
-> DecodeException
-> ExceptT DecodeException (Reader TOML) (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ Key -> DecodeException
TableNotFound Key
key
            Just tomls :: NonEmpty TOML
tomls -> NonEmpty TOML
-> (TOML -> ExceptT DecodeException (Reader TOML) a)
-> ExceptT DecodeException (Reader TOML) (NonEmpty a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NonEmpty TOML
tomls ((TOML -> ExceptT DecodeException (Reader TOML) a)
 -> ExceptT DecodeException (Reader TOML) (NonEmpty a))
-> (TOML -> ExceptT DecodeException (Reader TOML) a)
-> ExceptT DecodeException (Reader TOML) (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ \toml :: TOML
toml ->
                TOML -> TomlCodec a -> ExceptT DecodeException (Reader TOML) a
forall a. TOML -> TomlCodec a -> Env a
codecReadTOML TOML
toml TomlCodec a
codec ExceptT DecodeException (Reader TOML) a
-> (DecodeException -> ExceptT DecodeException (Reader TOML) a)
-> ExceptT DecodeException (Reader TOML) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` Key -> DecodeException -> ExceptT DecodeException (Reader TOML) a
forall a. Key -> DecodeException -> Env a
handleErrorInTable Key
key

    -- adds all TOML objects to the existing list if there are some
    output :: NonEmpty a -> St (NonEmpty a)
    output :: NonEmpty a -> MaybeT (State TOML) (NonEmpty a)
output as :: NonEmpty a
as = do
        let tomls :: NonEmpty TOML
tomls = (a -> TOML) -> NonEmpty a -> NonEmpty TOML
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TomlCodec a -> a -> TOML
forall a. TomlCodec a -> a -> TOML
execTomlCodec TomlCodec a
codec) NonEmpty a
as
        Maybe (NonEmpty TOML)
mTables <- (TOML -> Maybe (NonEmpty TOML))
-> MaybeT (State TOML) (Maybe (NonEmpty TOML))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((TOML -> Maybe (NonEmpty TOML))
 -> MaybeT (State TOML) (Maybe (NonEmpty TOML)))
-> (TOML -> Maybe (NonEmpty TOML))
-> MaybeT (State TOML) (Maybe (NonEmpty TOML))
forall a b. (a -> b) -> a -> b
$ Key -> HashMap Key (NonEmpty TOML) -> Maybe (NonEmpty TOML)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key (HashMap Key (NonEmpty TOML) -> Maybe (NonEmpty TOML))
-> (TOML -> HashMap Key (NonEmpty TOML))
-> TOML
-> Maybe (NonEmpty TOML)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TOML -> HashMap Key (NonEmpty TOML)
tomlTableArrays

        let newTomls :: NonEmpty TOML
newTomls = case Maybe (NonEmpty TOML)
mTables of
                Nothing       -> NonEmpty TOML
tomls
                Just oldTomls :: NonEmpty TOML
oldTomls -> NonEmpty TOML
oldTomls NonEmpty TOML -> NonEmpty TOML -> NonEmpty TOML
forall a. Semigroup a => a -> a -> a
<> NonEmpty TOML
tomls

        NonEmpty a
as NonEmpty a
-> MaybeT (State TOML) () -> MaybeT (State TOML) (NonEmpty a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (TOML -> TOML) -> MaybeT (State TOML) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Key -> NonEmpty TOML -> TOML -> TOML
insertTableArrays Key
key NonEmpty TOML
newTomls)

-- | 'Codec' for list of values. Represented in TOML as array of tables.
list :: forall a . TomlCodec a -> Key -> TomlCodec [a]
list :: TomlCodec a -> Key -> TomlCodec [a]
list codec :: TomlCodec a
codec key :: Key
key = Codec :: forall (r :: * -> *) (w :: * -> *) c a.
r a -> (c -> w a) -> Codec r w c a
Codec
    { codecRead :: Env [a]
codecRead = (NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
toList (NonEmpty a -> [a]) -> Env (NonEmpty a) -> Env [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Codec Env St (NonEmpty a) (NonEmpty a) -> Env (NonEmpty a)
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> r a
codecRead Codec Env St (NonEmpty a) (NonEmpty a)
nonEmptyCodec) Env [a] -> (DecodeException -> Env [a]) -> Env [a]
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \case
        TableNotFound errKey :: Key
errKey | Key
errKey Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
key -> [a] -> Env [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        err :: DecodeException
err -> DecodeException -> Env [a]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DecodeException
err
    , codecWrite :: [a] -> St [a]
codecWrite = \case
        [] -> [a] -> St [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        l :: [a]
l@(x :: a
x:xs :: [a]
xs) -> [a]
l [a] -> St (NonEmpty a) -> St [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Codec Env St (NonEmpty a) (NonEmpty a)
-> NonEmpty a -> St (NonEmpty a)
forall (r :: * -> *) (w :: * -> *) c a. Codec r w c a -> c -> w a
codecWrite Codec Env St (NonEmpty a) (NonEmpty a)
nonEmptyCodec (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs)
    }
  where
    nonEmptyCodec :: TomlCodec (NonEmpty a)
    nonEmptyCodec :: Codec Env St (NonEmpty a) (NonEmpty a)
nonEmptyCodec = TomlCodec a -> Key -> Codec Env St (NonEmpty a) (NonEmpty a)
forall a. TomlCodec a -> Key -> TomlCodec (NonEmpty a)
nonEmpty TomlCodec a
codec Key
key

{- | 'Codec' for set of values. Represented in TOML as array of tables.

@since 1.2.0.0
-}
set :: forall a . Ord a => TomlCodec a -> Key -> TomlCodec (Set a)
set :: TomlCodec a -> Key -> TomlCodec (Set a)
set codec :: TomlCodec a
codec key :: Key
key = (Set a -> [a])
-> ([a] -> Set a) -> Codec Env St [a] [a] -> TomlCodec (Set 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
dimap Set a -> [a]
forall a. Set a -> [a]
S.toList [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList (TomlCodec a -> Key -> Codec Env St [a] [a]
forall a. TomlCodec a -> Key -> TomlCodec [a]
list TomlCodec a
codec Key
key)
{-# INLINE set #-}

{- | 'Codec' for HashSet of values. Represented in TOML as array of tables.

@since 1.2.0.0
-}

hashSet :: forall a . (Hashable a, Eq a) => TomlCodec a -> Key -> TomlCodec (HashSet a)
hashSet :: TomlCodec a -> Key -> TomlCodec (HashSet a)
hashSet codec :: TomlCodec a
codec key :: Key
key = (HashSet a -> [a])
-> ([a] -> HashSet a)
-> Codec Env St [a] [a]
-> TomlCodec (HashSet 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
dimap HashSet a -> [a]
forall a. HashSet a -> [a]
HS.toList [a] -> HashSet a
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList (TomlCodec a -> Key -> Codec Env St [a] [a]
forall a. TomlCodec a -> Key -> TomlCodec [a]
list TomlCodec a
codec Key
key)
{-# INLINE hashSet #-}

----------------------------------------------------------------------------
-- Map-like combinators
----------------------------------------------------------------------------

{- | Bidirectional codec for 'Map'. It takes birectional converter for keys and
values and produces bidirectional codec for 'Map'. Currently it works only with array
of tables, so you need to specify 'Map's in TOML files like this:

@
myMap =
    [ { name = "foo", payload = 42 }
    , { name = "bar", payload = 69 }
    ]
@

'TomlCodec' for such TOML field can look like this:

@
Toml.'map' (Toml.'text' "name") (Toml.'int' "payload") "myMap"
@

If there's no key with the name @"myMap"@ then empty 'Map' is returned.

@since 1.2.1.0
-}
map :: forall k v .
       Ord k
    => TomlCodec k  -- ^ Codec for 'Map' keys
    -> TomlCodec v  -- ^ Codec for 'Map' values
    -> Key          -- ^ TOML key where 'Map' is stored
    -> TomlCodec (Map k v)  -- ^ Codec for the 'Map'
map :: TomlCodec k -> TomlCodec v -> Key -> TomlCodec (Map k v)
map keyCodec :: TomlCodec k
keyCodec valCodec :: TomlCodec v
valCodec key :: Key
key = ExceptT DecodeException (Reader TOML) (Map k v)
-> (Map k v -> MaybeT (State TOML) (Map k v))
-> TomlCodec (Map k v)
forall (r :: * -> *) (w :: * -> *) c a.
r a -> (c -> w a) -> Codec r w c a
Codec ExceptT DecodeException (Reader TOML) (Map k v)
input Map k v -> MaybeT (State TOML) (Map k v)
output
  where
    input :: Env (Map k v)
    input :: ExceptT DecodeException (Reader TOML) (Map k v)
input = do
        Maybe (NonEmpty TOML)
mTables <- (TOML -> Maybe (NonEmpty TOML))
-> ExceptT DecodeException (Reader TOML) (Maybe (NonEmpty TOML))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((TOML -> Maybe (NonEmpty TOML))
 -> ExceptT DecodeException (Reader TOML) (Maybe (NonEmpty TOML)))
-> (TOML -> Maybe (NonEmpty TOML))
-> ExceptT DecodeException (Reader TOML) (Maybe (NonEmpty TOML))
forall a b. (a -> b) -> a -> b
$ Key -> HashMap Key (NonEmpty TOML) -> Maybe (NonEmpty TOML)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key (HashMap Key (NonEmpty TOML) -> Maybe (NonEmpty TOML))
-> (TOML -> HashMap Key (NonEmpty TOML))
-> TOML
-> Maybe (NonEmpty TOML)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TOML -> HashMap Key (NonEmpty TOML)
tomlTableArrays
        case Maybe (NonEmpty TOML)
mTables of
            Nothing -> Map k v -> ExceptT DecodeException (Reader TOML) (Map k v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map k v
forall k a. Map k a
Map.empty
            Just tomls :: NonEmpty TOML
tomls -> ([(k, v)] -> Map k v)
-> ExceptT DecodeException (Reader TOML) [(k, v)]
-> ExceptT DecodeException (Reader TOML) (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (ExceptT DecodeException (Reader TOML) [(k, v)]
 -> ExceptT DecodeException (Reader TOML) (Map k v))
-> ExceptT DecodeException (Reader TOML) [(k, v)]
-> ExceptT DecodeException (Reader TOML) (Map k v)
forall a b. (a -> b) -> a -> b
$ [TOML]
-> (TOML -> ExceptT DecodeException (Reader TOML) (k, v))
-> ExceptT DecodeException (Reader TOML) [(k, v)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (NonEmpty TOML -> [TOML]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TOML
tomls) ((TOML -> ExceptT DecodeException (Reader TOML) (k, v))
 -> ExceptT DecodeException (Reader TOML) [(k, v)])
-> (TOML -> ExceptT DecodeException (Reader TOML) (k, v))
-> ExceptT DecodeException (Reader TOML) [(k, v)]
forall a b. (a -> b) -> a -> b
$ \toml :: TOML
toml -> do
                k
k <- TOML -> TomlCodec k -> Env k
forall a. TOML -> TomlCodec a -> Env a
codecReadTOML TOML
toml TomlCodec k
keyCodec
                v
v <- TOML -> TomlCodec v -> Env v
forall a. TOML -> TomlCodec a -> Env a
codecReadTOML TOML
toml TomlCodec v
valCodec
                (k, v) -> ExceptT DecodeException (Reader TOML) (k, v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (k
k, v
v)

    output :: Map k v -> St (Map k v)
    output :: Map k v -> MaybeT (State TOML) (Map k v)
output dict :: Map k v
dict = do
        let tomls :: [TOML]
tomls = ((k, v) -> TOML) -> [(k, v)] -> [TOML]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                (\(k :: k
k, v :: v
v) -> TomlCodec k -> k -> TOML
forall a. TomlCodec a -> a -> TOML
execTomlCodec TomlCodec k
keyCodec k
k TOML -> TOML -> TOML
forall a. Semigroup a => a -> a -> a
<> TomlCodec v -> v -> TOML
forall a. TomlCodec a -> a -> TOML
execTomlCodec TomlCodec v
valCodec v
v)
                (Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k v
dict)

        Maybe (NonEmpty TOML)
mTables <- (TOML -> Maybe (NonEmpty TOML))
-> MaybeT (State TOML) (Maybe (NonEmpty TOML))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((TOML -> Maybe (NonEmpty TOML))
 -> MaybeT (State TOML) (Maybe (NonEmpty TOML)))
-> (TOML -> Maybe (NonEmpty TOML))
-> MaybeT (State TOML) (Maybe (NonEmpty TOML))
forall a b. (a -> b) -> a -> b
$ Key -> HashMap Key (NonEmpty TOML) -> Maybe (NonEmpty TOML)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key (HashMap Key (NonEmpty TOML) -> Maybe (NonEmpty TOML))
-> (TOML -> HashMap Key (NonEmpty TOML))
-> TOML
-> Maybe (NonEmpty TOML)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TOML -> HashMap Key (NonEmpty TOML)
tomlTableArrays

        let updateAction :: TOML -> TOML
            updateAction :: TOML -> TOML
updateAction = case Maybe (NonEmpty TOML)
mTables of
                Nothing -> case [TOML]
tomls of
                    []   -> TOML -> TOML
forall a. a -> a
id
                    t :: TOML
t:ts :: [TOML]
ts -> Key -> NonEmpty TOML -> TOML -> TOML
insertTableArrays Key
key (TOML
t TOML -> [TOML] -> NonEmpty TOML
forall a. a -> [a] -> NonEmpty a
:| [TOML]
ts)
                Just (t :: TOML
t :| ts :: [TOML]
ts) ->
                    Key -> NonEmpty TOML -> TOML -> TOML
insertTableArrays Key
key (NonEmpty TOML -> TOML -> TOML) -> NonEmpty TOML -> TOML -> TOML
forall a b. (a -> b) -> a -> b
$ TOML
t TOML -> [TOML] -> NonEmpty TOML
forall a. a -> [a] -> NonEmpty a
:| ([TOML]
ts [TOML] -> [TOML] -> [TOML]
forall a. [a] -> [a] -> [a]
++ [TOML]
tomls)

        Map k v
dict Map k v -> MaybeT (State TOML) () -> MaybeT (State TOML) (Map k v)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (TOML -> TOML) -> MaybeT (State TOML) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify TOML -> TOML
updateAction