{-# LANGUAGE RankNTypes #-}

-- | This module allows you to encode and decode JSON values flowing downstream
-- through Pipes streams.
--
-- This module builds on top of the @aeson@, @pipes@ and @pipes-parse@
-- libraries, and assumes you know how to use them. Please read the examples
-- in "Pipes.Parse.Tutorial" to understand how to use these functions.
--
-- In this module, the following type synonym compatible with the @lens@,
-- @lens-family@ and @lens-family-core@ libraries is used but not exported:
--
-- @
-- type Lens' s a = forall f . 'Functor' f => (a -> f a) -> (s -> f s)
-- @

module Pipes.Aeson
  ( -- * Encoding
    -- $encoding
    encodeArray
  , encodeObject

    -- * Decoding
    -- $decoding
  , decode
  , decoded
    -- ** Including lengths
  , decodeL
  , decodedL

    -- * Types
  , I.DecodingError(..)
  ) where

import           Control.Monad         (liftM)
import qualified Data.Aeson            as Ae
import qualified Data.ByteString.Char8 as B
import           Pipes
import qualified Pipes.Aeson.Internal  as I
import qualified Pipes.Aeson.Unchecked as U
import qualified Pipes.Parse           as Pipes

--------------------------------------------------------------------------------
-- $encoding
--
-- Encode 'Ae.Array' or 'Ae.Object' values as JSON and send them downstream,
-- possibly in more than one 'B.ByteString' chunk.
--
-- /Note:/ The JSON RFC-4627 standard only allows arrays or objects as top-level
-- entities, which is why these functions restrict their input to them. If you
-- prefer to ignore the standard and encode any 'Ae.Value', then use 'U.encode'
-- from the "Pipes.Aeson.Unchecked" module.
--

-- | Encode an 'Ae.Object' as JSON and send it downstream,
--
-- /Hint:/ You can easily turn this 'Producer'' into a 'Pipe' that encodes
-- 'Ae.Object' values as JSON as they flow downstream using:
--
-- @
-- 'for' 'cat' 'encodeObject' :: 'Monad' m => 'Pipe' 'Ae.Object' 'B.ByteString' m r
-- @
encodeObject :: Monad m => Ae.Object -> Producer' B.ByteString m ()
encodeObject :: Object -> Producer' ByteString m ()
encodeObject = Object -> Proxy x' x () ByteString m ()
forall (m :: * -> *) a.
(Monad m, ToJSON a) =>
a -> Producer' ByteString m ()
U.encode
{-# INLINABLE encodeObject #-}
{-# RULES "p >-> for cat encodeObject" forall p .
    p >-> for cat encodeObject = for p encodeObject
  #-}

-- | Encode an 'Ae.Array' as JSON and send it downstream,
--
-- /Hint:/ You can easily turn this 'Producer'' into a 'Pipe' that encodes
-- 'Ae.Array' values as JSON as they flow downstream using:
--
-- @
-- 'for' 'cat' 'encodeArray' :: 'Monad' m => 'Pipe' 'Ae.Array' 'B.ByteString' m r
-- @
encodeArray :: Monad m => Ae.Array -> Producer' B.ByteString m ()
encodeArray :: Array -> Producer' ByteString m ()
encodeArray = Array -> Proxy x' x () ByteString m ()
forall (m :: * -> *) a.
(Monad m, ToJSON a) =>
a -> Producer' ByteString m ()
U.encode
{-# INLINABLE encodeArray #-}
{-# RULES "p >-> for cat encodeArray" forall p .
    p >-> for cat encodeArray = for p encodeArray
  #-}

--------------------------------------------------------------------------------
-- $decoding
--
-- Decoding JSON as a Haskell value involves two different steps:
--
-- * Parsing a raw JSON 'B.ByteString' into an 'Ae.Object' or an 'Ae.Array'.
--
-- * Converting the obtained 'Ae.Object' or 'Ae.Array' to the desired
-- 'Ae.FromJSON' instance.
--
-- Any of those steps can fail, in which case a 'I.DecodingError' will report
-- the precise error and at which step it happened.


-- | Decodes an 'Ae.Object' or 'Ae.Array' JSON value from the underlying state.
--
-- It returns 'Nothing' if the underlying 'Producer' is exhausted, otherwise
-- it returns either the decoded entity or a 'I.DecodingError' in case of error.
--
-- /Note:/ The JSON RFC-4627 standard only allows arrays or objects as top-level
-- entities, which is why this 'Pipes.Parser' restricts its output to them. If
-- you prefer to ignore the standard and decode any 'Ae.Value', then use
-- 'U.decode' from the "Pipes.Aeson.Unchecked" module.
decode
  :: (Monad m, Ae.FromJSON a)
  => Pipes.Parser B.ByteString m (Maybe (Either I.DecodingError a))
decode :: Parser ByteString m (Maybe (Either DecodingError a))
decode = (Either DecodingError (Int, a) -> Either DecodingError a)
-> Maybe (Either DecodingError (Int, a))
-> Maybe (Either DecodingError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int, a) -> a)
-> Either DecodingError (Int, a) -> Either DecodingError a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, a) -> a
forall a b. (a, b) -> b
snd) (Maybe (Either DecodingError (Int, a))
 -> Maybe (Either DecodingError a))
-> StateT
     (Producer ByteString m x) m (Maybe (Either DecodingError (Int, a)))
-> StateT
     (Producer ByteString m x) m (Maybe (Either DecodingError a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` StateT
  (Producer ByteString m x) m (Maybe (Either DecodingError (Int, a)))
forall (m :: * -> *) a.
(Monad m, FromJSON a) =>
Parser ByteString m (Maybe (Either DecodingError (Int, a)))
decodeL
{-# INLINABLE decode #-}

-- | Like 'decode', except it also returns the length of JSON input that was
-- consumed in order to obtain the value, not including the length of whitespace
-- before nor after the parsed JSON input.
decodeL
  :: (Monad m, Ae.FromJSON a)
  => Pipes.Parser B.ByteString m (Maybe (Either I.DecodingError (Int, a)))
decodeL :: Parser ByteString m (Maybe (Either DecodingError (Int, a)))
decodeL = Parser ByteString Value
-> Parser ByteString m (Maybe (Either DecodingError (Int, a)))
forall (m :: * -> *) a.
(Monad m, FromJSON a) =>
Parser ByteString Value
-> Parser ByteString m (Maybe (Either DecodingError (Int, a)))
I.decodeL Parser ByteString Value
Ae.json'
{-# INLINABLE decodeL #-}


-- | /Improper lens/ that turns a stream of raw JSON input into a stream of
-- 'Ae.FromJSON' and back.
--
-- By /improper lens/ we mean that in practice you can't expect the
-- /Monad Morphism Laws/ to be true when using 'decoded' with
-- 'Control.Lens.zoom'.
--
-- @
-- 'Control.Lens.zoom' 'decoded' ('return' r) /= 'return' r
-- 'Control.Lens.zoom' 'decoded' (m >>= k)  /= 'Control.Lens.zoom' m >>= 'Control.Lens.zoom' . f
-- @
--
-- /Note:/ The JSON RFC-4627 standard only allows arrays or objects as top-level
-- entities, which is why this function restricts its stream values to them. If
-- you prefer to ignore the standard and encode or decode any 'Ae.Value', then
-- use 'U.decoded' from the "Pipes.Aeson.Unchecked" module.
decoded
  :: (Monad m, Ae.FromJSON a, Ae.ToJSON a)
  => (Ae.Value -> Either Ae.Object Ae.Array)
     -- ^ A witness that @a@ can be represented either as an 'Ae.Object' or as
     -- an 'Ae.Array'. The passed in 'Ae.Value' is @'Ae.toJSON' a@
  -> Lens' (Producer B.ByteString m r)
           (Producer a m (Either (I.DecodingError, Producer B.ByteString m r) r))
decoded :: (Value -> Either Object Array)
-> Lens'
     (Producer ByteString m r)
     (Producer a m (Either (DecodingError, Producer ByteString m r) r))
decoded f :: Value -> Either Object Array
f k :: Producer a m (Either (DecodingError, Producer ByteString m r) r)
-> f (Producer
        a m (Either (DecodingError, Producer ByteString m r) r))
k p0 :: Producer ByteString m r
p0 = (Producer a m (Either (DecodingError, Producer ByteString m r) r)
 -> Producer ByteString m r)
-> f (Producer
        a m (Either (DecodingError, Producer ByteString m r) r))
-> f (Producer ByteString m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Producer a m (Either (DecodingError, Producer ByteString m r) r)
-> Producer ByteString m r
forall x' x a b.
Proxy x' x () a m (Either (a, Proxy x' x () ByteString m b) b)
-> Proxy x' x () ByteString m b
_encode (Producer a m (Either (DecodingError, Producer ByteString m r) r)
-> f (Producer
        a m (Either (DecodingError, Producer ByteString m r) r))
k (Parser ByteString m (Maybe (Either DecodingError a))
-> Producer ByteString m r
-> Producer a m (Either (DecodingError, Producer ByteString m r) r)
forall (m :: * -> *) e a r.
Monad m =>
Parser ByteString m (Maybe (Either e a))
-> Producer ByteString m r
-> Producer a m (Either (e, Producer ByteString m r) r)
I.consecutively Parser ByteString m (Maybe (Either DecodingError a))
forall (m :: * -> *) a.
(Monad m, FromJSON a) =>
Parser ByteString m (Maybe (Either DecodingError a))
decode Producer ByteString m r
p0))
  where
    _encode :: Proxy x' x () a m (Either (a, Proxy x' x () ByteString m b) b)
-> Proxy x' x () ByteString m b
_encode = \p :: Proxy x' x () a m (Either (a, Proxy x' x () ByteString m b) b)
p -> do
       Either (a, Proxy x' x () ByteString m b) b
er <- Proxy x' x () a m (Either (a, Proxy x' x () ByteString m b) b)
-> (a -> Proxy x' x () ByteString m ())
-> Proxy
     x' x () ByteString m (Either (a, Proxy x' x () ByteString m b) b)
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy x' x () a m (Either (a, Proxy x' x () ByteString m b) b)
p (\a :: a
a -> (Object -> Proxy x' x () ByteString m ())
-> (Array -> Proxy x' x () ByteString m ())
-> Either Object Array
-> Proxy x' x () ByteString m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Object -> Proxy x' x () ByteString m ()
forall (m :: * -> *).
Monad m =>
Object -> Producer' ByteString m ()
encodeObject Array -> Proxy x' x () ByteString m ()
forall (m :: * -> *). Monad m => Array -> Producer' ByteString m ()
encodeArray (Value -> Either Object Array
f (a -> Value
forall a. ToJSON a => a -> Value
Ae.toJSON a
a)))
       case Either (a, Proxy x' x () ByteString m b) b
er of
          Left (_, p' :: Proxy x' x () ByteString m b
p') -> Proxy x' x () ByteString m b
p'
          Right r :: b
r      -> b -> Proxy x' x () ByteString m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r
{-# INLINABLE decoded #-}

-- | Like 'decoded', except it also tags each decoded entity with the length of
-- JSON input that was consumed in order to obtain the value, not including the
-- length of whitespace between each parsed JSON input.
decodedL
  :: (Monad m, Ae.FromJSON a, Ae.ToJSON a)
  => (Ae.Value -> Either Ae.Object Ae.Array)
     -- ^ A witness that @a@ can be represented either as an 'Ae.Object' or as
     -- an 'Ae.Array'. The passed in 'Ae.Value' is @'Ae.toJSON' a@
  -> Lens' (Producer B.ByteString m r)
           (Producer (Int, a) m (Either (I.DecodingError, Producer B.ByteString m r) r))
decodedL :: (Value -> Either Object Array)
-> Lens'
     (Producer ByteString m r)
     (Producer
        (Int, a) m (Either (DecodingError, Producer ByteString m r) r))
decodedL f :: Value -> Either Object Array
f k :: Producer
  (Int, a) m (Either (DecodingError, Producer ByteString m r) r)
-> f (Producer
        (Int, a) m (Either (DecodingError, Producer ByteString m r) r))
k p0 :: Producer ByteString m r
p0 = (Producer
   (Int, a) m (Either (DecodingError, Producer ByteString m r) r)
 -> Producer ByteString m r)
-> f (Producer
        (Int, a) m (Either (DecodingError, Producer ByteString m r) r))
-> f (Producer ByteString m r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Producer
  (Int, a) m (Either (DecodingError, Producer ByteString m r) r)
-> Producer ByteString m r
forall x' x a a b.
Proxy x' x () (a, a) m (Either (a, Proxy x' x () ByteString m b) b)
-> Proxy x' x () ByteString m b
_encode (Producer
  (Int, a) m (Either (DecodingError, Producer ByteString m r) r)
-> f (Producer
        (Int, a) m (Either (DecodingError, Producer ByteString m r) r))
k (Parser ByteString m (Maybe (Either DecodingError (Int, a)))
-> Producer ByteString m r
-> Producer
     (Int, a) m (Either (DecodingError, Producer ByteString m r) r)
forall (m :: * -> *) e a r.
Monad m =>
Parser ByteString m (Maybe (Either e a))
-> Producer ByteString m r
-> Producer a m (Either (e, Producer ByteString m r) r)
I.consecutively Parser ByteString m (Maybe (Either DecodingError (Int, a)))
forall (m :: * -> *) a.
(Monad m, FromJSON a) =>
Parser ByteString m (Maybe (Either DecodingError a))
decode Producer ByteString m r
p0))
  where
    _encode :: Proxy x' x () (a, a) m (Either (a, Proxy x' x () ByteString m b) b)
-> Proxy x' x () ByteString m b
_encode = \p :: Proxy x' x () (a, a) m (Either (a, Proxy x' x () ByteString m b) b)
p -> do
      Either (a, Proxy x' x () ByteString m b) b
er <- Proxy x' x () (a, a) m (Either (a, Proxy x' x () ByteString m b) b)
-> ((a, a) -> Proxy x' x () ByteString m ())
-> Proxy
     x' x () ByteString m (Either (a, Proxy x' x () ByteString m b) b)
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy x' x () (a, a) m (Either (a, Proxy x' x () ByteString m b) b)
p (\(_, a :: a
a) -> (Object -> Proxy x' x () ByteString m ())
-> (Array -> Proxy x' x () ByteString m ())
-> Either Object Array
-> Proxy x' x () ByteString m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Object -> Proxy x' x () ByteString m ()
forall (m :: * -> *).
Monad m =>
Object -> Producer' ByteString m ()
encodeObject Array -> Proxy x' x () ByteString m ()
forall (m :: * -> *). Monad m => Array -> Producer' ByteString m ()
encodeArray (Value -> Either Object Array
f (a -> Value
forall a. ToJSON a => a -> Value
Ae.toJSON a
a)))
      case Either (a, Proxy x' x () ByteString m b) b
er of
         Left (_, p' :: Proxy x' x () ByteString m b
p') -> Proxy x' x () ByteString m b
p'
         Right r :: b
r      -> b -> Proxy x' x () ByteString m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r
{-# INLINABLE decodedL #-}


--------------------------------------------------------------------------------
-- Internal tools --------------------------------------------------------------

type Lens' s a = forall f . Functor f => (a -> f a) -> s -> f s