{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module YamlParse.Applicative.Parser where
import Control.Applicative
import Control.Monad
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Lazy as LB
#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.KeyMap (KeyMap)
#else
import qualified Data.HashMap.Strict as HM
#endif
import Data.Map (Map)
import Data.Scientific
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Validity.Text ()
import Data.Vector (Vector)
import qualified Data.Yaml as Yaml
import Text.Read
#if !MIN_VERSION_aeson(2,0,0)
type KeyMap a = HM.HashMap T.Text a
#endif
data Parser i o where
ParseAny :: Parser i i
:: (o -> Yaml.Parser u) -> Parser i o -> Parser i u
ParseEq ::
(Show o, Eq o) =>
o ->
Text ->
Parser i o ->
Parser i o
ParseNull :: Parser Yaml.Value ()
ParseMaybe :: Parser Yaml.Value o -> Parser Yaml.Value (Maybe o)
ParseBool :: Maybe Text -> Parser Bool o -> Parser Yaml.Value o
ParseString ::
Maybe Text ->
Parser Text o ->
Parser Yaml.Value o
ParseNumber ::
Maybe Text ->
Parser Scientific o ->
Parser Yaml.Value o
ParseArray ::
Maybe Text ->
Parser Yaml.Array o ->
Parser Yaml.Value o
ParseObject ::
Maybe Text ->
Parser Yaml.Object a ->
Parser Yaml.Value a
ParseList ::
Parser Yaml.Value o ->
Parser Yaml.Array (Vector o)
ParseMap ::
Parser Yaml.Value v ->
Parser Yaml.Object (KeyMap v)
ParseMapKeys ::
Ord k =>
Parser Text k ->
Parser Yaml.Object (KeyMap v) ->
Parser Yaml.Object (Map k v)
ParseField ::
Text ->
FieldParser o ->
Parser Yaml.Object o
ParsePure :: a -> Parser i a
ParseFmap :: (a -> b) -> Parser i a -> Parser i b
ParseAp :: Parser i (a -> b) -> Parser i a -> Parser i b
ParseAlt :: [Parser i o] -> Parser i o
:: Text -> Parser i o -> Parser i o
instance Functor (Parser i) where
fmap :: (a -> b) -> Parser i a -> Parser i b
fmap = (a -> b) -> Parser i a -> Parser i b
forall a b i. (a -> b) -> Parser i a -> Parser i b
ParseFmap
instance Applicative (Parser i) where
pure :: a -> Parser i a
pure = a -> Parser i a
forall a i. a -> Parser i a
ParsePure
<*> :: Parser i (a -> b) -> Parser i a -> Parser i b
(<*>) = Parser i (a -> b) -> Parser i a -> Parser i b
forall i a b. Parser i (a -> b) -> Parser i a -> Parser i b
ParseAp
instance Alternative (Parser i) where
empty :: Parser i a
empty = [Parser i a] -> Parser i a
forall i o. [Parser i o] -> Parser i o
ParseAlt []
Parser i a
l <|> :: Parser i a -> Parser i a -> Parser i a
<|> Parser i a
r = [Parser i a] -> Parser i a
forall i o. [Parser i o] -> Parser i o
ParseAlt [Parser i a
l, Parser i a
r]
some :: Parser i a -> Parser i [a]
some = Parser i a -> Parser i [a]
forall a. HasCallStack => a
undefined
many :: Parser i a -> Parser i [a]
many = Parser i a -> Parser i [a]
forall a. HasCallStack => a
undefined
data FieldParser o where
FieldParserFmap :: (a -> b) -> FieldParser a -> FieldParser b
FieldParserRequired :: YamlParser o -> FieldParser o
FieldParserOptional :: YamlParser o -> FieldParser (Maybe o)
FieldParserOptionalWithDefault :: Show o => YamlParser o -> o -> FieldParser o
instance Functor FieldParser where
fmap :: (a -> b) -> FieldParser a -> FieldParser b
fmap = (a -> b) -> FieldParser a -> FieldParser b
forall a b. (a -> b) -> FieldParser a -> FieldParser b
FieldParserFmap
type YamlParser a = Parser Yaml.Value a
type ObjectParser a = Parser Yaml.Object a
type KeyParser a = Parser Text a
objectParser :: Text -> ObjectParser o -> YamlParser o
objectParser :: Text -> ObjectParser o -> YamlParser o
objectParser Text
name = Maybe Text -> ObjectParser o -> YamlParser o
forall a. Maybe Text -> Parser Object a -> Parser Value a
ParseObject (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name)
unnamedObjectParser :: ObjectParser o -> YamlParser o
unnamedObjectParser :: ObjectParser o -> YamlParser o
unnamedObjectParser = Maybe Text -> ObjectParser o -> YamlParser o
forall a. Maybe Text -> Parser Object a -> Parser Value a
ParseObject Maybe Text
forall a. Maybe a
Nothing
viaRead :: Read a => YamlParser a
viaRead :: YamlParser a
viaRead = (String -> Maybe a) -> Parser Value String -> YamlParser a
forall o u i. Show o => (o -> Maybe u) -> Parser i o -> Parser i u
maybeParser String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (Parser Value String -> YamlParser a)
-> Parser Value String -> YamlParser a
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Parser Value Text -> Parser Value String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
literalString :: Text -> YamlParser Text
literalString :: Text -> Parser Value Text
literalString Text
t = 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 -> Parser Value Text)
-> Parser Text Text -> Parser Value Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Parser Text Text -> Parser Text Text
forall o i. (Show o, Eq o) => o -> Text -> Parser i o -> Parser i o
ParseEq Text
t (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. Show a => a -> String
show Text
t) Parser Text Text
forall i. Parser i i
ParseAny
literalShowValue :: Show a => a -> YamlParser a
literalShowValue :: a -> YamlParser a
literalShowValue a
v = a
v a -> Parser Value Text -> YamlParser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Value Text
literalString (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
v)
literalValue :: Yaml.ToJSON a => a -> YamlParser a
literalValue :: a -> YamlParser a
literalValue a
v = a
v a -> Parser Value Value -> YamlParser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Value -> Text -> Parser Value Value -> Parser Value Value
forall o i. (Show o, Eq o) => o -> Text -> Parser i o -> Parser i o
ParseEq (a -> Value
forall a. ToJSON a => a -> Value
Yaml.toJSON a
v) (ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LB.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encode a
v) Parser Value Value
forall i. Parser i i
ParseAny
alternatives :: [Parser i o] -> Parser i o
alternatives :: [Parser i o] -> Parser i o
alternatives = [Parser i o] -> Parser i o
forall i o. [Parser i o] -> Parser i o
ParseAlt
(<?>) :: Parser i a -> Text -> Parser i a
<?> :: Parser i a -> Text -> Parser i a
(<?>) = (Text -> Parser i a -> Parser i a)
-> Parser i a -> Text -> Parser i a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Parser i a -> Parser i a
forall i o. Text -> Parser i o -> Parser i o
ParseComment
(<??>) :: Parser i a -> [Text] -> Parser i a
<??> :: Parser i a -> [Text] -> Parser i a
(<??>) Parser i a
p [Text]
ts = Parser i a
p Parser i a -> Text -> Parser i a
forall i a. Parser i a -> Text -> Parser i a
<?> [Text] -> Text
T.unlines [Text]
ts
requiredFieldWith :: Text -> Text -> YamlParser a -> ObjectParser a
requiredFieldWith :: Text -> Text -> YamlParser a -> ObjectParser a
requiredFieldWith Text
k Text
h YamlParser a
func = Text -> ObjectParser a -> ObjectParser a
forall i o. Text -> Parser i o -> Parser i o
ParseComment Text
h (ObjectParser a -> ObjectParser a)
-> ObjectParser a -> ObjectParser a
forall a b. (a -> b) -> a -> b
$ Text -> FieldParser a -> ObjectParser a
forall o. Text -> FieldParser o -> Parser Object o
ParseField Text
k (FieldParser a -> ObjectParser a)
-> FieldParser a -> ObjectParser a
forall a b. (a -> b) -> a -> b
$ YamlParser a -> FieldParser a
forall o. YamlParser o -> FieldParser o
FieldParserRequired YamlParser a
func
requiredFieldWith' :: Text -> YamlParser a -> ObjectParser a
requiredFieldWith' :: Text -> YamlParser a -> ObjectParser a
requiredFieldWith' Text
k YamlParser a
func = Text -> FieldParser a -> ObjectParser a
forall o. Text -> FieldParser o -> Parser Object o
ParseField Text
k (FieldParser a -> ObjectParser a)
-> FieldParser a -> ObjectParser a
forall a b. (a -> b) -> a -> b
$ YamlParser a -> FieldParser a
forall o. YamlParser o -> FieldParser o
FieldParserRequired YamlParser a
func
optionalFieldWith :: Text -> Text -> YamlParser a -> ObjectParser (Maybe a)
optionalFieldWith :: Text -> Text -> YamlParser a -> ObjectParser (Maybe a)
optionalFieldWith Text
k Text
h YamlParser a
func = Text -> ObjectParser (Maybe a) -> ObjectParser (Maybe a)
forall i o. Text -> Parser i o -> Parser i o
ParseComment Text
h (ObjectParser (Maybe a) -> ObjectParser (Maybe a))
-> ObjectParser (Maybe a) -> ObjectParser (Maybe a)
forall a b. (a -> b) -> a -> b
$ Text -> FieldParser (Maybe a) -> ObjectParser (Maybe a)
forall o. Text -> FieldParser o -> Parser Object o
ParseField Text
k (FieldParser (Maybe a) -> ObjectParser (Maybe a))
-> FieldParser (Maybe a) -> ObjectParser (Maybe a)
forall a b. (a -> b) -> a -> b
$ (Maybe (Maybe a) -> Maybe a)
-> FieldParser (Maybe (Maybe a)) -> FieldParser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (FieldParser (Maybe (Maybe a)) -> FieldParser (Maybe a))
-> FieldParser (Maybe (Maybe a)) -> FieldParser (Maybe a)
forall a b. (a -> b) -> a -> b
$ YamlParser (Maybe a) -> FieldParser (Maybe (Maybe a))
forall o. YamlParser o -> FieldParser (Maybe o)
FieldParserOptional (YamlParser (Maybe a) -> FieldParser (Maybe (Maybe a)))
-> YamlParser (Maybe a) -> FieldParser (Maybe (Maybe a))
forall a b. (a -> b) -> a -> b
$ YamlParser a -> YamlParser (Maybe a)
forall o. Parser Value o -> Parser Value (Maybe o)
ParseMaybe YamlParser a
func
optionalFieldWith' :: Text -> YamlParser a -> ObjectParser (Maybe a)
optionalFieldWith' :: Text -> YamlParser a -> ObjectParser (Maybe a)
optionalFieldWith' Text
k YamlParser a
func = Text -> FieldParser (Maybe a) -> ObjectParser (Maybe a)
forall o. Text -> FieldParser o -> Parser Object o
ParseField Text
k (FieldParser (Maybe a) -> ObjectParser (Maybe a))
-> FieldParser (Maybe a) -> ObjectParser (Maybe a)
forall a b. (a -> b) -> a -> b
$ (Maybe (Maybe a) -> Maybe a)
-> FieldParser (Maybe (Maybe a)) -> FieldParser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (FieldParser (Maybe (Maybe a)) -> FieldParser (Maybe a))
-> FieldParser (Maybe (Maybe a)) -> FieldParser (Maybe a)
forall a b. (a -> b) -> a -> b
$ YamlParser (Maybe a) -> FieldParser (Maybe (Maybe a))
forall o. YamlParser o -> FieldParser (Maybe o)
FieldParserOptional (YamlParser (Maybe a) -> FieldParser (Maybe (Maybe a)))
-> YamlParser (Maybe a) -> FieldParser (Maybe (Maybe a))
forall a b. (a -> b) -> a -> b
$ YamlParser a -> YamlParser (Maybe a)
forall o. Parser Value o -> Parser Value (Maybe o)
ParseMaybe YamlParser a
func
optionalFieldWithDefaultWith :: Show a => Text -> a -> Text -> YamlParser a -> ObjectParser a
optionalFieldWithDefaultWith :: Text -> a -> Text -> YamlParser a -> ObjectParser a
optionalFieldWithDefaultWith Text
k a
d Text
h YamlParser a
func = Text -> ObjectParser a -> ObjectParser a
forall i o. Text -> Parser i o -> Parser i o
ParseComment Text
h (ObjectParser a -> ObjectParser a)
-> ObjectParser a -> ObjectParser a
forall a b. (a -> b) -> a -> b
$ Text -> FieldParser a -> ObjectParser a
forall o. Text -> FieldParser o -> Parser Object o
ParseField Text
k (FieldParser a -> ObjectParser a)
-> FieldParser a -> ObjectParser a
forall a b. (a -> b) -> a -> b
$ YamlParser a -> a -> FieldParser a
forall o. Show o => YamlParser o -> o -> FieldParser o
FieldParserOptionalWithDefault YamlParser a
func a
d
optionalFieldWithDefaultWith' :: Show a => Text -> a -> YamlParser a -> ObjectParser a
optionalFieldWithDefaultWith' :: Text -> a -> YamlParser a -> ObjectParser a
optionalFieldWithDefaultWith' Text
k a
d YamlParser a
func = Text -> FieldParser a -> ObjectParser a
forall o. Text -> FieldParser o -> Parser Object o
ParseField Text
k (FieldParser a -> ObjectParser a)
-> FieldParser a -> ObjectParser a
forall a b. (a -> b) -> a -> b
$ YamlParser a -> a -> FieldParser a
forall o. Show o => YamlParser o -> o -> FieldParser o
FieldParserOptionalWithDefault YamlParser a
func a
d
maybeParser :: Show o => (o -> Maybe u) -> Parser i o -> Parser i u
maybeParser :: (o -> Maybe u) -> Parser i o -> Parser i u
maybeParser o -> Maybe u
func = (o -> Parser u) -> Parser i o -> Parser i u
forall o u i. (o -> Parser u) -> Parser i o -> Parser i u
ParseExtra ((o -> Parser u) -> Parser i o -> Parser i u)
-> (o -> Parser u) -> Parser i o -> Parser i u
forall a b. (a -> b) -> a -> b
$ \o
o -> case o -> Maybe u
func o
o of
Maybe u
Nothing -> String -> Parser u
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser u) -> String -> Parser u
forall a b. (a -> b) -> a -> b
$ String
"Parsing of " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> o -> String
forall a. Show a => a -> String
show o
o String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" failed."
Just u
u -> u -> Parser u
forall (f :: * -> *) a. Applicative f => a -> f a
pure u
u
eitherParser :: Show o => (o -> Either String u) -> Parser i o -> Parser i u
eitherParser :: (o -> Either String u) -> Parser i o -> Parser i u
eitherParser o -> Either String u
func = (o -> Parser u) -> Parser i o -> Parser i u
forall o u i. (o -> Parser u) -> Parser i o -> Parser i u
ParseExtra ((o -> Parser u) -> Parser i o -> Parser i u)
-> (o -> Parser u) -> Parser i o -> Parser i u
forall a b. (a -> b) -> a -> b
$ \o
o -> case o -> Either String u
func o
o of
Left String
err -> String -> Parser u
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser u) -> String -> Parser u
forall a b. (a -> b) -> a -> b
$ String
"Parsing of " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> o -> String
forall a. Show a => a -> String
show o
o String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" failed with error: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"."
Right u
u -> u -> Parser u
forall (f :: * -> *) a. Applicative f => a -> f a
pure u
u
extraParser :: (o -> Yaml.Parser u) -> Parser i o -> Parser i u
= (o -> Parser u) -> Parser i o -> Parser i u
forall o u i. (o -> Parser u) -> Parser i o -> Parser i u
ParseExtra