module Toml.Parser.Validate
(
validateItems
, ValidationError (..)
, 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
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
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
groupWithParent
:: Maybe Key
-> [TomlItem]
-> (Forest TomlItem, [TomlItem])
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
(<:>) :: 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
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
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)
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
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
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
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 ()