{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module YamlParse.Applicative.Explain where
import Data.Text (Text)
import qualified Data.Text as T
import Data.Validity
import Data.Validity.Text ()
import GHC.Generics (Generic)
import YamlParse.Applicative.Parser
data Schema
= EmptySchema
| AnySchema
| ExactSchema Text
| NullSchema
| MaybeSchema Schema
| BoolSchema (Maybe Text)
| NumberSchema (Maybe Text)
| StringSchema (Maybe Text)
| ArraySchema (Maybe Text) Schema
| ObjectSchema (Maybe Text) Schema
| FieldSchema
Text
Bool
(Maybe Text)
Schema
| ListSchema Schema
| MapSchema Schema
| MapKeysSchema Schema
| ApSchema Schema Schema
| AltSchema [Schema]
| Text Schema
deriving (Int -> Schema -> ShowS
[Schema] -> ShowS
Schema -> String
(Int -> Schema -> ShowS)
-> (Schema -> String) -> ([Schema] -> ShowS) -> Show Schema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Schema] -> ShowS
$cshowList :: [Schema] -> ShowS
show :: Schema -> String
$cshow :: Schema -> String
showsPrec :: Int -> Schema -> ShowS
$cshowsPrec :: Int -> Schema -> ShowS
Show, Schema -> Schema -> Bool
(Schema -> Schema -> Bool)
-> (Schema -> Schema -> Bool) -> Eq Schema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Schema -> Schema -> Bool
$c/= :: Schema -> Schema -> Bool
== :: Schema -> Schema -> Bool
$c== :: Schema -> Schema -> Bool
Eq, (forall x. Schema -> Rep Schema x)
-> (forall x. Rep Schema x -> Schema) -> Generic Schema
forall x. Rep Schema x -> Schema
forall x. Schema -> Rep Schema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Schema x -> Schema
$cfrom :: forall x. Schema -> Rep Schema x
Generic)
instance Validity Schema
explainParser :: Parser i o -> Schema
explainParser :: Parser i o -> Schema
explainParser = Parser i o -> Schema
forall i o. Parser i o -> Schema
go
where
go :: Parser i o -> Schema
go :: Parser i o -> Schema
go = \case
Parser i o
ParseAny -> Schema
AnySchema
ParseExtra o -> Parser o
_ Parser i o
p -> Parser i o -> Schema
forall i o. Parser i o -> Schema
go Parser i o
p
ParseEq o
_ Text
t Parser i o
_ -> Text -> Schema
ExactSchema Text
t
Parser i o
ParseNull -> Schema
NullSchema
ParseMaybe Parser Value o
p -> Schema -> Schema
MaybeSchema (Schema -> Schema) -> Schema -> Schema
forall a b. (a -> b) -> a -> b
$ Parser Value o -> Schema
forall i o. Parser i o -> Schema
go Parser Value o
p
ParseBool Maybe Text
t Parser Bool o
_ -> Maybe Text -> Schema
BoolSchema Maybe Text
t
ParseNumber Maybe Text
t Parser Scientific o
_ -> Maybe Text -> Schema
NumberSchema Maybe Text
t
ParseString Maybe Text
t Parser Text o
ParseAny -> Maybe Text -> Schema
StringSchema Maybe Text
t
ParseString Maybe Text
_ Parser Text o
p -> Parser Text o -> Schema
forall i o. Parser i o -> Schema
go Parser Text o
p
ParseArray Maybe Text
t Parser Array o
p -> Maybe Text -> Schema -> Schema
ArraySchema Maybe Text
t (Schema -> Schema) -> Schema -> Schema
forall a b. (a -> b) -> a -> b
$ Parser Array o -> Schema
forall i o. Parser i o -> Schema
go Parser Array o
p
ParseObject Maybe Text
t Parser Object o
p -> Maybe Text -> Schema -> Schema
ObjectSchema Maybe Text
t (Schema -> Schema) -> Schema -> Schema
forall a b. (a -> b) -> a -> b
$ Parser Object o -> Schema
forall i o. Parser i o -> Schema
go Parser Object o
p
ParseField Text
k FieldParser o
fp -> case FieldParser o
fp of
FieldParserFmap a -> o
_ FieldParser a
fp' -> Parser Object a -> Schema
forall i o. Parser i o -> Schema
go (Parser Object a -> Schema) -> Parser Object a -> Schema
forall a b. (a -> b) -> a -> b
$ Text -> FieldParser a -> Parser Object a
forall o. Text -> FieldParser o -> Parser Object o
ParseField Text
k FieldParser a
fp'
FieldParserRequired YamlParser o
p -> Text -> Bool -> Maybe Text -> Schema -> Schema
FieldSchema Text
k Bool
True Maybe Text
forall a. Maybe a
Nothing (Schema -> Schema) -> Schema -> Schema
forall a b. (a -> b) -> a -> b
$ YamlParser o -> Schema
forall i o. Parser i o -> Schema
go YamlParser o
p
FieldParserOptional YamlParser o
p -> Text -> Bool -> Maybe Text -> Schema -> Schema
FieldSchema Text
k Bool
False Maybe Text
forall a. Maybe a
Nothing (Schema -> Schema) -> Schema -> Schema
forall a b. (a -> b) -> a -> b
$ YamlParser o -> Schema
forall i o. Parser i o -> Schema
go YamlParser o
p
FieldParserOptionalWithDefault YamlParser o
p o
d -> Text -> Bool -> Maybe Text -> Schema -> Schema
FieldSchema Text
k Bool
False (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ o -> String
forall a. Show a => a -> String
show o
d) (Schema -> Schema) -> Schema -> Schema
forall a b. (a -> b) -> a -> b
$ YamlParser o -> Schema
forall i o. Parser i o -> Schema
go YamlParser o
p
ParseList Parser Value o
p -> Schema -> Schema
ListSchema (Schema -> Schema) -> Schema -> Schema
forall a b. (a -> b) -> a -> b
$ Parser Value o -> Schema
forall i o. Parser i o -> Schema
go Parser Value o
p
ParseMap Parser Value v
p -> Schema -> Schema
MapSchema (Schema -> Schema) -> Schema -> Schema
forall a b. (a -> b) -> a -> b
$ Parser Value v -> Schema
forall i o. Parser i o -> Schema
go Parser Value v
p
ParseMapKeys Parser Text k
_ Parser Object (KeyMap v)
p -> Schema -> Schema
MapKeysSchema (Schema -> Schema) -> Schema -> Schema
forall a b. (a -> b) -> a -> b
$ Parser Object (KeyMap v) -> Schema
forall i o. Parser i o -> Schema
go Parser Object (KeyMap v)
p
ParsePure o
_ -> Schema
EmptySchema
ParseFmap a -> o
_ Parser i a
p -> Parser i a -> Schema
forall i o. Parser i o -> Schema
go Parser i a
p
ParseAp Parser i (a -> o)
pf Parser i a
p -> Schema -> Schema -> Schema
ApSchema (Parser i (a -> o) -> Schema
forall i o. Parser i o -> Schema
go Parser i (a -> o)
pf) (Parser i a -> Schema
forall i o. Parser i o -> Schema
go Parser i a
p)
ParseAlt [Parser i o]
ps -> [Schema] -> Schema
AltSchema ([Schema] -> Schema) -> [Schema] -> Schema
forall a b. (a -> b) -> a -> b
$ (Parser i o -> Schema) -> [Parser i o] -> [Schema]
forall a b. (a -> b) -> [a] -> [b]
map Parser i o -> Schema
forall i o. Parser i o -> Schema
go [Parser i o]
ps
ParseComment Text
t Parser i o
p -> Text -> Schema -> Schema
CommentSchema Text
t (Schema -> Schema) -> Schema -> Schema
forall a b. (a -> b) -> a -> b
$ Parser i o -> Schema
forall i o. Parser i o -> Schema
go Parser i o
p