{-# LANGUAGE RankNTypes #-}

-- | This module exports facilities similar to those exported by the
-- "Pipes.Aeson" module, except they do not restrict the 'Ae.Value's
-- that might be encoded or decoded to be just valid top-level values. That is,
-- not only 'Ae.Object's or 'Ae.Array's, according to to the RFC-4627 JSON
-- standard.

module Pipes.Aeson.Unchecked
  ( -- * Encoding
    encode
    -- * Decoding
  , decode
  , decoded
  , loop
    -- ** Including lenghts
  , decodeL
  , decodedL
  , loopL
  ) where

import           Control.Monad        (liftM)
import qualified Data.Aeson           as Ae
import qualified Data.Aeson.Parser    as Ae (value')
import qualified Data.ByteString      as B
import           Pipes
import qualified Pipes.Aeson.Internal as I
import qualified Pipes.ByteString     as PB
import qualified Pipes.Parse          as Pipes

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

-- | Like 'Pipes.Aeson.encode', except it accepts any 'Ae.ToJSON' instance,
-- not just 'Ae.Array' or 'Ae.Object'.
-- encode :: (Monad m, Ae.ToJSON a) => a -> Producer' B.ByteString m ()
encode :: (Monad m, Ae.ToJSON a) => a -> Proxy x' x () PB.ByteString m ()
encode :: forall (m :: * -> *) a x' x.
(Monad m, ToJSON a) =>
a -> Proxy x' x () ByteString m ()
encode a
a = ByteString -> Producer' ByteString m ()
forall (m :: * -> *).
Monad m =>
ByteString -> Producer' ByteString m ()
PB.fromLazy (a -> ByteString
forall a. ToJSON a => a -> ByteString
Ae.encode a
a)
{-# INLINABLE encode #-}
{-# RULES "p >-> for cat encode" forall p .
    p >-> for cat encode = for p (\a -> PB.fromLazy (Ae.encode a))
  #-}

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

-- | Like 'Pipes.Aeson.decode', except it will decode any 'Ae.FromJSON'
-- instance, not just 'Ae.Array' or 'Ae.Object'.
decode
  :: (Monad m, Ae.FromJSON a)
  => Pipes.Parser B.ByteString m (Maybe (Either I.DecodingError a)) -- ^
decode :: forall (m :: * -> *) a.
(Monad m, FromJSON a) =>
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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int, a) -> a)
-> Either DecodingError (Int, a) -> Either DecodingError a
forall a b.
(a -> b) -> Either DecodingError a -> Either DecodingError b
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)))
Parser ByteString 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
-- between each parsed JSON input.
decodeL
  :: (Monad m, Ae.FromJSON a)
  => Pipes.Parser B.ByteString m (Maybe (Either I.DecodingError (Int, a))) -- ^
decodeL :: forall (m :: * -> *) a.
(Monad m, FromJSON a) =>
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.value'
{-# INLINABLE decodeL #-}

-- | Like 'Pipes.Aeson.decoded', except it will decode and decode any
-- 'Ae.FromJSON' and 'Ae.ToJSON' instance, not just 'Ae.Array' or 'Ae.Object'.
decoded
  :: (Monad m, Ae.FromJSON a, Ae.ToJSON a)
  => Lens' (Producer B.ByteString m r)
           (Producer a m (Either (I.DecodingError, Producer B.ByteString m r) r))
     -- ^
decoded :: forall (m :: * -> *) a r.
(Monad m, FromJSON a, ToJSON a) =>
Lens'
  (Producer ByteString m r)
  (Producer a m (Either (DecodingError, Producer ByteString m r) r))
decoded Producer a m (Either (DecodingError, Producer ByteString m r) r)
-> f (Producer
        a m (Either (DecodingError, Producer ByteString m r) r))
k Producer ByteString m r
p = (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 a b. (a -> b) -> f a -> f b
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 StateT (Producer ByteString m x) m (Maybe (Either DecodingError a))
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
p))
  where
    _encode :: Proxy x' x () a m (Either (a, Proxy x' x () ByteString m b) b)
