{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE RankNTypes         #-}

-- | This module provides internal utilities and it is likely
-- to be modified in backwards-incompatible ways in the future.
--
-- Use the stable API exported by the "Pipes.Aeson" module instead.
module Pipes.Aeson.Internal
  ( DecodingError(..)
  , consecutively
  , decodeL
  ) where
import           Control.Exception                (Exception)
import           Control.Monad.Trans.Error        (Error)
import qualified Control.Monad.Trans.State.Strict as S
import qualified Data.Aeson                       as Ae
import qualified Data.Attoparsec.Types            as Attoparsec
import qualified Data.ByteString                  as B
import qualified Data.ByteString.Internal         as B (isSpaceWord8)
import           Data.Data                        (Data, Typeable)
import           Pipes
import qualified Pipes.Attoparsec                 as PA
import qualified Pipes.Parse                      as Pipes

--------------------------------------------------------------------------------

-- | An error while decoding a JSON value.
data DecodingError
  = AttoparsecError PA.ParsingError
    -- ^An @attoparsec@ error that happened while parsing the raw JSON string.
  | FromJSONError String
    -- ^An @aeson@ error that happened while trying to convert a
    -- 'Data.Aeson.Value' to an 'A.FromJSON' instance, as reported by
    -- 'Data.Aeson.Error'.
  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
instance Error     DecodingError

-- | This instance allows using 'Pipes.Lift.errorP' with 'Pipes.Aeson.decoded'
-- and 'Pipes.Aeson.decodedL'
instance Error (DecodingError, Producer a m r)

--------------------------------------------------------------------------------

-- | Consecutively parse 'a' elements from the given 'Producer' using the given
-- parser (such as 'Pipes.Aeson.decode' or 'Pipes.Aeson.parseValue'), skipping
-- any leading whitespace each time.
--
-- This 'Producer' runs until it either runs out of input or until a decoding
-- failure occurs, in which case it returns 'Left' with a 'DecodingError' and
-- a 'Producer' with any leftovers. You can use 'Pipes.Lift.errorP' to turn the
-- 'Either' return value into an 'Control.Monad.Trans.Error.ErrorT'
-- monad transformer.
consecutively
  :: (Monad m)
  => Pipes.Parser B.ByteString m (Maybe (Either e a))
  -> Producer B.ByteString m r  -- ^Producer from which to draw raw input.
  -> Producer a m (Either (e, Producer B.ByteString m r) r)
consecutively :: Parser ByteString m (Maybe (Either e a))
-> Producer ByteString m r
-> Producer a m (Either (e, Producer ByteString m r) r)
consecutively parser :: Parser ByteString m (Maybe (Either e a))
parser = Producer ByteString m r
-> Producer a m (Either (e, Producer ByteString m r) r)
forall x x' x.
Producer ByteString m x
-> Proxy x' x () a m (Either (e, Producer ByteString m x) x)
step where
    step :: Producer ByteString m x
-> Proxy x' x () a m (Either (e, Producer ByteString m x) x)
step p0 :: Producer ByteString m x
p0 = do
      Either x (ByteString, Producer ByteString m x)
x <- m (Either x (ByteString, Producer ByteString m x))
-> Proxy
     x' x () a m (Either x (ByteString, Producer ByteString m x))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either x (ByteString, Producer ByteString m x))
 -> Proxy
      x' x () a m (Either x (ByteString, Producer ByteString m x)))
-> m (Either x (ByteString, Producer ByteString m x))
-> Proxy
     x' x () a m (Either x (ByteString, Producer ByteString m x))
forall a b. (a -> b) -> a -> b
$ Producer ByteString m x
-> m (Either x (ByteString, Producer ByteString m x))
forall (m :: * -> *) r.
Monad m =>
Producer ByteString m r
-> m (Either r (ByteString, Producer ByteString m r))
nextSkipBlank Producer ByteString m x
p0
      case Either x (ByteString, Producer ByteString m x)
x of
         Left r :: x
r -> Either (e, Producer ByteString m x) x
-> Proxy x' x () a m (Either (e, Producer ByteString m x) x)
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> Either (e, Producer ByteString m x) x
forall a b. b -> Either a b
Right x
r)
         Right (bs :: ByteString
bs, p1 :: Producer ByteString m x
p1) -> do
            (mea :: Maybe (Either e a)
mea, p2 :: Producer ByteString m x
p2) <- m (Maybe (Either e a), Producer ByteString m x)
-> Proxy x' x () a m (Maybe (Either e a), Producer ByteString m x)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe (Either e a), Producer ByteString m x)
 -> Proxy x' x () a m (Maybe (Either e a), Producer ByteString m x))
-> m (Maybe (Either e a), Producer ByteString m x)
-> Proxy x' x () a m (Maybe (Either e a), Producer ByteString m x)
forall a b. (a -> b) -> a -> b
$ StateT (Producer ByteString m x) m (Maybe (Either e a))
-> Producer ByteString m x
-> m (Maybe (Either e a), Producer ByteString m x)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
S.runStateT StateT (Producer ByteString m x) m (Maybe (Either e a))
Parser ByteString m (Maybe (Either e a))
parser (ByteString -> Producer' ByteString m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield ByteString
bs Proxy X () () ByteString m ()
-> Producer ByteString m x -> Producer ByteString m x
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Producer ByteString m x
p1)
            case Maybe (Either e a)
