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

This module contains functions that aggregate the result of
'Toml.Parser.Item.tomlP' parser into 'TOML'. This approach allows to keep parser
fast and simple and delegate the process of creating tree structure to a
separate function.

@since 1.2.0.0
-}

module Toml.Parser.Validate
       ( -- * Decoding
         validateItems
       , ValidationError (..)

         -- * Internal helpers
       , groupItems
       , groupWithParent
       , validateItemForest
       ) where

import Data.Bifunctor (first)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Tree (Forest, Tree (..))

import Toml.Parser.Item (Table (..), TomlItem (..), setTableName)
import Toml.Type.Key (Key, KeysDiff (FstIsPref), keysDiff)
import Toml.Type.TOML (TOML (..), insertKeyAnyVal, insertTable, insertTableArrays)

import qualified Data.HashMap.Strict as HashMap
import qualified Toml.Type.PrefixTree as PrefixMap


{- | Validate list of 'TomlItem's and convert to 'TOML' if not validation
errors are found.
-}
validateItems :: [TomlItem] -> Either ValidationError TOML
validateItems :: [TomlItem] -> Either ValidationError TOML
validateItems = Forest TomlItem -> Either ValidationError TOML
validateItemForest forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TomlItem] -> Forest TomlItem
groupItems

----------------------------------------------------------------------------
-- Grouping
----------------------------------------------------------------------------

{- | This function takes flat list of 'TomlItem's and groups it into list of
'Tree's by putting all corresponding items inside tables and table arrays.  It
doesn't perform any validation, just groups items according to prefixes of their
keys. So, for example, if you have the following keys as flat list:

@
aaa              # ordinary key
aaa.bbb          # ordinary key
[foo]            # table nam
foo.bar
foo.baz
[xxx]            # table name
[xxx.yyy]        # table name
zzz
@

the following tree structure will be created:

@
aaa
aaa.bbb
[foo]
├──── foo.bar
└──── foo.baz
[xxx]
└──── [yyy]
      └──── zzz
@
-}
groupItems :: [TomlItem] -> Forest TomlItem
groupItems :: [TomlItem] -> Forest TomlItem
groupItems = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Key -> [TomlItem] -> (Forest TomlItem, [TomlItem])
groupWithParent forall a. Maybe a
Nothing

{- | This function groups list of TOML items into 'Forest' and returns list of
items that are not children of specified parent.

__Invariant:__ When this function is called with 'Nothing', second element in
the result tuple should be empty list.
-}
groupWithParent
    :: Maybe Key   -- ^ Parent name
    -> [TomlItem]  -- ^ List of items
    -> (Forest TomlItem, [TomlItem])  -- ^ Forest of times and remaining items
groupWithParent :: Maybe Key -> [TomlItem] -> (Forest TomlItem, [TomlItem])
groupWithParent Maybe Key
_ [] = ([], [])
groupWithParent Maybe Key
parent (TomlItem
item:[TomlItem]
items) = case TomlItem
item of
    KeyVal{}            -> forall a. a -> [Tree a] -> Tree a
Node TomlItem
item [] forall a b. a -> ([a], b) -> ([a], b)
<:> Maybe Key -> [TomlItem] -> (Forest TomlItem, [TomlItem])
groupWithParent Maybe Key
parent [TomlItem]
items
    InlineTable{}       -> forall a. a -> [Tree a] -> Tree a
Node TomlItem
item [] forall a b. a -> ([a], b) -> ([a], b)
<:> Maybe Key -> [TomlItem] -> (Forest TomlItem, [TomlItem])
groupWithParent Maybe Key
parent [TomlItem]
items
    InlineTableArray{}  -> forall a. a -> [Tree a] -> Tree a
Node TomlItem
item [] forall a b. a -> ([a], b) -> ([a], b)
<:> Maybe Key -> [TomlItem] -> (Forest TomlItem, [TomlItem])
groupWithParent Maybe Key
parent [TomlItem]
items
    TableName Key
name      -> TomlItem -> Key -> (Forest TomlItem, [TomlItem])
groupTable TomlItem
item Key
name
    TableArrayName Key
name -> TomlItem -> Key -> (Forest TomlItem, [TomlItem])
groupTable TomlItem
item Key
name
  where
    -- prepend to the first list, just to remove some code noise
    (<:>) :: a -> ([a], b) -> ([a], b)
    a
a <:> :: forall a b. a -> ([a], b) -> ([a], b)
<:> ([a], b)
tup = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (a
a forall a. a -> [a] -> [a]
:) ([a], b)
tup

    -- takes table item and its name, collects all children into table subforest
    -- and returns all elements after the table
    groupTable :: TomlItem -> Key -> (Forest TomlItem, [TomlItem])
    groupTable :: TomlItem -> Key -> (Forest TomlItem, [TomlItem])
groupTable TomlItem
tableItem Key
tableName = case Maybe Key
parent of
        Maybe Key
