{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}

-- | A JSON API which describes itself.

module Descriptive.JSON
  (-- * Consumers
   parse
  ,object
  ,key
  ,keyMaybe
  ,array
  ,string
  ,integer
  ,double
  ,bool
  ,null
  -- * Annotations
  ,label
  -- * Description
  ,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)

-- | Description of parseable things.
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)

-- | Consume an object.
object :: Monad m
       => Text -- ^ Description of what the object is.
       -> Consumer Object (Doc d) m a -- ^ An object consumer.
       -> 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

-- | Consume from object at the given key.
key :: Monad m
    => Text -- ^ The key to lookup.
    -> Consumer Value (Doc d) m a -- ^ A value consumer of the object at the key.
    -> 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

-- | Optionally consume from object at the given key, only if it
-- exists.
keyMaybe :: Monad m
         => Text -- ^ The key to lookup.
         -> Consumer Value (Doc d) m a -- ^ A value consumer of the object at the key.
         -> 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

-- | Consume an array.
array :: Monad m
      => Text -- ^ Description of this array.
      -> Consumer Value (Doc d) m a -- ^ Consumer for each element in the array.
      -> 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

-- | Consume a string.
string :: Monad m
       => Text -- ^ Description of what the string is for.
       -> 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)

-- | Consume an integer.
integer :: Monad m
        => Text -- ^ Description of what the integer is for.
        -> 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)

-- | Consume an double.
double :: Monad m
       => Text -- ^ Description of what the double is for.
       -> 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)

-- | Parse a boolean.
bool :: Monad m
     => Text -- ^ Description of what the bool is for.
     -> 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)

-- | Expect null.
null :: Monad m
     => Text -- ^ What the null is for.
     -> 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)

-- | Wrap a consumer with a label e.g. a type tag.
label :: Monad m
      => d                      -- ^ Some label.
      -> Consumer s (Doc d) m a -- ^ A value consumer.
      -> 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 from a consumer.
parse :: Monad m
      => d                           -- ^ Description of what it expects.
      -> (a -> StateT s m (Maybe b)) -- ^ Attempt to parse the value.
      -> Consumer s d m a            -- ^ Consumer to add validation to.
      -> Consumer s d m b            -- ^ A new validating consumer.
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'