{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TupleSections #-}
module Toml.Codec.Combinator.Map
(
map
, tableMap
, hashMap
, tableHashMap
, intMap
, tableIntMap
) where
import Prelude hiding (map)
import Control.Applicative (empty)
import Control.Monad (forM_)
import Control.Monad.State (gets, modify)
import Data.Hashable (Hashable)
import Data.HashMap.Strict (HashMap)
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 (pattern (:||), Key)
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
map :: forall k v .
Ord k
=> TomlCodec k
-> TomlCodec v
-> Key
-> TomlCodec (Map k v)
map :: forall k v.
Ord k =>
TomlCodec k -> TomlCodec v -> Key -> TomlCodec (Map k v)
map = forall map k v.
map
-> (map -> [(k, v)])
-> ([(k, v)] -> map)
-> TomlCodec k
-> TomlCodec v
-> Key
-> TomlCodec map
internalMap forall k a. Map k a
Map.empty forall k a. Map k a -> [(k, a)]
Map.toList forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
tableMap
:: forall k v
. Ord k
=> TomlBiMap Key k
-> (Key -> TomlCodec v)
-> Key
-> TomlCodec (Map k v)
tableMap :: forall k v.
Ord k =>
TomlBiMap Key k
-> (Key -> TomlCodec v) -> Key -> TomlCodec (Map k v)
tableMap = forall map k v.
map
-> (map -> [(k, v)])
-> ([(k, v)] -> map)
-> TomlBiMap Key k
-> (Key -> TomlCodec v)
-> Key
-> TomlCodec map
internalTableMap forall k a. Map k a
Map.empty forall k a. Map k a -> [(k, a)]
Map.toList forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
hashMap
:: forall k v
. (Eq k, Hashable k)
=> TomlCodec k
-> TomlCodec v
-> Key
-> TomlCodec (HashMap k v)
hashMap :: forall k v.
(Eq k, Hashable k) =>
TomlCodec k -> TomlCodec v -> Key -> TomlCodec (HashMap k v)
hashMap = forall map k v.
map
-> (map -> [(k, v)])
-> ([(k, v)] -> map)
-> TomlCodec k
-> TomlCodec v
-> Key
-> TomlCodec map
internalMap forall k v. HashMap k v
HashMap.empty forall k v. HashMap k v -> [(k, v)]
HashMap.toList forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
tableHashMap
:: forall k v
. (Eq k, Hashable k)
=> TomlBiMap Key k
-> (Key -> TomlCodec v)
-> Key
-> TomlCodec (HashMap k v)
tableHashMap :: forall k v.
(Eq k, Hashable k) =>
TomlBiMap Key k
-> (Key -> TomlCodec v) -> Key -> TomlCodec (HashMap k v)
tableHashMap = forall map k v.
map
-> (map -> [(k, v)])
-> ([(k, v)] -> map)
-> TomlBiMap Key k
-> (Key -> TomlCodec v)
-> Key
-> TomlCodec map
internalTableMap forall k v. HashMap k v
HashMap.empty forall k v. HashMap k v -> [(k, v)]
HashMap.toList forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
intMap
:: forall v
. TomlCodec Int
-> TomlCodec v
-> Key
-> TomlCodec (IntMap v)
intMap :: forall v.
TomlCodec Int -> TomlCodec v -> Key -> TomlCodec (IntMap v)
intMap = forall map k v.
map
-> (map -> [(k, v)])
-> ([(k, v)] -> map)
-> TomlCodec k
-> TomlCodec v
-> Key
-> TomlCodec map
internalMap forall a. IntMap a
IntMap.empty forall a. IntMap a -> [(Int, a)]
IntMap.toList forall a. [(Int, a)] -> IntMap a
IntMap.fromList
tableIntMap
:: forall v
. TomlBiMap Key Int
-> (Key -> TomlCodec v)
-> Key
-> TomlCodec (IntMap v)
tableIntMap :: forall v.
TomlBiMap Key Int
-> (Key -> TomlCodec v) -> Key -> TomlCodec (IntMap v)
tableIntMap = forall map k v.
map
-> (map -> [(k, v)])
-> ([(k, v)] -> map)
-> TomlBiMap Key k
-> (Key -> TomlCodec v)
-> Key
-> TomlCodec map
internalTableMap forall a. IntMap a
IntMap.empty forall a. IntMap a -> [(Int, a)]
IntMap.toList forall a. [(Int, a)] -> IntMap a
IntMap.fromList
internalMap :: forall map k v
. map
-> (map -> [(k, v)])
-> ([(k, v)] -> map)
-> TomlCodec k
-> TomlCodec v
-> Key
-> TomlCodec 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 = 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 forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key forall a b. (a -> b) -> a -> b
$ TOML -> HashMap Key (NonEmpty TOML)
tomlTableArrays TOML
t of
Maybe (NonEmpty TOML)
Nothing -> forall e a. a -> Validation e a
Success map
emptyMap
Just NonEmpty TOML
tomls -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, v)] -> map
fromListMap forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (forall a. NonEmpty a -> [a]
NE.toList NonEmpty TOML
tomls) forall a b. (a -> b) -> a -> b
$ \TOML
toml -> do
k
k <- forall i o. Codec i o -> TomlEnv o
codecRead TomlCodec k
keyCodec TOML
toml
v
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(\(k
k, v
v) -> forall a. TomlCodec a -> a -> TOML
execTomlCodec TomlCodec k
keyCodec k
k forall a. Semigroup a => a -> a -> a
<> forall a. TomlCodec a -> a -> TOML
execTomlCodec TomlCodec v
valCodec v
v)
(map -> [(k, v)]
toListMap map
dict)
Maybe (NonEmpty TOML)
mTables <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key 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
[] -> forall a. a -> a
id
TOML
t:[TOML]
ts -> Key -> NonEmpty TOML -> TOML -> TOML
insertTableArrays Key
key (TOML
t forall a. a -> [a] -> NonEmpty a
:| [TOML]
ts)
Just (TOML
t :| [TOML]
ts) ->
Key -> NonEmpty TOML -> TOML -> TOML
insertTableArrays Key
key forall a b. (a -> b) -> a -> b
$ TOML
t forall a. a -> [a] -> NonEmpty a
:| ([TOML]
ts forall a. [a] -> [a] -> [a]
++ [TOML]
tomls)
map
dict forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify TOML -> TOML
updateAction
internalTableMap
:: forall map k v
. map
-> (map -> [(k, v)])
-> ([(k, v)] -> map)
-> TomlBiMap Key k
-> (Key -> TomlCodec v)
-> Key
-> 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 =
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 forall a. Key -> PrefixMap a -> Maybe a
Prefix.lookup Key
tableName forall a b. (a -> b) -> a -> b
$ TOML -> PrefixMap TOML
tomlTables TOML
t of
Maybe TOML
Nothing -> forall e a. a -> Validation e a
Success map
emptyMap
Just TOML
toml ->
let valKeys :: [Key]
valKeys = forall k v. HashMap k v -> [k]
HashMap.keys forall a b. (a -> b) -> a -> b
$ TOML -> HashMap Key AnyValue
tomlPairs TOML
toml
tableKeys :: [Key]
tableKeys = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Piece -> [Piece] -> Key
:|| []) forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [k]
HashMap.keys forall a b. (a -> b) -> a -> b
$ TOML -> PrefixMap TOML
tomlTables TOML
toml
tableArrayKey :: [Key]
tableArrayKey = forall k v. HashMap k v -> [k]
HashMap.keys forall a b. (a -> b) -> a -> b
$ TOML -> HashMap Key (NonEmpty TOML)
tomlTableArrays TOML
toml
in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, v)] -> map
fromListMap forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ([Key]
valKeys forall a. Semigroup a => a -> a -> a
<> [Key]
tableKeys forall a. Semigroup a => a -> a -> a
<> [Key]
tableArrayKey) forall a b. (a -> b) -> a -> b
$ \Key
key ->
forall a b.
Key
-> Either TomlBiMapError a
-> (a -> Validation [TomlDecodeError] b)
-> Validation [TomlDecodeError] b
whenLeftBiMapError Key
key (forall e a b. BiMap e a b -> a -> Either e b
forward TomlBiMap Key k
keyBiMap Key
key) forall a b. (a -> b) -> a -> b
$ \k
k ->
(k
k,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall a. Key -> PrefixMap a -> Maybe a
Prefix.lookup Key
tableName forall b c a. (b -> c) -> (a -> b) -> a -> c
. TOML -> PrefixMap TOML
tomlTables
let toml :: TOML
toml = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe TOML
mTable
let (Maybe ()
_, TOML
newToml) = forall a. TomlState a -> TOML -> (Maybe a, TOML)
unTomlState TomlState ()
updateMapTable TOML
toml
map
m forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ 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 = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (map -> [(k, v)]
toListMap map
m) forall a b. (a -> b) -> a -> b
$ \(k
k, v
v) -> case forall e a b. BiMap e a b -> b -> Either e a
backward TomlBiMap Key k
keyBiMap k
k of
Left TomlBiMapError
_ -> forall (f :: * -> *) a. Alternative f => f a
empty
Right Key
key -> forall i o. Codec i o -> i -> TomlState o
codecWrite (Key -> TomlCodec v
valCodec Key
key) v
v