{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
module Data.ByteString.Streaming.Aeson
( DecodingError(..)
, encode
, decode
, decoded
, streamParse
) where
import Control.Exception (Exception)
import Control.Monad.Trans
import qualified Control.Monad.Trans.State.Strict as S
import Control.Monad.Trans.State.Strict (StateT(..))
import qualified Data.Aeson as Ae
import qualified Data.Attoparsec.ByteString as Attoparsec
import qualified Data.ByteString as S
import qualified Data.ByteString.Internal as S (isSpaceWord8)
import Data.Data (Data, Typeable)
import qualified Data.Attoparsec.ByteString.Streaming as PA
import Data.ByteString.Streaming
import Data.ByteString.Streaming.Internal
import qualified Data.ByteString.Streaming as B
import Streaming
import Streaming.Internal (Stream(..))
import Streaming.Prelude (yield)
import qualified Data.JsonStream.Parser as J
import Data.JsonStream.Parser (ParseOutput (..))
type ParsingError = ([String],String)
data DecodingError
= AttoparsecError ParsingError
| FromJSONError String
deriving (Int -> DecodingError -> ShowS
[DecodingError] -> ShowS
DecodingError -> String
(Int -> DecodingError -> ShowS)
-> (DecodingError -> String)
-> ([DecodingError] -> ShowS)
-> Show DecodingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecodingError] -> ShowS
$cshowList :: [DecodingError] -> ShowS
show :: DecodingError -> String
$cshow :: DecodingError -> String
showsPrec :: Int -> DecodingError -> ShowS
$cshowsPrec :: Int -> DecodingError -> ShowS
Show, DecodingError -> DecodingError -> Bool
(DecodingError -> DecodingError -> Bool)
-> (DecodingError -> DecodingError -> Bool) -> Eq DecodingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecodingError -> DecodingError -> Bool
$c/= :: DecodingError -> DecodingError -> Bool
== :: DecodingError -> DecodingError -> Bool
$c== :: DecodingError -> DecodingError -> Bool
Eq, Typeable DecodingError
DataType
Constr
Typeable DecodingError
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DecodingError -> c DecodingError)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DecodingError)
-> (DecodingError -> Constr)
-> (DecodingError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DecodingError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DecodingError))
-> ((forall b. Data b => b -> b) -> DecodingError -> DecodingError)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DecodingError -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DecodingError -> r)
-> (forall u. (forall d. Data d => d -> u) -> DecodingError -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> DecodingError -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DecodingError -> m DecodingError)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DecodingError -> m DecodingError)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DecodingError -> m DecodingError)
-> Data DecodingError
DecodingError -> DataType
DecodingError -> Constr
(forall b. Data b => b -> b) -> DecodingError -> DecodingError
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DecodingError -> c DecodingError
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DecodingError
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) -> DecodingError -> u
forall u. (forall d. Data d => d -> u) -> DecodingError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DecodingError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DecodingError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DecodingError -> m DecodingError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DecodingError -> m DecodingError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DecodingError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DecodingError -> c DecodingError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DecodingError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DecodingError)
$cFromJSONError :: Constr
$cAttoparsecError :: Constr
$tDecodingError :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DecodingError -> m DecodingError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DecodingError -> m DecodingError
gmapMp :: (forall d. Data d => d -> m d) -> DecodingError -> m DecodingError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DecodingError -> m DecodingError
gmapM :: (forall d. Data d => d -> m d) -> DecodingError -> m DecodingError
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DecodingError -> m DecodingError
gmapQi :: Int -> (forall d. Data d => d -> u) -> DecodingError -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DecodingError -> u
gmapQ :: (forall d. Data d => d -> u) -> DecodingError -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DecodingError -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DecodingError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DecodingError -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DecodingError -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DecodingError -> r
gmapT :: (forall b. Data b => b -> b) -> DecodingError -> DecodingError
$cgmapT :: (forall b. Data b => b -> b) -> DecodingError -> DecodingError
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DecodingError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DecodingError)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DecodingError)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DecodingError)
dataTypeOf :: DecodingError -> DataType
$cdataTypeOf :: DecodingError -> DataType
toConstr :: DecodingError -> Constr
$ctoConstr :: DecodingError -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DecodingError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DecodingError
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DecodingError -> c DecodingError
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DecodingError -> c DecodingError
$cp1Data :: Typeable DecodingError
Data, Typeable)
instance Exception DecodingError
encode :: (Monad m, Ae.ToJSON a) => a -> ByteString m ()
encode :: a -> ByteString m ()
encode = ByteString -> ByteString m ()
forall (m :: * -> *). Monad m => ByteString -> ByteStream m ()
fromLazy (ByteString -> ByteString m ())
-> (a -> ByteString) -> a -> ByteString m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
Ae.encode
decode
:: (Monad m, Ae.FromJSON a)
=> StateT (ByteString m x) m (Either DecodingError a)
decode :: StateT (ByteString m x) m (Either DecodingError a)
decode = do
Either Value Message
mev <- (ByteString m x -> m (Either Value Message, ByteString m x))
-> StateT (ByteString m x) m (Either Value Message)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (Parser Value
-> ByteString m x -> m (Either Value Message, ByteString m x)
forall (m :: * -> *) a x.
Monad m =>
Parser a -> ByteString m x -> m (Either a Message, ByteString m x)
PA.parse Parser Value
Ae.json')
Either DecodingError a
-> StateT (ByteString m x) m (Either DecodingError a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DecodingError a
-> StateT (ByteString m x) m (Either DecodingError a))
-> Either DecodingError a
-> StateT (ByteString m x) m (Either DecodingError a)
forall a b. (a -> b) -> a -> b
$ case Either Value Message
mev of
Right Message
l -> DecodingError -> Either DecodingError a
forall a b. a -> Either a b
Left (Message -> DecodingError
AttoparsecError Message
l)
Left Value
v -> case Value -> Result a
forall a. FromJSON a => Value -> Result a
Ae.fromJSON Value
v of
Ae.Error String
e -> DecodingError -> Either DecodingError a
forall a b. a -> Either a b
Left (String -> DecodingError
FromJSONError String
e)
Ae.Success a
a -> a -> Either DecodingError a
forall a b. b -> Either a b
Right a
a
decoded :: (Monad m, Ae.FromJSON a) =>
ByteString m r
-> Stream (Of a) m (Either (DecodingError, ByteString m r) r)
decoded :: ByteString m r
-> Stream (Of a) m (Either (DecodingError, ByteString m r) r)
decoded = StateT (ByteString m r) m (Either DecodingError a)
-> ByteString m r
-> Stream (Of a) m (Either (DecodingError, ByteString m r) r)
forall (m :: * -> *) r e a.
Monad m =>
StateT (ByteString m r) m (Either e a)
-> ByteString m r -> Stream (Of a) m (Either (e, ByteString m r) r)
consecutively StateT (ByteString m r) m (Either DecodingError a)
forall (m :: * -> *) a x.
(Monad m, FromJSON a) =>
StateT (ByteString m x) m (Either DecodingError a)
decode
where
consecutively
:: (Monad m)
=> StateT (ByteString m r) m (Either e a)
-> ByteString m r
-> Stream (Of a) m (Either (e, ByteString m r) r)
consecutively :: StateT (ByteString m r) m (Either e a)
-> ByteString m r -> Stream (Of a) m (Either (e, ByteString m r) r)
consecutively StateT (ByteString m r) m (Either e a)
parser = ByteString m r -> Stream (Of a) m (Either (e, ByteString m r) r)
step where
step :: ByteString m r -> Stream (Of a) m (Either (e, ByteString m r) r)
step ByteString m r
p0 = do
Either r (ByteString, ByteString m r)
x <- m (Either r (ByteString, ByteString m r))
-> Stream (Of a) m (Either r (ByteString, ByteString m r))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either r (ByteString, ByteString m r))
-> Stream (Of a) m (Either r (ByteString, ByteString m r)))
-> m (Either r (ByteString, ByteString m r))
-> Stream (Of a) m (Either r (ByteString, ByteString m r))
forall a b. (a -> b) -> a -> b
$ ByteString m r -> m (Either r (ByteString, ByteString m r))
forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> m (Either r (ByteString, ByteStream m r))
nextSkipBlank ByteString m r
p0
case Either r (ByteString, ByteString m r)
x of
Left r
r -> Either (e, ByteString m r) r
-> Stream (Of a) m (Either (e, ByteString m r) r)
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return (r -> Either (e, ByteString m r) r
forall a b. b -> Either a b
Right r
r)
Right (ByteString
bs, ByteString m r
p1) -> do
(Either e a
mea, ByteString m r
p2) <- m (Either e a, ByteString m r)
-> Stream (Of a) m (Either e a, ByteString m r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either e a, ByteString m r)
-> Stream (Of a) m (Either e a, ByteString m r))
-> m (Either e a, ByteString m r)
-> Stream (Of a) m (Either e a, ByteString m r)
forall a b. (a -> b) -> a -> b
$ StateT (ByteString m r) m (Either e a)
-> ByteString m r -> m (Either e a, ByteString m r)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT StateT (ByteString m r) m (Either e a)
parser (ByteString -> ByteString m r -> ByteString m r
forall (m :: * -> *) r.
ByteString -> ByteStream m r -> ByteStream m r
Chunk ByteString
bs ByteString m r
p1)
case Either e a
mea of
Right a
a -> do
a -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield a
a
ByteString m r -> Stream (Of a) m (Either (e, ByteString m r) r)
step ByteString m r
p2
Left e
e -> Either (e, ByteString m r) r
-> Stream (Of a) m (Either (e, ByteString m r) r)
forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return ((e, ByteString m r) -> Either (e, ByteString m r) r
forall a b. a -> Either a b
Left (e
e, ByteString m r
p2))
nextSkipBlank :: ByteStream m r -> m (Either r (ByteString, ByteStream m r))
nextSkipBlank ByteStream m r
p0 = do
Either r (ByteString, ByteStream m r)
x <- ByteStream m r -> m (Either r (ByteString, ByteStream m r))
forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> m (Either r (ByteString, ByteStream m r))
nextChunk ByteStream m r
p0
case Either r (ByteString, ByteStream m r)
x of
Left r
_ -> Either r (ByteString, ByteStream m r)
-> m (Either r (ByteString, ByteStream m r))
forall (m :: * -> *) a. Monad m => a -> m a
return Either r (ByteString, ByteStream m r)
x
Right (ByteString
a,ByteStream m r
p1) -> do
let a' :: ByteString
a' = (Word8 -> Bool) -> ByteString -> ByteString
S.dropWhile Word8 -> Bool
S.isSpaceWord8 ByteString
a
if ByteString -> Bool
S.null ByteString
a' then ByteStream m r -> m (Either r (ByteString, ByteStream m r))
nextSkipBlank ByteStream m r
p1
else Either r (ByteString, ByteStream m r)
-> m (Either r (ByteString, ByteStream m r))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString, ByteStream m r)
-> Either r (ByteString, ByteStream m r)
forall a b. b -> Either a b
Right (ByteString
a', ByteStream m r
p1))
streamParse
:: (Monad m) =>
J.Parser a
-> ByteString m r
-> Stream (Of a) m (Maybe String, ByteString m r)
streamParse :: Parser a
-> ByteString m r -> Stream (Of a) m (Maybe String, ByteString m r)
streamParse Parser a
parser ByteString m r
input = ByteString m r
-> ParseOutput a -> Stream (Of a) m (Maybe String, ByteString m r)
forall (m :: * -> *) a a.
Monad m =>
ByteStream m a
-> ParseOutput a -> Stream (Of a) m (Maybe String, ByteStream m a)
loop ByteString m r
input (Parser a -> ParseOutput a
forall a. Parser a -> ParseOutput a
J.runParser Parser a
parser) where
loop :: ByteStream m a
-> ParseOutput a -> Stream (Of a) m (Maybe String, ByteStream m a)
loop ByteStream m a
bytes ParseOutput a
p0 = case ParseOutput a
p0 of
ParseFailed String
s -> (Maybe String, ByteStream m a)
-> Stream (Of a) m (Maybe String, ByteStream m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
s,ByteStream m a
bytes)
ParseDone ByteString
bs -> (Maybe String, ByteStream m a)
-> Stream (Of a) m (Maybe String, ByteStream m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String
forall a. Maybe a
Nothing, ByteString -> ByteStream m ()
forall (m :: * -> *). ByteString -> ByteStream m ()
chunk ByteString
bs ByteStream m () -> ByteStream m a -> ByteStream m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteStream m a
bytes)
ParseYield a
a ParseOutput a
p1 -> a -> Stream (Of a) m ()
forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield a
a Stream (Of a) m ()
-> Stream (Of a) m (Maybe String, ByteStream m a)
-> Stream (Of a) m (Maybe String, ByteStream m a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteStream m a
-> ParseOutput a -> Stream (Of a) m (Maybe String, ByteStream m a)
loop ByteStream m a
bytes ParseOutput a
p1
ParseNeedData ByteString -> ParseOutput a
f -> do
Either a (ByteString, ByteStream m a)
e <- m (Either a (ByteString, ByteStream m a))
-> Stream (Of a) m (Either a (ByteString, ByteStream m a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either a (ByteString, ByteStream m a))
-> Stream (Of a) m (Either a (ByteString, ByteStream m a)))
-> m (Either a (ByteString, ByteStream m a))
-> Stream (Of a) m (Either a (ByteString, ByteStream m a))
forall a b. (a -> b) -> a -> b
$ ByteStream m a -> m (Either a (ByteString, ByteStream m a))
forall (m :: * -> *) r.
Monad m =>
ByteStream m r -> m (Either r (ByteString, ByteStream m r))
nextChunk ByteStream m a
bytes
case Either a (ByteString, ByteStream m a)
e of
Left a
r -> (Maybe String, ByteStream m a)
-> Stream (Of a) m (Maybe String, ByteStream m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
"Not enough data",a -> ByteStream m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r)
Right (ByteString
bs, ByteStream m a
rest) -> ByteStream m a
-> ParseOutput a -> Stream (Of a) m (Maybe String, ByteStream m a)
loop ByteStream m a
rest (ByteString -> ParseOutput a
f ByteString
bs)