{-# 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
import Data.HashMap.Strict (HashMap)
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
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 (HashMap Text v)
ParseMapKeys ::
Ord k =>
Parser Text k ->
Parser Yaml.Object (HashMap Text 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