Nothing -> Key -> (Forest TomlItem, [TomlItem])
tableWithChildren Key
tableName
        Just Key
parentKey -> case Key -> Key -> KeysDiff
keysDiff Key
parentKey Key
tableName of
            FstIsPref Key
diff -> Key -> (Forest TomlItem, [TomlItem])
tableWithChildren Key
diff
            KeysDiff
_              -> ([], TomlItem
itemforall a. a -> [a] -> [a]
:[TomlItem]
items)
      where
        tableWithChildren :: Key -> (Forest TomlItem, [TomlItem])
        tableWithChildren :: Key -> (Forest TomlItem, [TomlItem])
tableWithChildren Key
newName =
            let (Forest TomlItem
children, [TomlItem]
rest) = Maybe Key -> [TomlItem] -> (Forest TomlItem, [TomlItem])
groupWithParent (forall a. a -> Maybe a
Just Key
tableName) [TomlItem]
items
                newItem :: TomlItem
newItem = Key -> TomlItem -> TomlItem
setTableName Key
newName TomlItem
tableItem
            in forall a. a -> [Tree a] -> Tree a
Node TomlItem
newItem Forest TomlItem
children forall a b. a -> ([a], b) -> ([a], b)
<:> Maybe Key -> [TomlItem] -> (Forest TomlItem, [TomlItem])
groupWithParent Maybe Key
parent [TomlItem]
rest

----------------------------------------------------------------------------
-- Decoding
----------------------------------------------------------------------------

{- | Error that happens during validating TOML which is already syntactically
correct. For the list of all possible validation errors and their explanation,
see the following issue on GitHub:

* https://github.com/kowainik/tomland/issues/5
-}

data ValidationError
    = DuplicateKey !Key
    | DuplicateTable !Key
    | SameNameKeyTable !Key
    | SameNameTableArray !Key
    deriving stock (Int -> ValidationError -> ShowS
[ValidationError] -> ShowS
ValidationError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidationError] -> ShowS
$cshowList :: [ValidationError] -> ShowS
show :: ValidationError -> String
$cshow :: ValidationError -> String
showsPrec :: Int -> ValidationError -> ShowS
$cshowsPrec :: Int -> ValidationError -> ShowS
Show, ValidationError -> ValidationError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValidationError -> ValidationError -> Bool
$c/= :: ValidationError -> ValidationError -> Bool
== :: ValidationError -> ValidationError -> Bool
$c== :: ValidationError -> ValidationError -> Bool
Eq)

{- | Construct 'TOML' from the 'Forest' of 'TomlItem' and performing validation
of TOML at the same time.
-}
validateItemForest :: Forest TomlItem -> Either ValidationError TOML
validateItemForest :: Forest TomlItem -> Either ValidationError TOML
validateItemForest = TOML -> Forest TomlItem -> Either ValidationError TOML
go forall a. Monoid a => a
mempty
  where
    go :: TOML -> Forest TomlItem -> Either ValidationError TOML
    go :: TOML -> Forest TomlItem -> Either ValidationError TOML
go TOML
toml [] = forall a b. b -> Either a b
Right TOML
toml
    go toml :: TOML
toml@TOML{HashMap Key (NonEmpty TOML)
HashMap Key AnyValue
PrefixMap TOML
tomlTableArrays :: TOML -> HashMap Key (NonEmpty TOML)
tomlTables :: TOML -> PrefixMap TOML
tomlPairs :: TOML -> HashMap Key AnyValue
tomlTableArrays :: HashMap Key (NonEmpty TOML)
tomlTables :: PrefixMap TOML
tomlPairs :: HashMap Key AnyValue
..} (Tree TomlItem
node:Forest TomlItem
nodes) = case forall a. Tree a -> a
rootLabel Tree TomlItem
node of
        -- ignore subforest here
        KeyVal Key
key AnyValue
val -> do
            forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key HashMap Key AnyValue
tomlPairs forall a e. Maybe a -> e -> Either e ()
`errorOnJust` Key -> ValidationError
DuplicateKey Key
key
            forall a. Key -> PrefixMap a -> Maybe a
PrefixMap.lookup Key
key PrefixMap TOML
tomlTables forall a e. Maybe a -> e -> Either e ()
`errorOnJust` Key -> ValidationError
SameNameKeyTable Key
key
            TOML -> Forest TomlItem -> Either ValidationError TOML
go (Key -> AnyValue -> TOML -> TOML
insertKeyAnyVal Key
key AnyValue
val TOML
toml) Forest TomlItem
nodes

        -- ignore subforest here
        InlineTable Key
key Table
table -> do
            forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key HashMap Key AnyValue
tomlPairs forall a e. Maybe a -> e -> Either e ()
`errorOnJust` Key -> ValidationError
SameNameKeyTable Key
key
            forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key HashMap Key (NonEmpty TOML)
