{-# LANGUAGE FlexibleContexts #-}

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

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 :: TomlBiMap a AnyValue -> Key -> TomlCodec a
match BiMap{..} key :: Key
key = TomlEnv a -> (a -> TomlState a) -> TomlCodec 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
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
        Nothing     -> [TomlDecodeError] -> Validation [TomlDecodeError] a
forall e a. e -> Validation e a
Failure [Key -> TomlDecodeError
KeyNotFound Key
key]
        Just anyVal :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure

    output :: a -> TomlState a
    output :: a -> TomlState a
output a :: 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 (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 :: Key
-> Either TomlBiMapError a
-> (a -> Validation [TomlDecodeError] b)
-> Validation [TomlDecodeError] b
whenLeftBiMapError key :: Key
key val :: Either TomlBiMapError a
val action :: a -> Validation [TomlDecodeError] b
action = case Either TomlBiMapError a
val of
    Right a :: a
a  -> a -> Validation [TomlDecodeError] b
action a
a
    Left err :: TomlBiMapError
err -> [TomlDecodeError] -> Validation [TomlDecodeError] b
forall e a. e -> Validation e a
Failure [Key -> TomlBiMapError -> TomlDecodeError
BiMapError Key
key TomlBiMapError
err]