mea of
               Just (Right a :: a
a) -> a -> Producer' a m ()
forall (m :: * -> *) a. Functor m => a -> Producer' a m ()
yield a
a Proxy x' x () a m ()
-> Proxy x' x () a m (Either (e, Producer ByteString m x) x)
-> Proxy x' x () a m (Either (e, Producer ByteString m x) x)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Producer ByteString m x
-> Proxy x' x () a m (Either (e, Producer ByteString m x) x)
step Producer ByteString m x
p2
               Just (Left  e :: e
e) -> Either (e, Producer ByteString m x) x
-> Proxy x' x () a m (Either (e, Producer ByteString m x) x)
forall (m :: * -> *) a. Monad m => a -> m a
return ((e, Producer ByteString m x)
-> Either (e, Producer ByteString m x) x
forall a b. a -> Either a b
Left (e
e, Producer ByteString m x
p2))
               Nothing -> String -> Proxy x' x () a m (Either (e, Producer ByteString m x) x)
forall a. HasCallStack => String -> a
error "Pipes.Aeson.Internal.consecutively: impossible"
{-# INLINABLE consecutively #-}


-- | Decodes a 'Ae.FromJSON' value from the underlying state using the given
-- 'Attoparsec.Parser' in order to obtain an 'Ae.Value' first.
--
-- It returns 'Nothing' if the underlying 'Producer' is exhausted, otherwise
-- it returns either the decoded entity or a 'I.DecodingError' in case of error.
decodeL
  :: (Monad m, Ae.FromJSON a)
  => Attoparsec.Parser B.ByteString Ae.Value
  -> Pipes.Parser B.ByteString m (Maybe (Either DecodingError (Int, a))) -- ^
decodeL :: Parser ByteString Value
-> Parser ByteString m (Maybe (Either DecodingError (Int, a)))
decodeL parser :: Parser ByteString Value
parser = do
    Maybe (Either ParsingError (Int, Value))
mev <- Parser ByteString Value
-> Parser ByteString m (Maybe (Either ParsingError (Int, Value)))
forall (m :: * -> *) a b.
(Monad m, ParserInput a) =>
Parser a b -> Parser a m (Maybe (Either ParsingError (Int, b)))
PA.parseL Parser ByteString Value
parser
    Maybe (Either DecodingError (Int, a))
-> StateT
     (Producer ByteString m x) m (Maybe (Either DecodingError (Int, a)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Either DecodingError (Int, a))
 -> StateT
      (Producer ByteString m x)
      m
      (Maybe (Either DecodingError (Int, a))))
-> Maybe (Either DecodingError (Int, a))
-> StateT
     (Producer ByteString m x) m (Maybe (Either DecodingError (Int, a)))
forall a b. (a -> b) -> a -> b
$ case Maybe (Either ParsingError (Int, Value))
mev of
       Nothing             -> Maybe (Either DecodingError (Int, a))
forall a. Maybe a
Nothing
       Just (Left l :: ParsingError
l)       -> Either DecodingError (Int, a)
-> Maybe (Either DecodingError (Int, a))
forall a. a -> Maybe a
Just (DecodingError -> Either DecodingError (Int, a)
forall a b. a -> Either a b
Left (ParsingError -> DecodingError
AttoparsecError ParsingError
l))
       Just (Right (n :: Int
n, v :: Value
v)) -> case Value -> Result a
forall a. FromJSON a => Value -> Result a
Ae.fromJSON Value
v of
          Ae.Error e :: String
e   -> Either DecodingError (Int, a)
-> Maybe (Either DecodingError (Int, a))
forall a. a -> Maybe a
Just (DecodingError -> Either DecodingError (Int, a)
forall a b. a -> Either a b
Left (String -> DecodingError
FromJSONError String
e))
          Ae.Success a :: a
a -> Either DecodingError (Int, a)
-> Maybe (Either DecodingError (Int, a))
forall a. a -> Maybe a
Just ((Int, a) -> Either DecodingError (Int, a)
forall a b. b -> Either a b
Right (Int
n, a
a))
{-# INLINABLE decodeL #-}


--------------------------------------------------------------------------------
-- Internal stuff

-- | Like 'Pipes.next', except it skips leading whitespace and 'B.null' chunks.
nextSkipBlank
  :: (Monad m)
  => Producer B.ByteString m r
  -> m (Either r (B.ByteString, Producer B.ByteString m r))
nextSkipBlank :: Producer ByteString m r
-> m (Either r (ByteString, Producer ByteString m r))
nextSkipBlank = Producer ByteString m r
-> m (Either r (ByteString, Producer ByteString m r))
forall (m :: * -> *) r.
Monad m =>
Producer ByteString m r
-> m (Either r (ByteString, Producer ByteString m r))
go where
    go :: Producer ByteString m r
-> m (Either r (ByteString, Producer ByteString m r))
go p0 :: Producer ByteString m r
p0 = do
      Either r (ByteString, Producer ByteString m r)
x <- Producer ByteString m r
-> m (Either r (ByteString, Producer ByteString m r))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer ByteString m r
p0
      case Either r (ByteString, Producer ByteString m r)
x of
         Left  _      -> Either r (ByteString, Producer ByteString m r)
-> m (Either r (ByteString, Producer ByteString m r))
forall (m :: * -> *) a. Monad m => a -> m a
return Either r (ByteString, Producer ByteString m r)
x
         Right (a :: ByteString
a,p1 :: Producer ByteString m r
p1) -> do
            let a' :: ByteString
a' = (Word8 -> Bool) -> ByteString -> ByteString
B.dropWhile Word8 -> Bool
B.isSpaceWord8 ByteString
a
            if ByteString -> Bool
B.null ByteString
a' then Producer ByteString m r
-> m (Either r (ByteString, Producer ByteString m r))
go Producer ByteString m r
p1
                         else Either r (ByteString, Producer ByteString m r)
-> m (Either r (ByteString, Producer ByteString m r))
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString, Producer ByteString m r)
-> Either r (ByteString, Producer ByteString m r)
forall a b. b -> Either a b
Right (ByteString
a', Producer ByteString m r
p1))
{-# INLINABLE nextSkipBlank #-}