tomlTableArrays forall a e. Maybe a -> e -> Either e ()
`errorOnJust` Key -> ValidationError
SameNameTableArray Key
key
            forall a. Key -> PrefixMap a -> Maybe a
PrefixMap.lookup Key
key PrefixMap TOML
tomlTables forall a e. Maybe a -> e -> Either e ()
`errorOnJust` Key -> ValidationError
DuplicateTable Key
key
            TOML
tableToml <- Table -> Either ValidationError TOML
createTomlFromTable Table
table
            TOML -> Forest TomlItem -> Either ValidationError TOML
go (Key -> TOML -> TOML -> TOML
insertTable Key
key TOML
tableToml TOML
toml) Forest TomlItem
nodes

        -- ignore subforest here
        InlineTableArray Key
key NonEmpty Table
tables -> do
            forall a. Key -> PrefixMap a -> Maybe a
PrefixMap.lookup Key
key PrefixMap TOML
tomlTables forall a e. Maybe a -> e -> Either e ()
`errorOnJust` Key -> ValidationError
SameNameTableArray Key
key
            NonEmpty TOML
arrayToml <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Table -> Either ValidationError TOML
createTomlFromTable NonEmpty Table
tables
            TOML -> Forest TomlItem -> Either ValidationError TOML
go (Key -> NonEmpty TOML -> TOML -> TOML
insertTableArrays Key
key NonEmpty TOML
arrayToml TOML
toml) Forest TomlItem
nodes

        TableName Key
key -> do
            forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key HashMap Key AnyValue
tomlPairs forall a e. Maybe a -> e -> Either e ()
`errorOnJust` Key -> ValidationError
SameNameKeyTable Key
key
            forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key HashMap Key (NonEmpty TOML)
tomlTableArrays forall a e. Maybe a -> e -> Either e ()
`errorOnJust` Key -> ValidationError
SameNameTableArray Key
key
            forall a. Key -> PrefixMap a -> Maybe a
PrefixMap.lookup Key
key PrefixMap TOML
tomlTables forall a e. Maybe a -> e -> Either e ()
`errorOnJust` Key -> ValidationError
DuplicateTable Key
key
            TOML
subTable <- TOML -> Forest TomlItem -> Either ValidationError TOML
go forall a. Monoid a => a
mempty (forall a. Tree a -> [Tree a]
subForest Tree TomlItem
node)
            TOML -> Forest TomlItem -> Either ValidationError TOML
go (Key -> TOML -> TOML -> TOML
insertTable Key
key TOML
subTable TOML
toml) Forest TomlItem
nodes

        TableArrayName Key
key -> do
            forall a. Key -> PrefixMap a -> Maybe a
PrefixMap.lookup Key
key PrefixMap TOML
tomlTables forall a e. Maybe a -> e -> Either e ()
`errorOnJust` Key -> ValidationError
SameNameTableArray Key
key
            TOML
subTable <- TOML -> Forest TomlItem -> Either ValidationError TOML
go forall a. Monoid a => a
mempty (forall a. Tree a -> [Tree a]
subForest Tree TomlItem
node)
            let newArray :: HashMap Key (NonEmpty TOML)
newArray = case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Key
key HashMap Key (NonEmpty TOML)
tomlTableArrays of
                    Maybe (NonEmpty TOML)
Nothing  -> forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Key
key (TOML
subTable forall a. a -> [a] -> NonEmpty a
:| []) HashMap Key (NonEmpty TOML)
tomlTableArrays
                    Just NonEmpty TOML
arr ->
                        forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert Key
key (NonEmpty TOML
arr forall a. Semigroup a => a -> a -> a
<> (TOML
subTable forall a. a -> [a] -> NonEmpty a
:| [])) HashMap Key (NonEmpty TOML)
tomlTableArrays
            TOML -> Forest TomlItem -> Either ValidationError TOML
go (TOML
toml { tomlTableArrays :: HashMap Key (NonEmpty TOML)
tomlTableArrays = HashMap Key (NonEmpty TOML)
newArray }) Forest TomlItem
nodes

    createTomlFromTable :: Table -> Either ValidationError TOML
    createTomlFromTable :: Table -> Either ValidationError TOML
createTomlFromTable (Table [(Key, AnyValue)]
table) =
        TOML -> Forest TomlItem -> Either ValidationError TOML
go forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Key
k, AnyValue
v) -> forall a. a -> [Tree a] -> Tree a
Node (Key -> AnyValue -> TomlItem
KeyVal Key
k AnyValue
v) []) [(Key, AnyValue)]
table



errorOnJust :: Maybe a -> e -> Either e ()
errorOnJust :: forall a e. Maybe a -> e -> Either e ()
errorOnJust (Just a
_) e
e = forall a b. a -> Either a b
Left e
e
errorOnJust Maybe a
Nothing  e
_ = forall a b. b -> Either a b
Right ()