{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module YamlParse.Applicative.Class where
import qualified Data.Aeson as JSON
import Data.HashMap.Strict (HashMap)
import Data.Int
import Data.List.NonEmpty as NE
import Data.Map (Map)
import Data.Scientific
import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Data.Vector (Vector)
import qualified Data.Vector as V
import Data.Word
import qualified Data.Yaml as Yaml
import GHC.Generics (Generic)
import Path
import YamlParse.Applicative.Implement
import YamlParse.Applicative.Parser
class YamlSchema a where
{-# MINIMAL yamlSchema #-}
yamlSchema :: YamlParser a
yamlSchemaList :: YamlParser [a]
yamlSchemaList = Vector a -> [a]
forall a. Vector a -> [a]
V.toList (Vector a -> [a]) -> Parser Value (Vector a) -> YamlParser [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Parser Array (Vector a) -> Parser Value (Vector a)
forall o. Maybe Text -> Parser Array o -> Parser Value o
ParseArray Maybe Text
forall a. Maybe a
Nothing (Parser Value a -> Parser Array (Vector a)
forall o. Parser Value o -> Parser Array (Vector o)
ParseList Parser Value a
forall a. YamlSchema a => Parser Value a
yamlSchema)
class YamlKeySchema a where
yamlKeySchema :: KeyParser a
instance YamlSchema () where
yamlSchema :: YamlParser ()
yamlSchema = () -> YamlParser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance YamlSchema Bool where
yamlSchema :: YamlParser Bool
yamlSchema = Maybe Text -> Parser Bool Bool -> YamlParser Bool
forall o. Maybe Text -> Parser Bool o -> Parser Value o
ParseBool Maybe Text
forall a. Maybe a
Nothing Parser Bool Bool
forall i. Parser i i
ParseAny
instance YamlSchema Char where
yamlSchema :: YamlParser Char
yamlSchema =
Maybe Text -> Parser Text Char -> YamlParser Char
forall o. Maybe Text -> Parser Text o -> Parser Value o
ParseString Maybe Text
forall a. Maybe a
Nothing (Parser Text Char -> YamlParser Char)
-> Parser Text Char -> YamlParser Char
forall a b. (a -> b) -> a -> b
$
(Text -> Maybe Char) -> Parser Text Text -> Parser Text Char
forall o u i. Show o => (o -> Maybe u) -> Parser i o -> Parser i u
maybeParser
( \Text
cs -> case Text -> [Char]
T.unpack Text
cs of
[] -> Maybe Char
forall a. Maybe a
Nothing
[Char
c] -> Char -> Maybe Char
forall a. a -> Maybe a
Just Char
c
[Char]
_ -> Maybe Char
forall a. Maybe a
Nothing
)
Parser Text Text
forall i. Parser i i
ParseAny
yamlSchemaList :: YamlParser [Char]
yamlSchemaList = Text -> [Char]
T.unpack (Text -> [Char]) -> Parser Value Text -> YamlParser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Value Text
forall a. YamlSchema a => Parser Value a
yamlSchema
instance YamlSchema Text where
yamlSchema :: Parser Value Text
yamlSchema = Maybe Text -> Parser Text Text -> Parser Value Text
forall o. Maybe Text -> Parser Text o -> Parser Value o
ParseString Maybe Text
forall a. Maybe a
Nothing Parser Text Text
forall i. Parser i i
ParseAny
instance YamlKeySchema Text where
yamlKeySchema :: Parser Text Text
yamlKeySchema = Parser Text Text
forall i. Parser i i
ParseAny
instance YamlKeySchema String where
yamlKeySchema :: KeyParser [Char]
yamlKeySchema = Text -> [Char]
T.unpack (Text -> [Char]) -> Parser Text Text -> KeyParser [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
forall a. YamlKeySchema a => KeyParser a
yamlKeySchema
instance YamlSchema Scientific where
yamlSchema :: YamlParser Scientific
yamlSchema = Maybe Text -> Parser Scientific Scientific -> YamlParser Scientific
forall o. Maybe Text -> Parser Scientific o -> Parser Value o
ParseNumber Maybe Text
forall a. Maybe a
Nothing Parser Scientific Scientific
forall i. Parser i i
ParseAny
instance YamlSchema Int where
yamlSchema :: YamlParser Int
yamlSchema = YamlParser Int
forall i. (Integral i, Bounded i) => YamlParser i
boundedIntegerSchema
instance YamlSchema Int8 where
yamlSchema :: YamlParser Int8
yamlSchema = YamlParser Int8
forall i. (Integral i, Bounded i) => YamlParser i
boundedIntegerSchema
instance YamlSchema Int16 where
yamlSchema :: YamlParser Int16
yamlSchema = YamlParser Int16
forall i. (Integral i, Bounded i) => YamlParser i
boundedIntegerSchema
instance YamlSchema Int32 where
yamlSchema :: YamlParser Int32
yamlSchema = YamlParser Int32
forall i. (Integral i, Bounded i) => YamlParser i
boundedIntegerSchema
instance YamlSchema Int64 where
yamlSchema :: YamlParser Int64
yamlSchema = YamlParser Int64
forall i. (Integral i, Bounded i) => YamlParser i
boundedIntegerSchema
instance YamlSchema Word where
yamlSchema :: YamlParser Word
yamlSchema = YamlParser Word
forall i. (Integral i, Bounded i) => YamlParser i
boundedIntegerSchema
instance YamlSchema Word8 where
yamlSchema :: YamlParser Word8
yamlSchema = YamlParser Word8
forall i. (Integral i, Bounded i) => YamlParser i
boundedIntegerSchema
instance YamlSchema Word16 where
yamlSchema :: YamlParser Word16
yamlSchema = YamlParser Word16
forall i. (Integral i, Bounded i) => YamlParser i
boundedIntegerSchema
instance YamlSchema Word32 where
yamlSchema :: YamlParser Word32
yamlSchema = YamlParser Word32
forall i. (Integral i, Bounded i) => YamlParser i
boundedIntegerSchema
instance YamlSchema Word64 where
yamlSchema :: YamlParser Word64
yamlSchema = YamlParser Word64
forall i. (Integral i, Bounded i) => YamlParser i
boundedIntegerSchema
boundedIntegerSchema :: (Integral i, Bounded i) => YamlParser i
boundedIntegerSchema :: YamlParser i
boundedIntegerSchema = (Scientific -> Maybe i) -> YamlParser Scientific -> YamlParser i
forall o u i. Show o => (o -> Maybe u) -> Parser i o -> Parser i u
maybeParser Scientific -> Maybe i
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger (YamlParser Scientific -> YamlParser i)
-> YamlParser Scientific -> YamlParser i
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Parser Scientific Scientific -> YamlParser Scientific
forall o. Maybe Text -> Parser Scientific o -> Parser Value o
ParseNumber Maybe Text
forall a. Maybe a
Nothing Parser Scientific Scientific
forall i. Parser i i
ParseAny
instance YamlSchema (Path Rel File) where
yamlSchema :: YamlParser (Path Rel File)
yamlSchema = ([Char] -> Maybe (Path Rel File))
-> YamlParser [Char] -> YamlParser (Path Rel File)
forall o u i. Show o => (o -> Maybe u) -> Parser i o -> Parser i u
maybeParser [Char] -> Maybe (Path Rel File)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel File)
parseRelFile YamlParser [Char]
forall a. YamlSchema a => Parser Value a
yamlSchema
instance YamlSchema (Path Rel Dir) where
yamlSchema :: YamlParser (Path Rel Dir)
yamlSchema = ([Char] -> Maybe (Path Rel Dir))
-> YamlParser [Char] -> YamlParser (Path Rel Dir)
forall o u i. Show o => (o -> Maybe u) -> Parser i o -> Parser i u
maybeParser [Char] -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel Dir)
parseRelDir YamlParser [Char]
forall a. YamlSchema a => Parser Value a
yamlSchema
instance YamlSchema (Path Abs File) where
yamlSchema :: YamlParser (Path Abs File)
yamlSchema = ([Char] -> Maybe (Path Abs File))
-> YamlParser [Char] -> YamlParser (Path Abs File)
forall o u i. Show o => (o -> Maybe u) -> Parser i o -> Parser i u
maybeParser [Char] -> Maybe (Path Abs File)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Abs File)
parseAbsFile YamlParser [Char]
forall a. YamlSchema a => Parser Value a
yamlSchema
instance YamlSchema (Path Abs Dir) where
yamlSchema :: YamlParser (Path Abs Dir)
yamlSchema = ([Char] -> Maybe (Path Abs Dir))
-> YamlParser [Char] -> YamlParser (Path Abs Dir)
forall o u i. Show o => (o -> Maybe u) -> Parser i o -> Parser i u
maybeParser [Char] -> Maybe (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Abs Dir)
parseAbsDir YamlParser [Char]
forall a. YamlSchema a => Parser Value a
yamlSchema
instance YamlSchema Yaml.Value where
yamlSchema :: YamlParser Value
yamlSchema = YamlParser Value
forall i. Parser i i
ParseAny
instance YamlSchema a => YamlSchema (Maybe a) where
yamlSchema :: YamlParser (Maybe a)
yamlSchema = Parser Value a -> YamlParser (Maybe a)
forall o. Parser Value o -> Parser Value (Maybe o)
ParseMaybe Parser Value a
forall a. YamlSchema a => Parser Value a
yamlSchema
instance YamlSchema a => YamlSchema (Vector a) where
yamlSchema :: YamlParser (Vector a)
yamlSchema = Maybe Text -> Parser Array (Vector a) -> YamlParser (Vector a)
forall o. Maybe Text -> Parser Array o -> Parser Value o
ParseArray Maybe Text
forall a. Maybe a
Nothing (Parser Value a -> Parser Array (Vector a)
forall o. Parser Value o -> Parser Array (Vector o)
ParseList Parser Value a
forall a. YamlSchema a => Parser Value a
yamlSchema)
instance YamlSchema a => YamlSchema [a] where
yamlSchema :: YamlParser [a]
yamlSchema = YamlParser [a]
forall a. YamlSchema a => YamlParser [a]
yamlSchemaList
instance YamlSchema a => YamlSchema (NonEmpty a) where
yamlSchema :: YamlParser (NonEmpty a)
yamlSchema = ([a] -> Parser (NonEmpty a))
-> Parser Value [a] -> YamlParser (NonEmpty a)
forall o u i. (o -> Parser u) -> Parser i o -> Parser i u
extraParser [a] -> Parser (NonEmpty a)
go Parser Value [a]
forall a. YamlSchema a => Parser Value a
yamlSchema
where
go :: [a] -> Yaml.Parser (NonEmpty a)
go :: [a] -> Parser (NonEmpty a)
go [a]
as = case [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [a]
as of
Maybe (NonEmpty a)
Nothing -> [Char] -> Parser (NonEmpty a)
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Nonempty list expected, but got an empty list"
Just NonEmpty a
ne -> NonEmpty a -> Parser (NonEmpty a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty a
ne
instance (Ord a, YamlSchema a) => YamlSchema (Set a) where
yamlSchema :: YamlParser (Set a)
yamlSchema = [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> Parser Value [a] -> YamlParser (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Value [a]
forall a. YamlSchema a => Parser Value a
yamlSchema
instance (Ord k, YamlKeySchema k, YamlSchema v) => YamlSchema (Map k v) where
yamlSchema :: YamlParser (Map k v)
yamlSchema = Maybe Text -> Parser Object (Map k v) -> YamlParser (Map k v)
forall a. Maybe Text -> Parser Object a -> Parser Value a
ParseObject Maybe Text
forall a. Maybe a
Nothing (Parser Object (Map k v) -> YamlParser (Map k v))
-> Parser Object (Map k v) -> YamlParser (Map k v)
forall a b. (a -> b) -> a -> b
$ Parser Text k
-> Parser Object (HashMap Text v) -> Parser Object (Map k v)
forall k v.
Ord k =>
Parser Text k
-> Parser Object (HashMap Text v) -> Parser Object (Map k v)
ParseMapKeys Parser Text k
forall a. YamlKeySchema a => KeyParser a
yamlKeySchema (Parser Object (HashMap Text v) -> Parser Object (Map k v))
-> Parser Object (HashMap Text v) -> Parser Object (Map k v)
forall a b. (a -> b) -> a -> b
$ Parser Value v -> Parser Object (HashMap Text v)
forall v. Parser Value v -> Parser Object (HashMap Text v)
ParseMap Parser Value v
forall a. YamlSchema a => Parser Value a
yamlSchema
instance YamlSchema v => YamlSchema (HashMap Text v) where
yamlSchema :: YamlParser (HashMap Text v)
yamlSchema = Maybe Text
-> Parser Object (HashMap Text v) -> YamlParser (HashMap Text v)
forall a. Maybe Text -> Parser Object a -> Parser Value a
ParseObject Maybe Text
forall a. Maybe a
Nothing (Parser Object (HashMap Text v) -> YamlParser (HashMap Text v))
-> Parser Object (HashMap Text v) -> YamlParser (HashMap Text v)
forall a b. (a -> b) -> a -> b
$ Parser Value v -> Parser Object (HashMap Text v)
forall v. Parser Value v -> Parser Object (HashMap Text v)
ParseMap Parser Value v
forall a. YamlSchema a => Parser Value a
yamlSchema
requiredField :: YamlSchema a => Text -> Text -> ObjectParser a
requiredField :: Text -> Text -> ObjectParser a
requiredField Text
k Text
h = Text -> Text -> YamlParser a -> ObjectParser a
forall a. Text -> Text -> YamlParser a -> ObjectParser a
requiredFieldWith Text
k Text
h YamlParser a
forall a. YamlSchema a => Parser Value a
yamlSchema
requiredField' :: YamlSchema a => Text -> ObjectParser a
requiredField' :: Text -> ObjectParser a
requiredField' Text
k = Text -> YamlParser a -> ObjectParser a
forall a. Text -> YamlParser a -> ObjectParser a
requiredFieldWith' Text
k YamlParser a
forall a. YamlSchema a => Parser Value a
yamlSchema
optionalField :: YamlSchema a => Text -> Text -> ObjectParser (Maybe a)
optionalField :: Text -> Text -> ObjectParser (Maybe a)
optionalField Text
k Text
h = Text -> Text -> YamlParser a -> ObjectParser (Maybe a)
forall a. Text -> Text -> YamlParser a -> ObjectParser (Maybe a)
optionalFieldWith Text
k Text
h YamlParser a
forall a. YamlSchema a => Parser Value a
yamlSchema
optionalField' :: YamlSchema a => Text -> ObjectParser (Maybe a)
optionalField' :: Text -> ObjectParser (Maybe a)
optionalField' Text
k = Text -> YamlParser a -> ObjectParser (Maybe a)
forall a. Text -> YamlParser a -> ObjectParser (Maybe a)
optionalFieldWith' Text
k YamlParser a
forall a. YamlSchema a => Parser Value a
yamlSchema
optionalFieldWithDefault :: (Show a, YamlSchema a) => Text -> a -> Text -> ObjectParser a
optionalFieldWithDefault :: Text -> a -> Text -> ObjectParser a
optionalFieldWithDefault Text
k a
d Text
h = Text -> a -> Text -> YamlParser a -> ObjectParser a
forall a.
Show a =>
Text -> a -> Text -> YamlParser a -> ObjectParser a
optionalFieldWithDefaultWith Text
k a
d Text
h YamlParser a
forall a. YamlSchema a => Parser Value a
yamlSchema
optionalFieldWithDefault' :: (Show a, YamlSchema a) => Text -> a -> ObjectParser a
optionalFieldWithDefault' :: Text -> a -> ObjectParser a
optionalFieldWithDefault' Text
k a
d = Text -> a -> YamlParser a -> ObjectParser a
forall a. Show a => Text -> a -> YamlParser a -> ObjectParser a
optionalFieldWithDefaultWith' Text
k a
d YamlParser a
forall a. YamlSchema a => Parser Value a
yamlSchema
viaYamlSchema :: YamlSchema a => Yaml.Value -> Yaml.Parser a
viaYamlSchema :: Value -> Parser a
viaYamlSchema = Parser Value a -> Value -> Parser a
forall i o. Parser i o -> i -> Parser o
implementParser Parser Value a
forall a. YamlSchema a => Parser Value a
yamlSchema
newtype ViaYamlSchema a = ViaYamlSchema a
deriving (Int -> ViaYamlSchema a -> ShowS
[ViaYamlSchema a] -> ShowS
ViaYamlSchema a -> [Char]
(Int -> ViaYamlSchema a -> ShowS)
-> (ViaYamlSchema a -> [Char])
-> ([ViaYamlSchema a] -> ShowS)
-> Show (ViaYamlSchema a)
forall a. Show a => Int -> ViaYamlSchema a -> ShowS
forall a. Show a => [ViaYamlSchema a] -> ShowS
forall a. Show a => ViaYamlSchema a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ViaYamlSchema a] -> ShowS
$cshowList :: forall a. Show a => [ViaYamlSchema a] -> ShowS
show :: ViaYamlSchema a -> [Char]
$cshow :: forall a. Show a => ViaYamlSchema a -> [Char]
showsPrec :: Int -> ViaYamlSchema a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ViaYamlSchema a -> ShowS
Show, ViaYamlSchema a -> ViaYamlSchema a -> Bool
(ViaYamlSchema a -> ViaYamlSchema a -> Bool)
-> (ViaYamlSchema a -> ViaYamlSchema a -> Bool)
-> Eq (ViaYamlSchema a)
forall a. Eq a => ViaYamlSchema a -> ViaYamlSchema a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViaYamlSchema a -> ViaYamlSchema a -> Bool
$c/= :: forall a. Eq a => ViaYamlSchema a -> ViaYamlSchema a -> Bool
== :: ViaYamlSchema a -> ViaYamlSchema a -> Bool
$c== :: forall a. Eq a => ViaYamlSchema a -> ViaYamlSchema a -> Bool
Eq, (forall x. ViaYamlSchema a -> Rep (ViaYamlSchema a) x)
-> (forall x. Rep (ViaYamlSchema a) x -> ViaYamlSchema a)
-> Generic (ViaYamlSchema a)
forall x. Rep (ViaYamlSchema a) x -> ViaYamlSchema a
forall x. ViaYamlSchema a -> Rep (ViaYamlSchema a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ViaYamlSchema a) x -> ViaYamlSchema a
forall a x. ViaYamlSchema a -> Rep (ViaYamlSchema a) x
$cto :: forall a x. Rep (ViaYamlSchema a) x -> ViaYamlSchema a
$cfrom :: forall a x. ViaYamlSchema a -> Rep (ViaYamlSchema a) x
Generic)
instance YamlSchema a => Yaml.FromJSON (ViaYamlSchema a) where
parseJSON :: Value -> Parser (ViaYamlSchema a)
parseJSON = (a -> ViaYamlSchema a) -> Parser a -> Parser (ViaYamlSchema a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ViaYamlSchema a
forall a. a -> ViaYamlSchema a
ViaYamlSchema (Parser a -> Parser (ViaYamlSchema a))
-> (Value -> Parser a) -> Value -> Parser (ViaYamlSchema a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser a
forall a. YamlSchema a => Value -> Parser a
viaYamlSchema