{- |
Copyright: (c) 2018-2020 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.

Tables can be represented in @TOML@ in one of the following ways:

@
foo =
    { x = ...
    , y = ...
    , ...
    }
@

__Or__

@
[foo]
    x = ...
    y = ...
    ...
@

@since 1.3.0.0
-}

module Toml.Codec.Combinator.Table
    ( -- * Tables
      table
      -- * Error Helpers
    , handleTableErrors
    , mapTableErrors
    ) where

import Control.Monad.State (gets, modify)
import Data.Maybe (fromMaybe)
import Validation (Validation (..))

import Toml.Codec.Error (TomlDecodeError (..))
import Toml.Codec.Types (Codec (..), TomlCodec, TomlEnv, TomlState (..))
import Toml.Type.Key (Key)
import Toml.Type.TOML (TOML (..), insertTable)

import qualified Toml.Type.PrefixTree as Prefix



{- | Maps errors in tables with 'mapTableErrors'

@since 1.3.0.0
-}
handleTableErrors :: TomlCodec a -> Key -> TOML -> Validation [TomlDecodeError] a
handleTableErrors :: TomlCodec a -> Key -> TOML -> Validation [TomlDecodeError] a
handleTableErrors codec :: TomlCodec a
codec key :: Key
key toml :: TOML
toml = case TomlCodec a -> TOML -> Validation [TomlDecodeError] a
forall i o. Codec i o -> TomlEnv o
codecRead TomlCodec a
codec TOML
toml of
    Success res :: a
res  -> a -> Validation [TomlDecodeError] a
forall e a. a -> Validation e a
Success a
res
    Failure errs :: [TomlDecodeError]
errs -> [TomlDecodeError] -> Validation [TomlDecodeError] a
forall e a. e -> Validation e a
Failure ([TomlDecodeError] -> Validation [TomlDecodeError] a)
-> [TomlDecodeError] -> Validation [TomlDecodeError] a
forall a b. (a -> b) -> a -> b
$ Key -> [TomlDecodeError] -> [TomlDecodeError]
mapTableErrors Key
key [TomlDecodeError]
errs

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

@since 0.2.0
-}
mapTableErrors :: Key -> [TomlDecodeError] -> [TomlDecodeError]
mapTableErrors :: Key -> [TomlDecodeError] -> [TomlDecodeError]
mapTableErrors key :: Key
key = (TomlDecodeError -> TomlDecodeError)
-> [TomlDecodeError] -> [TomlDecodeError]
forall a b. (a -> b) -> [a] -> [b]
map (\case
    KeyNotFound name :: Key
name        -> Key -> TomlDecodeError
KeyNotFound (Key
key Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
name)
    TableNotFound name :: Key
name      -> Key -> TomlDecodeError
TableNotFound (Key
key Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
name)
    TableArrayNotFound name :: Key
name -> Key -> TomlDecodeError
TableArrayNotFound (Key
key Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
name)
    e :: TomlDecodeError
e                       -> TomlDecodeError
e
    )

{- | Codec for tables. Use it when when you have nested objects.

@since 0.2.0
-}
table :: forall a . TomlCodec a -> Key -> TomlCodec a
table :: TomlCodec a -> Key -> TomlCodec a
table codec :: TomlCodec a
codec 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 = \t :: TOML
t -> case Key -> PrefixMap TOML -> Maybe TOML
forall a. Key -> PrefixMap a -> Maybe a
Prefix.lookup Key
key (PrefixMap TOML -> Maybe TOML) -> PrefixMap TOML -> Maybe TOML
forall a b. (a -> b) -> a -> b
$ TOML -> PrefixMap TOML
tomlTables TOML
t of
        Nothing   -> [TomlDecodeError] -> Validation [TomlDecodeError] a
forall e a. e -> Validation e a
Failure [Key -> TomlDecodeError
TableNotFound Key
key]
        Just toml :: TOML
toml -> TomlCodec a -> Key -> TomlEnv a
forall a.
TomlCodec a -> Key -> TOML -> Validation [TomlDecodeError] a
handleTableErrors TomlCodec a
codec Key
key TOML
toml

    output :: a -> TomlState a
    output :: a -> TomlState a
output a :: a
a = 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
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) = TomlState a -> TOML -> (Maybe a, TOML)
forall a. TomlState a -> TOML -> (Maybe a, TOML)
unTomlState (TomlCodec a -> a -> TomlState a
forall i o. Codec i o -> i -> TomlState o
codecWrite TomlCodec a
codec a
a) TOML
toml
        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 -> TOML -> TOML -> TOML
insertTable Key
key TOML
newToml)