module Descriptive.JSON
(
obj
,key
,string
,integer
,Doc(..)
)
where
import Data.Bifunctor
import Data.Monoid
import Descriptive
import Data.Aeson
import Data.Aeson.Types
import Data.Text (Text)
data Doc
= Integer !Text
| Text !Text
| Struct !Text
| Key !Text
deriving (Show,Eq)
obj :: Text
-> Consumer Object Doc a
-> Consumer Value Doc a
obj desc =
wrap (\v d -> (Wrap doc (fst (d mempty)),v))
(\v _ p ->
case fromJSON v of
Error{} -> (Failed (Unit doc),v)
Success o ->
(case p o of
(Failed e,_) -> Failed (Wrap doc e)
(Continued e,_) -> Failed (Wrap doc e)
(Succeeded a,_) -> Succeeded a
,toJSON o))
where doc = Struct desc
key :: Text
-> Consumer Value Doc a
-> Consumer Object Doc a
key k =
wrap (\o d ->
first (Wrap doc)
(second (const o)
(d (toJSON o))))
(\o _ p ->
case parseMaybe (const (o .: k))
() of
Nothing -> (Failed (Unit doc),o)
Just (v :: Value) ->
first (bimap (Wrap doc) id)
(second (const o)
(p v)))
where doc = Key k
string :: Text
-> Consumer Value Doc Text
string doc =
consumer (d,)
(\s ->
case fromJSON s of
Error{} -> (Failed d,s)
Success a -> (Succeeded a,s))
where d = Unit (Text doc)
integer :: Text
-> Consumer Value Doc Integer
integer doc =
consumer (d,)
(\s ->
case fromJSON s of
Error{} -> (Failed d,s)
Success a -> (Succeeded a,s))
where d = Unit (Integer doc)