{-# LANGUAGE FlexibleContexts #-}

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

This module implements common utilities for writing custom codecs
without diving into internal implementation details. Most of the time
you don't need to implement your own codecs and can reuse existing
ones. But if you need something that library doesn't provide, you can
find functions in this module useful.

@since 1.3.0.0
-}

module Toml.Codec.Combinator.Common
    ( match
    , whenLeftBiMapError
    ) where

import Control.Monad.State (modify)
import Validation (Validation (..))

import Toml.Codec.BiMap (BiMap (..), TomlBiMap, TomlBiMapError)
import Toml.Codec.Error (TomlDecodeError (..))
import Toml.Codec.Types (Codec (..), TomlCodec, TomlEnv, TomlState, eitherToTomlState)
import Toml.Type.AnyValue (AnyValue (..))
import Toml.Type.Key (Key)
import Toml.Type.TOML (TOML (..), insertKeyAnyVal)

import qualified Data.HashMap.Strict as HashMap


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

@since 0.4.0
-}
match :: forall a . TomlBiMap a AnyValue -> Key -> TomlCodec a
match :: forall a. TomlBiMap a AnyValue -> Key -> TomlCodec a
match BiMap{a -> Either TomlBiMapError AnyValue
AnyValue -> Either TomlBiMapError a
forward :: a -> Either TomlBiMapError AnyValue
backward :: AnyValue -> Either TomlBiMapError a
forward :: forall e a b. BiMap e a b -> a -> Either e b
backward :: forall e a b. BiMap e a b -> b -> Either e a
..} Key
key = TomlEnv a -> (a -> TomlState a) -> Codec a a
forall i o. TomlEnv o -> (i -> TomlState o) -> Codec i o
Codec TomlEnv a
input a -> TomlState a
output
  where
    input :: TomlEnv a
    input :: TomlEnv a
input = \TOML
toml -> case Key -> HashMap Key AnyValue -> Maybe AnyValue
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key (TOML -> HashMap Key AnyValue
tomlPairs TOML
toml) of
        Maybe AnyValue
Nothing     -> [TomlDecodeError] -> Validation [TomlDecodeError] a
forall e a. e -> Validation e a
Failure [Key -> TomlDecodeError
KeyNotFound Key
key]
        Just AnyValue
anyVal -> Key
-> Either TomlBiMapError a
-> (a -> Validation [TomlDecodeError] a)
-> Validation [TomlDecodeError] a
forall a b.
Key
-> Either TomlBiMapError a
-> (a -> Validation [TomlDecodeError] b)
-> Validation [TomlDecodeError] b
whenLeftBiMapError Key
key (AnyValue -> Either TomlBiMapError a
backward AnyValue
anyVal) a -> Validation [TomlDecodeError] a
forall a. a -> Validation [TomlDecodeError] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    output :: a -> TomlState a
    output :: a -> TomlState a
output a
a = do
        AnyValue
anyVal <- Either TomlBiMapError AnyValue -> TomlState AnyValue
forall e a. Either e a -> TomlState a
eitherToTomlState (Either TomlBiMapError AnyValue -> TomlState AnyValue)
-> Either TomlBiMapError AnyValue -> TomlState AnyValue
forall a b. (a -> b) -> a -> b
$ a -> Either TomlBiMapError AnyValue
forward a
a
        a
a a -> TomlState () -> TomlState a
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 -> AnyValue -> TOML -> TOML
insertKeyAnyVal Key
key AnyValue
anyVal)

{- | Throw error on 'Left', or perform a given action with 'Right'.

@since 1.3.0.0
-}
whenLeftBiMapError
    :: Key
    -> Either TomlBiMapError a
    -> (a -> Validation [TomlDecodeError] b)
    -> Validation [TomlDecodeError] b
whenLeftBiMapError :: forall a b.
Key
-> Either TomlBiMapError a
-> (a -> Validation [TomlDecodeError] b)
-> Validation [TomlDecodeError] b
whenLeftBiMapError Key
key Either TomlBiMapError a
val a -> Validation [TomlDecodeError] b
action = case Either TomlBiMapError a
val of
    Right a
a  -> a -> Validation [TomlDecodeError] b
action a
a
    Left TomlBiMapError
err -> [TomlDecodeError] -> Validation [TomlDecodeError] b
forall e a. e -> Validation e a
Failure [Key -> TomlBiMapError -> TomlDecodeError
BiMapError Key
key TomlBiMapError
err]