{-# 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
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
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
DecodingError -> DataType
DecodingError -> Constr
(forall b. Data b => b -> b) -> DecodingError -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> DecodingError -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DecodingError -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> DecodingError -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DecodingError -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Typeable)
instance Exception DecodingError
encode :: (Monad m, Ae.ToJSON a) => a -> ByteString m ()
encode :: forall (m :: * -> *) a. (Monad m, ToJSON a) => a -> ByteString m ()
encode = forall (m :: * -> *). Monad m => ByteString -> ByteStream m ()
fromLazy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
Ae.encode
decode
:: (Monad m, Ae.FromJSON a)
=> StateT (ByteString m x) m (Either DecodingError a)
decode :: forall (m :: * -> *) a x.
(Monad m, FromJSON a) =>
StateT (ByteString m x) m (Either DecodingError a)
decode = do
Either Value ParsingError
mev <- forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (forall (m :: * -> *) a x.
Monad m =>
Parser a
-> ByteString m x -> m (Either a ParsingError, ByteString m x)
PA.parse Parser Value
Ae.json')
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either Value ParsingError
mev of
Right ParsingError
l -> forall a b. a -> Either a b
Left (ParsingError -> DecodingError
AttoparsecError ParsingError
l)
Left Value
v -> case forall a. FromJSON a => Value -> Result a
Ae.fromJSON Value
v of
Ae.Error String
e -> forall a b. a -> Either a b
Left (String -> DecodingError
FromJSONError String
e)
Ae.Success a
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 :: forall (m :: * -> *) a r.
(Monad m, FromJSON a) =>
ByteString m r
-> Stream (Of a) m (Either (DecodingError, ByteString m r) r)
decoded = 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 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 :: 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 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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ 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 -> forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return (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) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT StateT (ByteString m r) m (Either e a)
parser (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
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 -> forall (f :: * -> *) (m :: * -> *) r. r -> Stream f m r
Return (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 <- 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
_ -> 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 forall (m :: * -> *) a. Monad m => a -> m a
return (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 :: forall (m :: * -> *) a r.
Monad m =>
Parser a
-> ByteString m r -> Stream (Of a) m (Maybe String, ByteString m r)
streamParse Parser a
parser ByteString m r
input = forall {m :: * -> *} {r} {a}.
Monad m =>
ByteStream m r
-> ParseOutput a -> Stream (Of a) m (Maybe String, ByteStream m r)
loop ByteString m r
input (forall a. Parser a -> ParseOutput a
J.runParser Parser a
parser) where
loop :: ByteStream m r
-> ParseOutput a -> Stream (Of a) m (Maybe String, ByteStream m r)
loop ByteStream m r
bytes ParseOutput a
p0 = case ParseOutput a
p0 of
ParseFailed String
s -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just String
s,ByteStream m r
bytes)
ParseDone ByteString
bs -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, forall (m :: * -> *). ByteString -> ByteStream m ()
chunk ByteString
bs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteStream m r
bytes)
ParseYield a
a ParseOutput a
p1 -> forall (m :: * -> *) a. Monad m => a -> Stream (Of a) m ()
yield a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteStream m r
-> ParseOutput a -> Stream (Of a) m (Maybe String, ByteStream m r)
loop ByteStream m r
bytes ParseOutput a
p1
ParseNeedData ByteString -> ParseOutput a
f -> do
Either r (ByteString, ByteStream m r)
e <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {r}.
Monad m =>
ByteStream m r -> m (Either r (ByteString, ByteStream m r))
nextChunk ByteStream m r
bytes
case Either r (ByteString, ByteStream m r)
e of
Left r
r -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just String
"Not enough data",forall (m :: * -> *) a. Monad m => a -> m a
return r
r)
Right (ByteString
bs, ByteStream m r
rest) -> ByteStream m r
-> ParseOutput a -> Stream (Of a) m (Maybe String, ByteStream m r)
loop ByteStream m r
rest (ByteString -> ParseOutput a
f ByteString
bs)