module Descriptive.JSON
(
object
,key
,keyMaybe
,array
,string
,integer
,double
,bool
,null
,label
,Doc(..)
)
where
import Data.Scientific
import Descriptive
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
= Integer !Text
| Double !Text
| Text !Text
| Boolean !Text
| Null !Text
| Object !Text
| Key !Text
| Array !Text
| Label !Text
deriving (Eq,Show,Typeable,Data)
object :: Text
-> Consumer Object Doc a
-> Consumer Value Doc a
object 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 = Object 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
keyMaybe :: Text
-> Consumer Value Doc a
-> Consumer Object Doc (Maybe a)
keyMaybe k =
wrap (\o d ->
first (Wrap doc)
(second (const o)
(d (toJSON o))))
(\o _ p ->
case parseMaybe (const (o .: k))
() of
Nothing -> (Succeeded Nothing,o)
Just (v :: Value) ->
first (bimap (Wrap doc) Just)
(second (const o)
(p v)))
where doc = Key k
array :: Text
-> Consumer Value Doc a
-> Consumer Value Doc (Vector a)
array desc =
wrap (\v d -> (Wrap doc (fst (d Aeson.Null)),v))
(\v _ p ->
case fromJSON v of
Error{} -> (Failed (Unit doc),v)
Success (o :: Vector Value) ->
(fix (\loop i acc ->
if i < V.length o 1
then case p (o ! i) of
(Failed e,_) ->
Failed (Wrap doc e)
(Continued e,_) ->
Failed (Wrap doc e)
(Succeeded a,_) ->
loop (i + 1) (a : acc)
else Succeeded (V.fromList (reverse acc)))
0
[]
,v))
where doc = Array desc
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 s of
Number a
| Right i <- floatingOrInteger a ->
(Succeeded i,s)
_ -> (Failed d,s))
where d = Unit (Integer doc)
double :: Text
-> Consumer Value Doc Double
double doc =
consumer (d,)
(\s ->
case s of
Number a ->
(Succeeded (toRealFloat a),s)
_ -> (Failed d,s))
where d = Unit (Double doc)
bool :: Text
-> Consumer Value Doc Bool
bool doc =
consumer (d,)
(\s ->
case fromJSON s of
Error{} -> (Failed d,s)
Success a -> (Succeeded a,s))
where d = Unit (Boolean doc)
null :: Text
-> Consumer Value Doc ()
null doc =
consumer (d,)
(\s ->
case fromJSON s of
Success Aeson.Null -> (Succeeded (),s)
_ -> (Failed d,s))
where d = Unit (Null doc)
label :: Text
-> Consumer s Doc a
-> Consumer s Doc a
label desc =
wrap (\s d -> (Wrap doc (fst (d s)),s))
(\s _ p -> p s)
where doc = Label desc