-> Proxy x' x () ByteString m b
_encode = \Proxy x' x () a m (Either (a, Proxy x' x () ByteString m b) b)
p0 -> 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)
p0 (\a
a -> a -> Proxy x' x () ByteString m ()
forall (m :: * -> *) a x' x.
(Monad m, ToJSON a) =>
a -> Proxy x' x () ByteString m ()
encode a
a)
      case Either (a, Proxy x' x () ByteString m b) b
er of
         Left (a
_, Proxy x' x () ByteString m b
p1) -> Proxy x' x () ByteString m b
p1
         Right b
r      -> b -> Proxy x' x () ByteString m b
forall a. a -> Proxy x' x () ByteString m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
r
    {-# INLINE _encode #-}
{-# 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)
  => Lens' (Producer B.ByteString m r)
           (Producer (Int, a) m (Either (I.DecodingError, Producer B.ByteString m r) r))
     -- ^
decodedL :: forall (m :: * -> *) a r.
(Monad m, FromJSON a, ToJSON a) =>
Lens'
  (Producer ByteString m r)
  (Producer
     (Int, a) m (Either (DecodingError, Producer ByteString m r) r))
decodedL Producer
  (Int, a) m (Either (DecodingError, Producer ByteString m r) r)
-> f (Producer
        (Int, a) m (Either (DecodingError, Producer ByteString m r) r))
k Producer ByteString m r
p = (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 a b. (a -> b) -> f a -> f b
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 StateT
  (Producer ByteString m x) m (Maybe (Either DecodingError (Int, a)))
Parser ByteString m (Maybe (Either DecodingError (Int, a)))
forall (m :: * -> *) a.
(Monad m, FromJSON a) =>
Parser ByteString m (Maybe (Either DecodingError (Int, a)))
decodeL Producer ByteString m r
p))
  where
    _encode :: Proxy x' x () (a, a) m (Either (a, Proxy x' x () ByteString m b) b)
