{-# LANGUAGE ApplicativeDo   #-}
{-# LANGUAGE CPP             #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TupleSections   #-}

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

TOML-specific combinators for converting between TOML and Haskell Map-like data
types.

There are two way to represent map-like structures with the @tomland@ library.

* Map structure with the key and value represented as key-value pairs:

    @
    foo =
        [ {myKey = "name", myVal = 42}
        , {myKey = "otherName", myVal = 100}
        ]
    @

* Map structure as a table with the @TOML@ key as the map key:

    @
    [foo]
        name = 42
        otherName = 100
    @

You can find both types of the codecs in this module for different map-like
structures. See the following table for the heads up:

+------------------------------+--------------------------------+----------------------------------------------------+
|         Haskell Type         |             @TOML@             |                    'TomlCodec'                     |
+==============================+================================+====================================================+
| __@'Map' 'Int' 'Text'@__     | @x = [{k = 42, v = "foo"}]@    | @'map' ('Toml.int' "k") ('Toml.text' "v") "x"@     |
+------------------------------+--------------------------------+----------------------------------------------------+
| __@'Map' 'Text' 'Int'@__     | @x = {a = 42, b = 11}@         | @'tableMap' 'Toml._KeyText' 'Toml.int' "x"@        |
+------------------------------+--------------------------------+----------------------------------------------------+
| __@'HashMap' 'Int' 'Text'@__ | @x = [{k = 42, v = "foo"}]@    | @'hashMap' ('Toml.int' "k") ('Toml.text' "v") "x"@ |
+------------------------------+--------------------------------+----------------------------------------------------+
| __@'HashMap' 'Text' 'Int'@__ | @x = {a = 42, b = 11}@         | @'tableHashMap' 'Toml._KeyText' 'Toml.int' "x"@    |
+------------------------------+--------------------------------+----------------------------------------------------+
| __@'IntMap' 'Text'@__        | @x = [{k = 42, v = "foo"}]@    | @'intMap' ('Toml.int' "k") ('Toml.text' "v") "x"@  |
+------------------------------+--------------------------------+----------------------------------------------------+
| __@'IntMap' 'Text'@__        | @x = {1 = "one", 2 = "two"}@   | @'tableIntMap' 'Toml._KeyInt' 'Toml.text' "x"@     |
+------------------------------+--------------------------------+----------------------------------------------------+

__Note:__ in case of the missing key on the @TOML@ side an empty map structure
is returned.

@since 1.3.0.0
-}

module Toml.Codec.Combinator.Map
    ( -- * 'Map' codecs
      map
    , tableMap
      -- * 'HashMap' codecs
    , hashMap
    , tableHashMap
      -- * 'IntMap' codecs
    , intMap
    , tableIntMap
    ) where

import Prelude hiding (map)

import Control.Applicative (empty)
import Control.Monad (forM_)
import Control.Monad.State (gets, modify)
import Data.HashMap.Strict (HashMap)
import Data.Hashable (Hashable)
import Data.IntMap.Strict (IntMap)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map.Strict (Map)
import Data.Maybe (fromMaybe)
import Data.Traversable (for)
import Validation (Validation (..))

import Toml.Codec.BiMap (BiMap (..), TomlBiMap)
import Toml.Codec.Code (execTomlCodec)
import Toml.Codec.Combinator.Common (whenLeftBiMapError)
import Toml.Codec.Types (Codec (..), TomlCodec, TomlEnv, TomlState (..))
import Toml.Type.Key (Key, pattern (:||))
import Toml.Type.TOML (TOML (..), insertTable, insertTableArrays)

import qualified Data.HashMap.Strict as HashMap
import qualified Data.IntMap.Strict as IntMap
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map

import qualified Toml.Type.PrefixTree as Prefix


{- | 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 :: forall k v.
Ord k =>
TomlCodec k -> TomlCodec v -> Key -> TomlCodec (Map k v)
map = Map k v
-> (Map k v -> [(k, v)])
-> ([(k, v)] -> Map k v)
-> TomlCodec k
-> TomlCodec v
-> Key
-> TomlCodec (Map k v)
forall map k v.
map
-> (map -> [(k, v)])
-> ([(k, v)] -> map)
-> TomlCodec k
-> TomlCodec v
-> Key
-> TomlCodec map
internalMap Map k v
forall k a. Map k a
Map.empty Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

{- | This 'TomlCodec' helps you to convert TOML key-value pairs
directly to 'Map' using TOML keys as 'Map' keys. It can be convenient
if your 'Map' keys are types like 'Text' or 'Int' and you want to work with raw
TOML keys directly.

For example, if you have TOML like this:

@
[colours]
yellow = "#FFFF00"
red    = { red = 255, green = 0, blue = 0 }
pink   = "#FFC0CB"
@

You want to convert such TOML configuration into the following Haskell
types:


@
__data__ Rgb = Rgb
    { rgbRed   :: Int
    , rgbGreen :: Int
    , rgbBlue  :: Int
    }

__data__ Colour
    = Hex Text
    | RGB Rgb

colourCodec :: 'TomlCodec' Colour
colourCodec = ...

__data__ ColourConfig = ColourConfig
    { configColours :: 'Map' 'Text' Colour
    }
@

And you want in the result to have a 'Map' like this:

@
'Map.fromList'
    [ "yellow" -> Hex "#FFFF00"
    , "pink"   -> Hex "#FFC0CB"
    , "red"    -> Rgb 255 0 0
    ]
@

You can use 'tableMap' to define 'TomlCodec' in the following way:

@
colourConfigCodec :: 'TomlCodec' ColourConfig
colourConfigCodec = ColourConfig
    \<$\> Toml.'tableMap' Toml._KeyText colourCodec "colours" .= configColours
@

__Hint:__ You can use 'Toml.Codec.BiMap._KeyText' or
'Toml.Codec.BiMap._KeyString' to convert betwen TOML keys and 'Map'
keys (or you can write your custom 'TomlBiMap').

__NOTE__: Unlike the 'map' codec, this codec is less flexible (i.e. it doesn't
allow to have arbitrary structures as 'Key's, it works only for
text-like keys), but can be helpful if you want to save a few
keystrokes during TOML configuration. A similar TOML configuration,
but suitable for the 'map' codec will look like this:

@
colours =
    [ { key = "yellow", hex = "#FFFF00" }
    , { key = "pink",   hex = "#FFC0CB" }
    , { key = "red",    rgb = { red = 255, green = 0, blue = 0 } }
    ]
@

@since 1.3.0.0
-}
tableMap
    :: forall k v
    .  Ord k
    => TomlBiMap Key k
    -- ^ Bidirectional converter between TOML 'Key's and 'Map' keys
    -> (Key -> TomlCodec v)
    -- ^ Codec for 'Map' values for the corresponding 'Key'
    -> Key
    -- ^ Table name for 'Map'
    -> TomlCodec (Map k v)
tableMap :: forall k v.
Ord k =>
TomlBiMap Key k
-> (Key -> TomlCodec v) -> Key -> TomlCodec (Map k v)
tableMap = Map k v
-> (Map k v -> [(k, v)])
-> ([(k, v)] -> Map k v)
-> TomlBiMap Key k
-> (Key -> TomlCodec v)
-> Key
-> TomlCodec (Map k v)
forall map k v.
map
-> (map -> [(k, v)])
-> ([(k, v)] -> map)
-> TomlBiMap Key k
-> (Key -> TomlCodec v)
-> Key
-> TomlCodec map
internalTableMap Map k v
forall k a. Map k a
Map.empty Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

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

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

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

@
Toml.'hashMap' (Toml.'text' "name") (Toml.'int' "payload") "myHashMap"
@

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

@since 1.3.0.0
-}
hashMap
    :: forall k v
#if MIN_VERSION_hashable(1,4,0)
    .  (Hashable k)
#else
    .  (Eq k, Hashable k)
#endif
    => TomlCodec k  -- ^ Codec for 'HashMap' keys
    -> TomlCodec v  -- ^ Codec for 'HashMap' values
    -> Key          -- ^ TOML key where 'HashMap' is stored
    -> TomlCodec (HashMap k v)  -- ^ Codec for the 'HashMap'
hashMap :: forall k v.
Hashable k =>
TomlCodec k -> TomlCodec v -> Key -> TomlCodec (HashMap k v)
hashMap = HashMap k v
-> (HashMap k v -> [(k, v)])
-> ([(k, v)] -> HashMap k v)
-> TomlCodec k
-> TomlCodec v
-> Key
-> TomlCodec (HashMap k v)
forall map k v.
map
-> (map -> [(k, v)])
-> ([(k, v)] -> map)
-> TomlCodec k
-> TomlCodec v
-> Key
-> TomlCodec map
internalMap HashMap k v
forall k v. HashMap k v
HashMap.empty HashMap k v -> [(k, v)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList [(k, v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList

{- | This 'TomlCodec' helps to convert TOML key-value pairs
directly to 'HashMap' using TOML keys as 'HashMap' keys.
It can be convenient if your 'HashMap' keys are types like 'Text' or 'Int' and
you want to work with raw TOML keys directly.

For example, if you can write your 'HashMap' in @TOML@ like this:

@
[myHashMap]
key1 = "value1"
key2 = "value2"
@

@since 1.3.0.0
-}
tableHashMap
    :: forall k v
#if MIN_VERSION_hashable(1,4,0)
    .  (Hashable k)
#else
    .  (Eq k, Hashable k)
#endif
    => TomlBiMap Key k
    -- ^ Bidirectional converter between TOML 'Key's and 'HashMap' keys
    -> (Key -> TomlCodec v)
    -- ^ Codec for 'HashMap' values for the corresponding 'Key'
    -> Key
    -- ^ Table name for 'HashMap'
    -> TomlCodec (HashMap k v)
tableHashMap :: forall k v.
Hashable k =>
TomlBiMap Key k
-> (Key -> TomlCodec v) -> Key -> TomlCodec (HashMap k v)
tableHashMap = HashMap k v
-> (HashMap k v -> [(k, v)])
-> ([(k, v)] -> HashMap k v)
-> TomlBiMap Key k
-> (Key -> TomlCodec v)
-> Key
-> TomlCodec (HashMap k v)
forall map k v.
map
-> (map -> [(k, v)])
-> ([(k, v)] -> map)
-> TomlBiMap Key k
-> (Key -> TomlCodec v)
-> Key
-> TomlCodec map
internalTableMap HashMap k v
forall k v. HashMap k v
HashMap.empty HashMap k v -> [(k, v)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList [(k, v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList

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

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

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

@
Toml.'intMap' (Toml.'text' "name") (Toml.'int' "payload") "myIntMap"
@

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

@since 1.3.0.0
-}
intMap
    :: forall v
    .  TomlCodec Int  -- ^ Codec for 'IntMap' keys
    -> TomlCodec v  -- ^ Codec for 'IntMap' values
    -> Key          -- ^ TOML key where 'IntMap' is stored
    -> TomlCodec (IntMap v)  -- ^ Codec for the 'IntMap'
intMap :: forall v.
TomlCodec Int -> TomlCodec v -> Key -> TomlCodec (IntMap v)
intMap = IntMap v
-> (IntMap v -> [(Int, v)])
-> ([(Int, v)] -> IntMap v)
-> TomlCodec Int
-> TomlCodec v
-> Key
-> TomlCodec (IntMap v)
forall map k v.
map
-> (map -> [(k, v)])
-> ([(k, v)] -> map)
-> TomlCodec k
-> TomlCodec v
-> Key
-> TomlCodec map
internalMap IntMap v
forall a. IntMap a
IntMap.empty IntMap v -> [(Int, v)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList [(Int, v)] -> IntMap v
forall a. [(Int, a)] -> IntMap a
IntMap.fromList

{- | This 'TomlCodec' helps to convert TOML key-value pairs
directly to 'IntMap' using TOML 'Int' keys as 'IntMap' keys.

For example, if you can write your 'IntMap' in @TOML@ like this:

@
[myIntMap]
1 = "value1"
2 = "value2"
@

@since 1.3.0.0
-}
tableIntMap
    :: forall v
    .  TomlBiMap Key Int
    -- ^ Bidirectional converter between TOML 'Key's and 'IntMap' keys
    -> (Key -> TomlCodec v)
    -- ^ Codec for 'IntMap' values for the corresponding 'Key'
    -> Key
    -- ^ Table name for 'IntMap'
    -> TomlCodec (IntMap v)
tableIntMap :: forall v.
TomlBiMap Key Int
-> (Key -> TomlCodec v) -> Key -> TomlCodec (IntMap v)
tableIntMap = IntMap v
-> (IntMap v -> [(Int, v)])
-> ([(Int, v)] -> IntMap v)
-> TomlBiMap Key Int
-> (Key -> TomlCodec v)
-> Key
-> TomlCodec (IntMap v)
forall map k v.
map
-> (map -> [(k, v)])
-> ([(k, v)] -> map)
-> TomlBiMap Key k
-> (Key -> TomlCodec v)
-> Key
-> TomlCodec map
internalTableMap IntMap v
forall a. IntMap a
IntMap.empty IntMap v -> [(Int, v)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList [(Int, v)] -> IntMap v
forall a. [(Int, a)] -> IntMap a
IntMap.fromList


----------------------------------------------------------------------------
-- Internal
----------------------------------------------------------------------------

internalMap :: forall map k v
    .  map  -- ^ empty map
    -> (map -> [(k, v)])  -- ^ toList function
    -> ([(k, v)] -> map)  -- ^ fromList function
    -> TomlCodec k  -- ^ Codec for Map keys
    -> TomlCodec v  -- ^ Codec for Map values
    -> Key          -- ^ TOML key where Map is stored
    -> TomlCodec map  -- ^ Codec for the Map
internalMap :: forall map k v.
map
-> (map -> [(k, v)])
-> ([(k, v)] -> map)
-> TomlCodec k
-> TomlCodec v
-> Key
-> TomlCodec map
internalMap map
emptyMap map -> [(k, v)]
toListMap [(k, v)] -> map
fromListMap TomlCodec k
keyCodec TomlCodec v
valCodec Key
key = TomlEnv map -> (map -> TomlState map) -> Codec map map
forall i o. TomlEnv o -> (i -> TomlState o) -> Codec i o
Codec TomlEnv map
input map -> TomlState map
output
  where
    input :: TomlEnv map
    input :: TomlEnv map
input = \TOML
t -> case 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))
-> HashMap Key (NonEmpty TOML) -> Maybe (NonEmpty TOML)
forall a b. (a -> b) -> a -> b
$ TOML -> HashMap Key (NonEmpty TOML)
tomlTableArrays TOML
t of
        Maybe (NonEmpty TOML)
Nothing -> map -> Validation [TomlDecodeError] map
forall e a. a -> Validation e a
Success map
emptyMap
        Just NonEmpty TOML
tomls -> ([(k, v)] -> map)
-> Validation [TomlDecodeError] [(k, v)]
-> Validation [TomlDecodeError] map
forall a b.
(a -> b)
-> Validation [TomlDecodeError] a -> Validation [TomlDecodeError] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, v)] -> map
fromListMap (Validation [TomlDecodeError] [(k, v)]
 -> Validation [TomlDecodeError] map)
-> Validation [TomlDecodeError] [(k, v)]
-> Validation [TomlDecodeError] map
forall a b. (a -> b) -> a -> b
$ [TOML]
-> (TOML -> Validation [TomlDecodeError] (k, v))
-> Validation [TomlDecodeError] [(k, v)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (NonEmpty TOML -> [TOML]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TOML
tomls) ((TOML -> Validation [TomlDecodeError] (k, v))
 -> Validation [TomlDecodeError] [(k, v)])
-> (TOML -> Validation [TomlDecodeError] (k, v))
-> Validation [TomlDecodeError] [(k, v)]
forall a b. (a -> b) -> a -> b
$ \TOML
toml -> do
            k
k <- TomlCodec k -> TomlEnv k
forall i o. Codec i o -> TomlEnv o
codecRead TomlCodec k
keyCodec TOML
toml
            v
v <- TomlCodec v -> TomlEnv v
forall i o. Codec i o -> TomlEnv o
codecRead TomlCodec v
valCodec TOML
toml
            pure (k
k, v
v)

    output :: map -> TomlState map
    output :: map -> TomlState map
output map
dict = do
        let tomls :: [TOML]
tomls = ((k, v) -> TOML) -> [(k, v)] -> [TOML]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                (\(k
k, 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)]
toListMap map
dict)

        Maybe (NonEmpty TOML)
mTables <- (TOML -> Maybe (NonEmpty TOML))
-> TomlState (Maybe (NonEmpty TOML))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((TOML -> Maybe (NonEmpty TOML))
 -> TomlState (Maybe (NonEmpty TOML)))
-> (TOML -> Maybe (NonEmpty TOML))
-> TomlState (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
                Maybe (NonEmpty TOML)
Nothing -> case [TOML]
tomls of
                    []   -> TOML -> TOML
forall a. a -> a
id
                    TOML
t:[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 (TOML
t :| [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
dict map -> TomlState () -> TomlState map
forall a b. a -> TomlState b -> TomlState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (TOML -> TOML) -> TomlState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify TOML -> TOML
updateAction

internalTableMap
    :: forall map k v
    .  map  -- ^ empty map
    -> (map -> [(k, v)])  -- ^ toList function
    -> ([(k, v)] -> map)  -- ^ fromList function
    -> TomlBiMap Key k
    -- ^ Bidirectional converter between TOML 'Key's and Map keys
    -> (Key -> TomlCodec v)
    -- ^ Codec for Map values for the corresponding 'Key'
    -> Key
    -- ^ Table name for Map
    -> TomlCodec map
internalTableMap :: forall map k v.
map
-> (map -> [(k, v)])
-> ([(k, v)] -> map)
-> TomlBiMap Key k
-> (Key -> TomlCodec v)
-> Key
-> TomlCodec map
internalTableMap map
emptyMap map -> [(k, v)]
toListMap [(k, v)] -> map
fromListMap TomlBiMap Key k
keyBiMap Key -> TomlCodec v
valCodec Key
tableName =
    TomlEnv map -> (map -> TomlState map) -> Codec map map
forall i o. TomlEnv o -> (i -> TomlState o) -> Codec i o
Codec TomlEnv map
input map -> TomlState map
output
  where
    input :: TomlEnv map
    input :: TomlEnv map
input = \TOML
t -> case Key -> PrefixMap TOML -> Maybe TOML
forall a. Key -> PrefixMap a -> Maybe a
Prefix.lookup Key
tableName (PrefixMap TOML -> Maybe TOML) -> PrefixMap TOML -> Maybe TOML
forall a b. (a -> b) -> a -> b
$ TOML -> PrefixMap TOML
tomlTables TOML
t of
        Maybe TOML
Nothing -> map -> Validation [TomlDecodeError] map
forall e a. a -> Validation e a
Success map
emptyMap
        Just TOML
toml ->
            let valKeys :: [Key]
valKeys = HashMap Key AnyValue -> [Key]
forall k v. HashMap k v -> [k]
HashMap.keys (HashMap Key AnyValue -> [Key]) -> HashMap Key AnyValue -> [Key]
forall a b. (a -> b) -> a -> b
$ TOML -> HashMap Key AnyValue
tomlPairs TOML
toml
                tableKeys :: [Key]
tableKeys = (Piece -> Key) -> [Piece] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Piece -> [Piece] -> Key
:|| []) ([Piece] -> [Key]) -> [Piece] -> [Key]
forall a b. (a -> b) -> a -> b
$ PrefixMap TOML -> [Piece]
forall k v. HashMap k v -> [k]
HashMap.keys (PrefixMap TOML -> [Piece]) -> PrefixMap TOML -> [Piece]
forall a b. (a -> b) -> a -> b
$ TOML -> PrefixMap TOML
tomlTables TOML
toml
                tableArrayKey :: [Key]
tableArrayKey = HashMap Key (NonEmpty TOML) -> [Key]
forall k v. HashMap k v -> [k]
HashMap.keys (HashMap Key (NonEmpty TOML) -> [Key])
-> HashMap Key (NonEmpty TOML) -> [Key]
forall a b. (a -> b) -> a -> b
$ TOML -> HashMap Key (NonEmpty TOML)
tomlTableArrays TOML
toml
            in ([(k, v)] -> map)
-> Validation [TomlDecodeError] [(k, v)]
-> Validation [TomlDecodeError] map
forall a b.
(a -> b)
-> Validation [TomlDecodeError] a -> Validation [TomlDecodeError] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, v)] -> map
fromListMap (Validation [TomlDecodeError] [(k, v)]
 -> Validation [TomlDecodeError] map)
-> Validation [TomlDecodeError] [(k, v)]
-> Validation [TomlDecodeError] map
forall a b. (a -> b) -> a -> b
$ [Key]
-> (Key -> Validation [TomlDecodeError] (k, v))
-> Validation [TomlDecodeError] [(k, v)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ([Key]
valKeys [Key] -> [Key] -> [Key]
forall a. Semigroup a => a -> a -> a
<> [Key]
tableKeys [Key] -> [Key] -> [Key]
forall a. Semigroup a => a -> a -> a
<> [Key]
tableArrayKey) ((Key -> Validation [TomlDecodeError] (k, v))
 -> Validation [TomlDecodeError] [(k, v)])
-> (Key -> Validation [TomlDecodeError] (k, v))
-> Validation [TomlDecodeError] [(k, v)]
forall a b. (a -> b) -> a -> b
$ \Key
key ->
                Key
-> Either TomlBiMapError k
-> (k -> Validation [TomlDecodeError] (k, v))
-> Validation [TomlDecodeError] (k, v)
forall a b.
Key
-> Either TomlBiMapError a
-> (a -> Validation [TomlDecodeError] b)
-> Validation [TomlDecodeError] b
whenLeftBiMapError Key
key (TomlBiMap Key k -> Key -> Either TomlBiMapError k
forall e a b. BiMap e a b -> a -> Either e b
forward TomlBiMap Key k
keyBiMap Key
key) ((k -> Validation [TomlDecodeError] (k, v))
 -> Validation [TomlDecodeError] (k, v))
-> (k -> Validation [TomlDecodeError] (k, v))
-> Validation [TomlDecodeError] (k, v)
forall a b. (a -> b) -> a -> b
$ \k
k ->
                    (k
k,) (v -> (k, v))
-> Validation [TomlDecodeError] v
-> Validation [TomlDecodeError] (k, v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TomlCodec v -> TomlEnv v
forall i o. Codec i o -> TomlEnv o
codecRead (Key -> TomlCodec v
valCodec Key
key) TOML
toml

    output :: map -> TomlState map
    output :: map -> TomlState map
output map
m = do
        Maybe TOML
mTable <- (TOML -> Maybe TOML) -> TomlState (Maybe TOML)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((TOML -> Maybe TOML) -> TomlState (Maybe TOML))
-> (TOML -> Maybe TOML) -> TomlState (Maybe TOML)
forall a b. (a -> b) -> a -> b
$ Key -> PrefixMap TOML -> Maybe TOML
forall a. Key -> PrefixMap a -> Maybe a
Prefix.lookup Key
tableName (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 (Maybe ()
_, TOML
newToml) = TomlState () -> TOML -> (Maybe (), TOML)
forall a. TomlState a -> TOML -> (Maybe a, TOML)
unTomlState TomlState ()
updateMapTable TOML
toml
        map
m map -> TomlState () -> TomlState map
forall a b. a -> TomlState b -> TomlState a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (TOML -> TOML) -> TomlState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Key -> TOML -> TOML -> TOML
insertTable Key
tableName TOML
newToml)
      where
        updateMapTable :: TomlState ()
        updateMapTable :: TomlState ()
updateMapTable = [(k, v)] -> ((k, v) -> TomlState v) -> TomlState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (map -> [(k, v)]
toListMap map
m) (((k, v) -> TomlState v) -> TomlState ())
-> ((k, v) -> TomlState v) -> TomlState ()
forall a b. (a -> b) -> a -> b
$ \(k
k, v
v) -> case TomlBiMap Key k -> k -> Either TomlBiMapError Key
forall e a b. BiMap e a b -> b -> Either e a
backward TomlBiMap Key k
keyBiMap k
k of
            Left TomlBiMapError
_    -> TomlState v
forall a. TomlState a
forall (f :: * -> *) a. Alternative f => f a
empty
            Right Key
key -> TomlCodec v -> v -> TomlState v
forall i o. Codec i o -> i -> TomlState o
codecWrite (Key -> TomlCodec v
valCodec Key
key) v
v