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

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 :: forall a.
TomlCodec a -> Key -> TOML -> Validation [TomlDecodeError] a
handleTableErrors TomlCodec a
codec Key
key TOML
toml = case TomlCodec a -> TomlEnv a
forall i o. Codec i o -> TomlEnv o
codecRead TomlCodec a
codec TOML
toml of
    Success a
res  -> a -> Validation [TomlDecodeError] a
forall e a. a -> Validation e a
Success a
res
    Failure [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 = (TomlDecodeError -> TomlDecodeError)
-> [TomlDecodeError] -> [TomlDecodeError]
forall a b. (a -> b) -> [a] -> [b]
map (\case
    KeyNotFound Key
name        -> Key -> TomlDecodeError
KeyNotFound (Key
key Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
name)
    TableNotFound Key
name      -> Key -> TomlDecodeError
TableNotFound (Key
key Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
name)
    TableArrayNotFound Key
name -> Key -> TomlDecodeError
TableArrayNotFound (Key
key Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
<> Key
name)
    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 :: forall a. TomlCodec a -> Key -> TomlCodec a
table TomlCodec a
codec 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
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
        Maybe TOML
Nothing   -> [TomlDecodeError] -> Validation [TomlDecodeError] a
forall e a. e -> Validation e a
Failure [Key -> TomlDecodeError
TableNotFound Key
key]
        Just 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 = 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 (Maybe a
_, 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 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
key TOML
newToml)