-> Proxy x' x () ByteString m b
_encode = \Proxy x' x () (a, a) m (Either (a, Proxy x' x () ByteString m b) b)
p0 -> 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)
p0 (\(a
_, a
a) -> a -> Proxy x' x () ByteString m ()
forall (m :: * -> *) a x' x.
(Monad m, ToJSON a) =>
a -> Proxy x' x () ByteString m ()
encode a
a)
      case Either (a, Proxy x' x () ByteString m b) b
er of
         Left (a
_, Proxy x' x () ByteString m b
p1) -> Proxy x' x () ByteString m b
p1
         Right b
r      -> b -> Proxy x' x () ByteString m b
forall a. a -> Proxy x' x () ByteString m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
r
    {-# INLINE _encode #-}
{-# INLINABLE decodedL #-}


-- | Repeteadly try to parse raw JSON bytes into @a@ values, reporting any
-- 'I.DecodingError's downstream as they happen.
loop
  :: (Monad m, Ae.FromJSON a)
  => (Pipes.Producer B.ByteString m r -> Pipes.Producer B.ByteString m r)
  -- ^ In case of 'I.AttoparsecError', this function will be called to modify
  -- the leftovers 'Pipes.Producer' before using it.
  --
  -- Ideally you will want to drop everything until the beginning of the next
  -- JSON element. This is easy to accomplish if there is a clear whitespace
  -- delimiter between the JSON elements, such as a newline (i.e.,
  -- @'Pipes.ByteString.drop' 1 . 'Pipes.ByteString.dropWhile' (/= 0xA)@).
  -- However, it can be hard to do correctly is there is no such delimiter.
  -- Skipping the first character (i.e., @'Pipes.ByteString.drop' 1@) should be
  -- sufficient in most cases, but not when parsing recursive data structures
  -- because you can accidentally parse a child in its parent's stead.
  --
  -- Notice that unless you advance the 'Pipes.Producer' somehow, 'loop'
  -- will never terminate.
  -> Pipes.Producer B.ByteString m r
  -- ^ Raw JSON input.
  -> Pipes.Producer' (Either I.DecodingError a) m r
{-# INLINABLE loop #-}
loop :: forall (m :: * -> *) a r.
(Monad m, FromJSON a) =>
(Producer ByteString m r -> Producer ByteString m r)
-> Producer ByteString m r
-> Producer' (Either DecodingError a) m r
loop Producer ByteString m r -> Producer ByteString m r
fp Producer ByteString m r
p0 = Proxy x' x () (Either DecodingError (Int, a)) m r
-> (Either DecodingError (Int, a)
    -> Proxy x' x () (Either DecodingError a) m ())
-> Proxy x' x () (Either DecodingError a) m r
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'
Pipes.for ((Producer ByteString m r -> Producer ByteString m r)
-> Producer ByteString m r
-> Proxy x' x () (Either DecodingError (Int, a)) m r
forall (m :: * -> *) a r x' x.
(Monad m, FromJSON a) =>
(Producer ByteString m r -> Producer ByteString m r)
-> Producer ByteString m r
-> Proxy x' x () (Either DecodingError (Int, a)) m r
loopL Producer ByteString m r -> Producer ByteString m r
fp Producer ByteString m r
p0) (Either DecodingError a
-> Proxy x' x () (Either DecodingError a) m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
Pipes.yield (Either DecodingError a
 -> Proxy x' x () (Either DecodingError a) m ())
-> (Either DecodingError (Int, a) -> Either DecodingError a)
-> Either DecodingError (Int, a)
-> Proxy x' x () (Either DecodingError a) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, a) -> a)
-> Either DecodingError (Int, a) -> Either DecodingError a
forall a b.
(a -> b) -> Either DecodingError a -> Either DecodingError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, a) -> a
forall a b. (a, b) -> b
snd)

-- | Like 'loop', except it also outputs 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.
loopL
  :: (Monad m, Ae.FromJSON a)
  => (Pipes.Producer B.ByteString m r -> Pipes.Producer B.ByteString m r)
  -- ^ In case of 'I.AttoparsecError', this function will be called to modify
  -- the leftovers 'Pipes.Producer' before using it.
  --
  -- Ideally you will want to drop everything until the beginning of the next
  -- JSON element. This is easy to accomplish if there is a clear whitespace
  -- delimiter between the JSON elements, such as a newline (i.e.,
  -- @'Pipes.ByteString.drop' 1 . 'Pipes.ByteString.dropWhile' (/= 0xA)@).
  -- However, it can be hard to do correctly is there is no such delimiter.
  -- Skipping the first character (i.e., @'Pipes.ByteString.drop' 1@) should be
  -- sufficient in most cases, but not when parsing recursive data structures
  -- because you can accidentally parse a child in its parent's stead.
  --
  -- Notice that unless you advance the 'Pipes.Producer' somehow, 'loopL'
  -- will never terminate.
  -> Pipes.Producer B.ByteString m r
  -- ^ Raw JSON input.
  -> Pipes.Proxy x' x () (Either I.DecodingError (Int, a)) m r
{-# INLINABLE loopL #-}
loopL :: forall (m :: * -> *) a r x' x.
(Monad m, FromJSON a) =>
(Producer ByteString m r -> Producer ByteString m r)
-> Producer ByteString m r
-> Proxy x' x () (Either DecodingError (Int, a)) m r
loopL = Parser ByteString Value
-> (Producer ByteString m r -> Producer ByteString m r)
-> Producer ByteString m r
-> Proxy x' x () (Either DecodingError (Int, a)) m r
forall (m :: * -> *) a r x' x.
(Monad m, FromJSON a) =>
Parser ByteString Value
-> (Producer ByteString m r -> Producer ByteString m r)
-> Producer ByteString m r
-> Proxy x' x () (Either DecodingError (Int, a)) m r
I.loopL Parser ByteString Value
Ae.value'

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

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