{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
module Descriptive.JSON
(
parse
,object
,key
,keyMaybe
,array
,string
,integer
,double
,bool
,null
,label
,Doc(..)
)
where
import Descriptive
import Descriptive.Internal
import Control.Monad.State.Strict
import Data.Scientific
import Data.Function
import Data.Aeson hiding (Value(Object,Null,Array),object)
import Data.Aeson.Types (Value,parseMaybe)
import qualified Data.Aeson.Types as Aeson
import Data.Bifunctor
import Data.Data
import Data.Monoid
import Data.Text (Text)
import Data.Vector ((!))
import Data.Vector (Vector)
import qualified Data.Vector as V
import Prelude hiding (null)
data Doc a
= Integer !Text
| Double !Text
| Text !Text
| Boolean !Text
| Null !Text
| Object !Text
| Key !Text
| Array !Text
| Label !a
deriving (Doc a -> Doc a -> Bool
(Doc a -> Doc a -> Bool) -> (Doc a -> Doc a -> Bool) -> Eq (Doc a)
forall a. Eq a => Doc a -> Doc a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Doc a -> Doc a -> Bool
$c/= :: forall a. Eq a => Doc a -> Doc a -> Bool
== :: Doc a -> Doc a -> Bool
$c== :: forall a. Eq a => Doc a -> Doc a -> Bool
Eq,Int -> Doc a -> ShowS
[Doc a] -> ShowS
Doc a -> String
(Int -> Doc a -> ShowS)
-> (Doc a -> String) -> ([Doc a] -> ShowS) -> Show (Doc a)
forall a. Show a => Int -> Doc a -> ShowS
forall a. Show a => [Doc a] -> ShowS
forall a. Show a => Doc a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Doc a] -> ShowS
$cshowList :: forall a. Show a => [Doc a] -> ShowS
show :: Doc a -> String
$cshow :: forall a. Show a => Doc a -> String
showsPrec :: Int -> Doc a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Doc a -> ShowS
Show,Typeable,Typeable (Doc a)
Constr
DataType
Typeable (Doc a) =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Doc a -> c (Doc a))
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Doc a))
-> (Doc a -> Constr)
-> (Doc a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Doc a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Doc a)))
-> ((forall b. Data b => b -> b) -> Doc a -> Doc a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Doc a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Doc a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a))
-> Data (Doc a)
Doc a -> Constr
Doc a -> DataType
(forall d. Data d => c (t d)) -> Maybe (c (Doc a))
(forall b. Data b => b -> b) -> Doc a -> Doc a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Doc a -> c (Doc a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Doc a)
forall a. Data a => Typeable (Doc a)
forall a. Data a => Doc a -> Constr
forall a. Data a => Doc a -> DataType
forall a. Data a => (forall b. Data b => b -> b) -> Doc a -> Doc a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Doc a -> u
forall a u. Data a => (forall d. Data d => d -> u) -> Doc a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r
forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Doc a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Doc a -> c (Doc a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Doc a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Doc a))
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Doc a -> u
forall u. (forall d. Data d => d -> u) -> Doc a -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Doc a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Doc a -> c (Doc a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Doc a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Doc a))
$cLabel :: Constr
$cArray :: Constr
$cKey :: Constr
$cObject :: Constr
$cNull :: Constr
$cBoolean :: Constr
$cText :: Constr
$cDouble :: Constr
$cInteger :: Constr
$tDoc :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
gmapMp :: (forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
gmapM :: (forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Doc a -> m (Doc a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Doc a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Doc a -> u
gmapQ :: (forall d. Data d => d -> u) -> Doc a -> [u]
$cgmapQ :: forall a u. Data a => (forall d. Data d => d -> u) -> Doc a -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Doc a -> r
gmapT :: (forall b. Data b => b -> b) -> Doc a -> Doc a
$cgmapT :: forall a. Data a => (forall b. Data b => b -> b) -> Doc a -> Doc a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Doc a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Doc a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Doc a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Doc a))
dataTypeOf :: Doc a -> DataType
$cdataTypeOf :: forall a. Data a => Doc a -> DataType
toConstr :: Doc a -> Constr
$ctoConstr :: forall a. Data a => Doc a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Doc a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Doc a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Doc a -> c (Doc a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Doc a -> c (Doc a)
$cp1Data :: forall a. Data a => Typeable (Doc a)
Data)
object :: Monad m
=> Text
-> Consumer Object (Doc d) m a
-> Consumer Value (Doc d) m a
object :: Text -> Consumer Object (Doc d) m a -> Consumer Value (Doc d) m a
object desc :: Text
desc =
(StateT Object m (Description (Doc d))
-> StateT Value m (Description (Doc d)))
-> (StateT Object m (Description (Doc d))
-> StateT Object m (Result (Description (Doc d)) a)
-> StateT Value m (Result (Description (Doc d)) a))
-> Consumer Object (Doc d) m a
-> Consumer Value (Doc d) m a
forall t (m :: * -> *) d s a b.
(StateT t m (Description d) -> StateT s m (Description d))
-> (StateT t m (Description d)
-> StateT t m (Result (Description d) a)
-> StateT s m (Result (Description d) b))
-> Consumer t d m a
-> Consumer s d m b
wrap (\d :: StateT Object m (Description (Doc d))
d ->
do Value
s <- StateT Value m Value
forall s (m :: * -> *). MonadState s m => m s
get
(Value -> Object)
-> (Object -> Value)
-> StateT Object m (Description (Doc d))
-> StateT Value m (Description (Doc d))
forall (m :: * -> *) s s' a.
Monad m =>
(s -> s') -> (s' -> s) -> StateT s' m a -> StateT s m a
runSubStateT (Object -> Value -> Object
forall a b. a -> b -> a
const Object
forall a. Monoid a => a
mempty)
(Value -> Object -> Value
forall a b. a -> b -> a
const Value
s)
((Description (Doc d) -> Description (Doc d))
-> StateT Object m (Description (Doc d))
-> StateT Object m (Description (Doc d))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Doc d -> Description (Doc d) -> Description (Doc d)
forall a. a -> Description a -> Description a
Wrap Doc d
forall a. Doc a
doc) StateT Object m (Description (Doc d))
d))
(\_ p :: StateT Object m (Result (Description (Doc d)) a)
p ->
do Value
v <- StateT Value m Value
forall s (m :: * -> *). MonadState s m => m s
get
case Value -> Result Object
forall a. FromJSON a => Value -> Result a
fromJSON Value
v of
Error{} ->
Result (Description (Doc d)) a
-> StateT Value m (Result (Description (Doc d)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Doc d) -> Result (Description (Doc d)) a
forall e a. e -> Result e a
Continued (Doc d -> Description (Doc d)
forall a. a -> Description a
Unit Doc d
forall a. Doc a
doc))
Success (Object
o :: Object) ->
do Value
s <- StateT Value m Value
forall s (m :: * -> *). MonadState s m => m s
get
(Value -> Object)
-> (Object -> Value)
-> StateT Object m (Result (Description (Doc d)) a)
-> StateT Value m (Result (Description (Doc d)) a)
forall (m :: * -> *) s s' a.
Monad m =>
(s -> s') -> (s' -> s) -> StateT s' m a -> StateT s m a
runSubStateT
(Object -> Value -> Object
forall a b. a -> b -> a
const Object
o)
(Value -> Object -> Value
forall a b. a -> b -> a
const Value
s)
(do Result (Description (Doc d)) a
r <- StateT Object m (Result (Description (Doc d)) a)
p
case Result (Description (Doc d)) a
r of
Failed e :: Description (Doc d)
e ->
Result (Description (Doc d)) a
-> StateT Object m (Result (Description (Doc d)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Doc d) -> Result (Description (Doc d)) a
forall e a. e -> Result e a
Continued (Doc d -> Description (Doc d) -> Description (Doc d)
forall a. a -> Description a -> Description a
Wrap Doc d
forall a. Doc a
doc Description (Doc d)
e))
Continued e :: Description (Doc d)
e ->
Result (Description (Doc d)) a
-> StateT Object m (Result (Description (Doc d)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Doc d) -> Result (Description (Doc d)) a
forall e a. e -> Result e a
Continued (Doc d -> Description (Doc d) -> Description (Doc d)
forall a. a -> Description a -> Description a
Wrap Doc d
forall a. Doc a
doc Description (Doc d)
e))
Succeeded a :: a
a ->
Result (Description (Doc d)) a
-> StateT Object m (Result (Description (Doc d)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Result (Description (Doc d)) a
forall e a. a -> Result e a
Succeeded a
a)))
where doc :: Doc a
doc = Text -> Doc a
forall a. Text -> Doc a
Object Text
desc
key :: Monad m
=> Text
-> Consumer Value (Doc d) m a
-> Consumer Object (Doc d) m a
key :: Text -> Consumer Value (Doc d) m a -> Consumer Object (Doc d) m a
key k :: Text
k =
(StateT Value m (Description (Doc d))
-> StateT Object m (Description (Doc d)))
-> (StateT Value m (Description (Doc d))
-> StateT Value m (Result (Description (Doc d)) a)
-> StateT Object m (Result (Description (Doc d)) a))
-> Consumer Value (Doc d) m a
-> Consumer Object (Doc d) m a
forall t (m :: * -> *) d s a b.
(StateT t m (Description d) -> StateT s m (Description d))
-> (StateT t m (Description d)
-> StateT t m (Result (Description d) a)
-> StateT s m (Result (Description d) b))
-> Consumer t d m a
-> Consumer s d m b
wrap (\d :: StateT Value m (Description (Doc d))
d ->
do Object
s <- StateT Object m Object
forall s (m :: * -> *). MonadState s m => m s
get
(Object -> Value)
-> (Value -> Object)
-> StateT Value m (Description (Doc d))
-> StateT Object m (Description (Doc d))
forall (m :: * -> *) s s' a.
Monad m =>
(s -> s') -> (s' -> s) -> StateT s' m a -> StateT s m a
runSubStateT Object -> Value
forall a. ToJSON a => a -> Value
toJSON
(Object -> Value -> Object
forall a b. a -> b -> a
const Object
s)
((Description (Doc d) -> Description (Doc d))
-> StateT Value m (Description (Doc d))
-> StateT Value m (Description (Doc d))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Doc d -> Description (Doc d) -> Description (Doc d)
forall a. a -> Description a -> Description a
Wrap Doc d
forall a. Doc a
doc) StateT Value m (Description (Doc d))
d))
(\_ p :: StateT Value m (Result (Description (Doc d)) a)
p ->
do Object
s <- StateT Object m Object
forall s (m :: * -> *). MonadState s m => m s
get
case (() -> Parser Value) -> () -> Maybe Value
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe (Parser Value -> () -> Parser Value
forall a b. a -> b -> a
const (Object
s Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
k))
() of
Nothing ->
Result (Description (Doc d)) a
-> StateT Object m (Result (Description (Doc d)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Doc d) -> Result (Description (Doc d)) a
forall e a. e -> Result e a
Continued (Doc d -> Description (Doc d)
forall a. a -> Description a
Unit Doc d
forall a. Doc a
doc))
Just (Value
v :: Value) ->
do Result (Description (Doc d)) a
r <-
(Object -> Value)
-> (Value -> Object)
-> StateT Value m (Result (Description (Doc d)) a)
-> StateT Object m (Result (Description (Doc d)) a)
forall (m :: * -> *) s s' a.
Monad m =>
(s -> s') -> (s' -> s) -> StateT s' m a -> StateT s m a
runSubStateT (Value -> Object -> Value
forall a b. a -> b -> a
const Value
v)
(Object -> Value -> Object
forall a b. a -> b -> a
const Object
s)
StateT Value m (Result (Description (Doc d)) a)
p
Result (Description (Doc d)) a
-> StateT Object m (Result (Description (Doc d)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Description (Doc d) -> Description (Doc d))
-> (a -> a)
-> Result (Description (Doc d)) a
-> Result (Description (Doc d)) a
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Doc d -> Description (Doc d) -> Description (Doc d)
forall a. a -> Description a -> Description a
Wrap Doc d
forall a. Doc a
doc) a -> a
forall a. a -> a
id Result (Description (Doc d)) a
r))
where doc :: Doc a
doc = Text -> Doc a
forall a. Text -> Doc a
Key Text
k
keyMaybe :: Monad m
=> Text
-> Consumer Value (Doc d) m a
-> Consumer Object (Doc d) m (Maybe a)
keyMaybe :: Text
-> Consumer Value (Doc d) m a
-> Consumer Object (Doc d) m (Maybe a)
keyMaybe k :: Text
k =
(StateT Value m (Description (Doc d))
-> StateT Object m (Description (Doc d)))
-> (StateT Value m (Description (Doc d))
-> StateT Value m (Result (Description (Doc d)) a)
-> StateT Object m (Result (Description (Doc d)) (Maybe a)))
-> Consumer Value (Doc d) m a
-> Consumer Object (Doc d) m (Maybe a)
forall t (m :: * -> *) d s a b.
(StateT t m (Description d) -> StateT s m (Description d))
-> (StateT t m (Description d)
-> StateT t m (Result (Description d) a)
-> StateT s m (Result (Description d) b))
-> Consumer t d m a
-> Consumer s d m b
wrap (\d :: StateT Value m (Description (Doc d))
d ->
do Object
s <- StateT Object m Object
forall s (m :: * -> *). MonadState s m => m s
get
(Object -> Value)
-> (Value -> Object)
-> StateT Value m (Description (Doc d))
-> StateT Object m (Description (Doc d))
forall (m :: * -> *) s s' a.
Monad m =>
(s -> s') -> (s' -> s) -> StateT s' m a -> StateT s m a
runSubStateT Object -> Value
forall a. ToJSON a => a -> Value
toJSON
(Object -> Value -> Object
forall a b. a -> b -> a
const Object
s)
((Description (Doc d) -> Description (Doc d))
-> StateT Value m (Description (Doc d))
-> StateT Value m (Description (Doc d))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Doc d -> Description (Doc d) -> Description (Doc d)
forall a. a -> Description a -> Description a
Wrap Doc d
forall a. Doc a
doc) StateT Value m (Description (Doc d))
d))
(\_ p :: StateT Value m (Result (Description (Doc d)) a)
p ->
do Object
s <- StateT Object m Object
forall s (m :: * -> *). MonadState s m => m s
get
case (() -> Parser Value) -> () -> Maybe Value
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe (Parser Value -> () -> Parser Value
forall a b. a -> b -> a
const (Object
s Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
k))
() of
Nothing ->
Result (Description (Doc d)) (Maybe a)
-> StateT Object m (Result (Description (Doc d)) (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Result (Description (Doc d)) (Maybe a)
forall e a. a -> Result e a
Succeeded Maybe a
forall a. Maybe a
Nothing)
Just (Value
v :: Value) ->
do Result (Description (Doc d)) a
r <-
(Object -> Value)
-> (Value -> Object)
-> StateT Value m (Result (Description (Doc d)) a)
-> StateT Object m (Result (Description (Doc d)) a)
forall (m :: * -> *) s s' a.
Monad m =>
(s -> s') -> (s' -> s) -> StateT s' m a -> StateT s m a
runSubStateT (Value -> Object -> Value
forall a b. a -> b -> a
const Value
v)
(Object -> Value -> Object
forall a b. a -> b -> a
const Object
s)
StateT Value m (Result (Description (Doc d)) a)
p
Result (Description (Doc d)) (Maybe a)
-> StateT Object m (Result (Description (Doc d)) (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Description (Doc d) -> Description (Doc d))
-> (a -> Maybe a)
-> Result (Description (Doc d)) a
-> Result (Description (Doc d)) (Maybe a)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Doc d -> Description (Doc d) -> Description (Doc d)
forall a. a -> Description a -> Description a
Wrap Doc d
forall a. Doc a
doc) a -> Maybe a
forall a. a -> Maybe a
Just Result (Description (Doc d)) a
r))
where doc :: Doc a
doc = Text -> Doc a
forall a. Text -> Doc a
Key Text
k
array :: Monad m
=> Text
-> Consumer Value (Doc d) m a
-> Consumer Value (Doc d) m (Vector a)
array :: Text
-> Consumer Value (Doc d) m a
-> Consumer Value (Doc d) m (Vector a)
array desc :: Text
desc =
(StateT Value m (Description (Doc d))
-> StateT Value m (Description (Doc d)))
-> (StateT Value m (Description (Doc d))
-> StateT Value m (Result (Description (Doc d)) a)
-> StateT Value m (Result (Description (Doc d)) (Vector a)))
-> Consumer Value (Doc d) m a
-> Consumer Value (Doc d) m (Vector a)
forall t (m :: * -> *) d s a b.
(StateT t m (Description d) -> StateT s m (Description d))
-> (StateT t m (Description d)
-> StateT t m (Result (Description d) a)
-> StateT s m (Result (Description d) b))
-> Consumer t d m a
-> Consumer s d m b
wrap (\d :: StateT Value m (Description (Doc d))
d -> (Description (Doc d) -> Description (Doc d))
-> StateT Value m (Description (Doc d))
-> StateT Value m (Description (Doc d))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Doc d -> Description (Doc d) -> Description (Doc d)
forall a. a -> Description a -> Description a
Wrap Doc d
forall a. Doc a
doc) StateT Value m (Description (Doc d))
d)
(\_ p :: StateT Value m (Result (Description (Doc d)) a)
p ->
do Value
s <- StateT Value m Value
forall s (m :: * -> *). MonadState s m => m s
get
case Value -> Result (Vector Value)
forall a. FromJSON a => Value -> Result a
fromJSON Value
s of
Error{} ->
Result (Description (Doc d)) (Vector a)
-> StateT Value m (Result (Description (Doc d)) (Vector a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Doc d) -> Result (Description (Doc d)) (Vector a)
forall e a. e -> Result e a
Continued (Doc d -> Description (Doc d)
forall a. a -> Description a
Unit Doc d
forall a. Doc a
doc))
Success (Vector Value
o :: Vector Value) ->
((Int
-> [a] -> StateT Value m (Result (Description (Doc d)) (Vector a)))
-> Int
-> [a]
-> StateT Value m (Result (Description (Doc d)) (Vector a)))
-> Int
-> [a]
-> StateT Value m (Result (Description (Doc d)) (Vector a))
forall a. (a -> a) -> a
fix (\loop :: Int
-> [a] -> StateT Value m (Result (Description (Doc d)) (Vector a))
loop i :: Int
i acc :: [a]
acc ->
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Vector Value -> Int
forall a. Vector a -> Int
V.length Vector Value
o
then do Result (Description (Doc d)) a
r <-
(Value -> Value)
-> (Value -> Value)
-> StateT Value m (Result (Description (Doc d)) a)
-> StateT Value m (Result (Description (Doc d)) a)
forall (m :: * -> *) s s' a.
Monad m =>
(s -> s') -> (s' -> s) -> StateT s' m a -> StateT s m a
runSubStateT (Value -> Value -> Value
forall a b. a -> b -> a
const (Vector Value
o Vector Value -> Int -> Value
forall a. Vector a -> Int -> a
! Int
i))
(Value -> Value -> Value
forall a b. a -> b -> a
const Value
s)
StateT Value m (Result (Description (Doc d)) a)
p
case Result (Description (Doc d)) a
r of
Failed e :: Description (Doc d)
e ->
Result (Description (Doc d)) (Vector a)
-> StateT Value m (Result (Description (Doc d)) (Vector a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Doc d) -> Result (Description (Doc d)) (Vector a)
forall e a. e -> Result e a
Continued (Doc d -> Description (Doc d) -> Description (Doc d)
forall a. a -> Description a -> Description a
Wrap Doc d
forall a. Doc a
doc Description (Doc d)
e))
Continued e :: Description (Doc d)
e ->
Result (Description (Doc d)) (Vector a)
-> StateT Value m (Result (Description (Doc d)) (Vector a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Doc d) -> Result (Description (Doc d)) (Vector a)
forall e a. e -> Result e a
Continued (Doc d -> Description (Doc d) -> Description (Doc d)
forall a. a -> Description a -> Description a
Wrap Doc d
forall a. Doc a
doc Description (Doc d)
e))
Succeeded a :: a
a ->
Int
-> [a] -> StateT Value m (Result (Description (Doc d)) (Vector a))
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
(a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)
else Result (Description (Doc d)) (Vector a)
-> StateT Value m (Result (Description (Doc d)) (Vector a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector a -> Result (Description (Doc d)) (Vector a)
forall e a. a -> Result e a
Succeeded ([a] -> Vector a
forall a. [a] -> Vector a
V.fromList ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
acc))))
0
[])
where doc :: Doc a
doc = Text -> Doc a
forall a. Text -> Doc a
Array Text
desc
string :: Monad m
=> Text
-> Consumer Value (Doc d) m Text
string :: Text -> Consumer Value (Doc d) m Text
string doc :: Text
doc =
StateT Value m (Description (Doc d))
-> StateT Value m (Result (Description (Doc d)) Text)
-> Consumer Value (Doc d) m Text
forall s (m :: * -> *) d a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
consumer (Description (Doc d) -> StateT Value m (Description (Doc d))
forall (m :: * -> *) a. Monad m => a -> m a
return Description (Doc d)
forall a. Description (Doc a)
d)
(do Value
s <- StateT Value m Value
forall s (m :: * -> *). MonadState s m => m s
get
case Value -> Result Text
forall a. FromJSON a => Value -> Result a
fromJSON Value
s of
Error{} -> Result (Description (Doc d)) Text
-> StateT Value m (Result (Description (Doc d)) Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Doc d) -> Result (Description (Doc d)) Text
forall e a. e -> Result e a
Continued Description (Doc d)
forall a. Description (Doc a)
d)
Success a :: Text
a ->
Result (Description (Doc d)) Text
-> StateT Value m (Result (Description (Doc d)) Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Result (Description (Doc d)) Text
forall e a. a -> Result e a
Succeeded Text
a))
where d :: Description (Doc a)
d = Doc a -> Description (Doc a)
forall a. a -> Description a
Unit (Text -> Doc a
forall a. Text -> Doc a
Text Text
doc)
integer :: Monad m
=> Text
-> Consumer Value (Doc d) m Integer
integer :: Text -> Consumer Value (Doc d) m Integer
integer doc :: Text
doc =
StateT Value m (Description (Doc d))
-> StateT Value m (Result (Description (Doc d)) Integer)
-> Consumer Value (Doc d) m Integer
forall s (m :: * -> *) d a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
consumer (Description (Doc d) -> StateT Value m (Description (Doc d))
forall (m :: * -> *) a. Monad m => a -> m a
return Description (Doc d)
forall a. Description (Doc a)
d)
(do Value
s <- StateT Value m Value
forall s (m :: * -> *). MonadState s m => m s
get
case Value
s of
Number a :: Scientific
a
| Right i :: Integer
i <- Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
a ->
Result (Description (Doc d)) Integer
-> StateT Value m (Result (Description (Doc d)) Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Result (Description (Doc d)) Integer
forall e a. a -> Result e a
Succeeded Integer
i)
_ -> Result (Description (Doc d)) Integer
-> StateT Value m (Result (Description (Doc d)) Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Doc d) -> Result (Description (Doc d)) Integer
forall e a. e -> Result e a
Continued Description (Doc d)
forall a. Description (Doc a)
d))
where d :: Description (Doc a)
d = Doc a -> Description (Doc a)
forall a. a -> Description a
Unit (Text -> Doc a
forall a. Text -> Doc a
Integer Text
doc)
double :: Monad m
=> Text
-> Consumer Value (Doc d) m Double
double :: Text -> Consumer Value (Doc d) m Double
double doc :: Text
doc =
StateT Value m (Description (Doc d))
-> StateT Value m (Result (Description (Doc d)) Double)
-> Consumer Value (Doc d) m Double
forall s (m :: * -> *) d a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
consumer (Description (Doc d) -> StateT Value m (Description (Doc d))
forall (m :: * -> *) a. Monad m => a -> m a
return Description (Doc d)
forall a. Description (Doc a)
d)
(do Value
s <- StateT Value m Value
forall s (m :: * -> *). MonadState s m => m s
get
case Value
s of
Number a :: Scientific
a ->
Result (Description (Doc d)) Double
-> StateT Value m (Result (Description (Doc d)) Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Result (Description (Doc d)) Double
forall e a. a -> Result e a
Succeeded (Scientific -> Double
forall a. RealFloat a => Scientific -> a
toRealFloat Scientific
a))
_ -> Result (Description (Doc d)) Double
-> StateT Value m (Result (Description (Doc d)) Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Doc d) -> Result (Description (Doc d)) Double
forall e a. e -> Result e a
Continued Description (Doc d)
forall a. Description (Doc a)
d))
where d :: Description (Doc a)
d = Doc a -> Description (Doc a)
forall a. a -> Description a
Unit (Text -> Doc a
forall a. Text -> Doc a
Double Text
doc)
bool :: Monad m
=> Text
-> Consumer Value (Doc d) m Bool
bool :: Text -> Consumer Value (Doc d) m Bool
bool doc :: Text
doc =
StateT Value m (Description (Doc d))
-> StateT Value m (Result (Description (Doc d)) Bool)
-> Consumer Value (Doc d) m Bool
forall s (m :: * -> *) d a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
consumer (Description (Doc d) -> StateT Value m (Description (Doc d))
forall (m :: * -> *) a. Monad m => a -> m a
return Description (Doc d)
forall a. Description (Doc a)
d)
(do Value
s <- StateT Value m Value
forall s (m :: * -> *). MonadState s m => m s
get
case Value -> Result Bool
forall a. FromJSON a => Value -> Result a
fromJSON Value
s of
Error{} -> Result (Description (Doc d)) Bool
-> StateT Value m (Result (Description (Doc d)) Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Doc d) -> Result (Description (Doc d)) Bool
forall e a. e -> Result e a
Continued Description (Doc d)
forall a. Description (Doc a)
d)
Success a :: Bool
a ->
Result (Description (Doc d)) Bool
-> StateT Value m (Result (Description (Doc d)) Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Result (Description (Doc d)) Bool
forall e a. a -> Result e a
Succeeded Bool
a))
where d :: Description (Doc a)
d = Doc a -> Description (Doc a)
forall a. a -> Description a
Unit (Text -> Doc a
forall a. Text -> Doc a
Boolean Text
doc)
null :: Monad m
=> Text
-> Consumer Value (Doc d) m ()
null :: Text -> Consumer Value (Doc d) m ()
null doc :: Text
doc =
StateT Value m (Description (Doc d))
-> StateT Value m (Result (Description (Doc d)) ())
-> Consumer Value (Doc d) m ()
forall s (m :: * -> *) d a.
StateT s m (Description d)
-> StateT s m (Result (Description d) a) -> Consumer s d m a
consumer (Description (Doc d) -> StateT Value m (Description (Doc d))
forall (m :: * -> *) a. Monad m => a -> m a
return Description (Doc d)
forall a. Description (Doc a)
d)
(do Value
s <- StateT Value m Value
forall s (m :: * -> *). MonadState s m => m s
get
case Value -> Result Value
forall a. FromJSON a => Value -> Result a
fromJSON Value
s of
Success Aeson.Null ->
Result (Description (Doc d)) ()
-> StateT Value m (Result (Description (Doc d)) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Result (Description (Doc d)) ()
forall e a. a -> Result e a
Succeeded ())
_ -> Result (Description (Doc d)) ()
-> StateT Value m (Result (Description (Doc d)) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Doc d) -> Result (Description (Doc d)) ()
forall e a. e -> Result e a
Continued Description (Doc d)
forall a. Description (Doc a)
d))
where d :: Description (Doc a)
d = Doc a -> Description (Doc a)
forall a. a -> Description a
Unit (Text -> Doc a
forall a. Text -> Doc a
Null Text
doc)
label :: Monad m
=> d
-> Consumer s (Doc d) m a
-> Consumer s (Doc d) m a
label :: d -> Consumer s (Doc d) m a -> Consumer s (Doc d) m a
label desc :: d
desc =
(StateT s m (Description (Doc d))
-> StateT s m (Description (Doc d)))
-> (StateT s m (Description (Doc d))
-> StateT s m (Result (Description (Doc d)) a)
-> StateT s m (Result (Description (Doc d)) a))
-> Consumer s (Doc d) m a
-> Consumer s (Doc d) m a
forall t (m :: * -> *) d s a b.
(StateT t m (Description d) -> StateT s m (Description d))
-> (StateT t m (Description d)
-> StateT t m (Result (Description d) a)
-> StateT s m (Result (Description d) b))
-> Consumer t d m a
-> Consumer s d m b
wrap ((Description (Doc d) -> Description (Doc d))
-> StateT s m (Description (Doc d))
-> StateT s m (Description (Doc d))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Doc d -> Description (Doc d) -> Description (Doc d)
forall a. a -> Description a -> Description a
Wrap Doc d
doc))
(\_ p :: StateT s m (Result (Description (Doc d)) a)
p ->
do Result (Description (Doc d)) a
r <- StateT s m (Result (Description (Doc d)) a)
p
case Result (Description (Doc d)) a
r of
Failed e :: Description (Doc d)
e ->
Result (Description (Doc d)) a
-> StateT s m (Result (Description (Doc d)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Doc d) -> Result (Description (Doc d)) a
forall e a. e -> Result e a
Failed (Doc d -> Description (Doc d) -> Description (Doc d)
forall a. a -> Description a -> Description a
Wrap Doc d
doc Description (Doc d)
e))
Continued e :: Description (Doc d)
e ->
Result (Description (Doc d)) a
-> StateT s m (Result (Description (Doc d)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description (Doc d) -> Result (Description (Doc d)) a
forall e a. e -> Result e a
Continued (Doc d -> Description (Doc d) -> Description (Doc d)
forall a. a -> Description a -> Description a
Wrap Doc d
doc Description (Doc d)
e))
k :: Result (Description (Doc d)) a
k -> Result (Description (Doc d)) a
-> StateT s m (Result (Description (Doc d)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Result (Description (Doc d)) a
k)
where doc :: Doc d
doc = d -> Doc d
forall a. a -> Doc a
Label d
desc
parse :: Monad m
=> d
-> (a -> StateT s m (Maybe b))
-> Consumer s d m a
-> Consumer s d m b
parse :: d
-> (a -> StateT s m (Maybe b))
-> Consumer s d m a
-> Consumer s d m b
parse d' :: d
d' check :: a -> StateT s m (Maybe b)
check =
(StateT s m (Description d) -> StateT s m (Description d))
-> (StateT s m (Description d)
-> StateT s m (Result (Description d) a)
-> StateT s m (Result (Description d) b))
-> Consumer s d m a
-> Consumer s d m b
forall t (m :: * -> *) d s a b.
(StateT t m (Description d) -> StateT s m (Description d))
-> (StateT t m (Description d)
-> StateT t m (Result (Description d) a)
-> StateT s m (Result (Description d) b))
-> Consumer t d m a
-> Consumer s d m b
wrap ((Description d -> Description d)
-> StateT s m (Description d) -> StateT s m (Description d)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Description d -> Description d
wrapper)
(\d :: StateT s m (Description d)
d p :: StateT s m (Result (Description d) a)
p ->
do s
s <- StateT s m s
forall s (m :: * -> *). MonadState s m => m s
get
Result (Description d) a
r <- StateT s m (Result (Description d) a)
p
case Result (Description d) a
r of
(Failed e :: Description d
e) -> Result (Description d) b -> StateT s m (Result (Description d) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) b
forall e a. e -> Result e a
Failed Description d
e)
(Continued e :: Description d
e) ->
Result (Description d) b -> StateT s m (Result (Description d) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) b
forall e a. e -> Result e a
Continued Description d
e)
(Succeeded a :: a
a) ->
do Maybe b
r' <- a -> StateT s m (Maybe b)
check a
a
case Maybe b
r' of
Nothing ->
do Description d
doc <- (s -> s)
-> StateT s m (Description d) -> StateT s m (Description d)
forall s (m :: * -> *) a. (s -> s) -> StateT s m a -> StateT s m a
withStateT (s -> s -> s
forall a b. a -> b -> a
const s
s) StateT s m (Description d)
d
Result (Description d) b -> StateT s m (Result (Description d) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Description d -> Result (Description d) b
forall e a. e -> Result e a
Continued (Description d -> Description d
wrapper Description d
doc))
Just a' :: b
a' -> Result (Description d) b -> StateT s m (Result (Description d) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Result (Description d) b
forall e a. a -> Result e a
Succeeded b
a'))
where wrapper :: Description d -> Description d
wrapper = d -> Description d -> Description d
forall a. a -> Description a -> Description a
Wrap d
d'