{-# LANGUAGE CPP #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MonoLocalBinds #-}
-- |
-- Module      : Data.Conduit.Aeson
-- Copyright   : (c) Alexey Kuleshevich 2021-2022
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
-- Stability   : experimental
-- Portability : non-portable
--
module Data.Conduit.Aeson
  ( ParserError(..)
  , conduitArray
  , conduitArrayEither
  , conduitObject
  , conduitObjectEither
  -- * Helpers
  -- ** Conduit
  , conduitArrayParserEither
  , conduitArrayParserNoStartEither
  , conduitObjectParserEither
  , conduitObjectParserNoStartEither
  -- ** Attoparsec
  , skipSpace
  , commaParser
  , delimiterParser
  , valuePrefixParser
  , valueParser
  , valueMaybeParser
  , objectEntryPrefixParser
  , objectEntryParser
  , objectEntryMaybeParser
  ) where

import Conduit
import Control.Applicative
import Control.Exception
import Control.Monad
import Data.Aeson as Aeson
import qualified Data.Aeson.Parser as Aeson
import qualified Data.Aeson.Types as Aeson
import Data.Attoparsec.ByteString as Atto
import qualified Data.Attoparsec.ByteString.Char8 as Atto8
import Data.Bifunctor (first)
import qualified Data.ByteString as BS
import Data.Conduit.Attoparsec
import qualified Data.Text as T
#if MIN_VERSION_aeson(1,5,0)
import Data.Coerce
#endif

-- | Various reason for failed parsing.
--
-- @since 0.1.0
data ParserError
  = AttoParserError ParseError
  -- ^ Attoparsec parser failure
  | AesonParserError String
  -- ^ Aeson parser failure
  | NonTerminatedInput
  -- ^ Parser failure when end of input was reached without proper termination.
  deriving Int -> ParserError -> ShowS
[ParserError] -> ShowS
ParserError -> String
(Int -> ParserError -> ShowS)
-> (ParserError -> String)
-> ([ParserError] -> ShowS)
-> Show ParserError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParserError -> ShowS
showsPrec :: Int -> ParserError -> ShowS
$cshow :: ParserError -> String
show :: ParserError -> String
$cshowList :: [ParserError] -> ShowS
showList :: [ParserError] -> ShowS
Show
instance Exception ParserError


-- | Parse a top level array into a stream of json values.  Throws a
-- `ParserError` on invalid input, see `conduitArrayEither` for more graceful
-- error handling.
--
-- ===__Examples__
--
-- >>> :set -XTypeApplications
-- >>> :set -XOverloadedStrings
-- >>> import Conduit
-- >>> import Data.Conduit.Aeson
-- >>> runConduit $ yield ("[1,2,3,4]") .| conduitArray @Int .| printC
-- 1
-- 2
-- 3
-- 4
--
-- @since 0.1.0
conduitArray ::
     forall v m. (FromJSON v, MonadThrow m)
  => ConduitM BS.ByteString v m ()
conduitArray :: forall v (m :: * -> *).
(FromJSON v, MonadThrow m) =>
ConduitM ByteString v m ()
conduitArray = ConduitM ByteString (Either ParserError v) m ()
forall v (m :: * -> *).
(FromJSON v, Monad m) =>
ConduitM ByteString (Either ParserError v) m ()
conduitArrayEither ConduitM ByteString (Either ParserError v) m ()
-> ConduitT (Either ParserError v) v m ()
-> ConduitT ByteString v m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Either ParserError v -> m v)
-> ConduitT (Either ParserError v) v m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
mapMC ((ParserError -> m v) -> (v -> m v) -> Either ParserError v -> m v
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParserError -> m v
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM v -> m v
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

-- | Same as `conduitArray`, parse a top level array into a stream of values,
-- but produce @`Left` `ParserError`@ instead of failing immediately with an
-- exception.
--
-- @since 0.1.0
conduitArrayEither ::
     forall v m. (FromJSON v, Monad m)
  => ConduitM BS.ByteString (Either ParserError v) m ()
conduitArrayEither :: forall v (m :: * -> *).
(FromJSON v, Monad m) =>
ConduitM ByteString (Either ParserError v) m ()
conduitArrayEither = ConduitM
  ByteString (Either ParseError (PositionRange, Maybe Value)) m ()
forall (m :: * -> *).
Monad m =>
ConduitM
  ByteString (Either ParseError (PositionRange, Maybe Value)) m ()
conduitArrayParserEither ConduitM
  ByteString (Either ParseError (PositionRange, Maybe Value)) m ()
-> ConduitT
     (Either ParseError (PositionRange, Maybe Value))
     (Either ParserError v)
     m
     ()
-> ConduitT ByteString (Either ParserError v) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitM
  (Either ParseError (PositionRange, Maybe Value))
  (Either ParserError (PositionRange, Value))
  m
  ()
forall (m :: * -> *) a.
Monad m =>
ConduitM
  (Either ParseError (PositionRange, Maybe a))
  (Either ParserError (PositionRange, a))
  m
  ()
stopOnNothing ConduitM
  (Either ParseError (PositionRange, Maybe Value))
  (Either ParserError (PositionRange, Value))
  m
  ()
-> ConduitT
     (Either ParserError (PositionRange, Value))
     (Either ParserError v)
     m
     ()
-> ConduitT
     (Either ParseError (PositionRange, Maybe Value))
     (Either ParserError v)
     m
     ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Either ParserError (PositionRange, Value) -> Either ParserError v)
-> ConduitT
     (Either ParserError (PositionRange, Value))
     (Either ParserError v)
     m
     ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC Either ParserError (PositionRange, Value) -> Either ParserError v
forall {b} {a}.
FromJSON b =>
Either ParserError (a, Value) -> Either ParserError b
toValue
  where
    toValue :: Either ParserError (a, Value) -> Either ParserError b
toValue (Left ParserError
err) = ParserError -> Either ParserError b
forall a b. a -> Either a b
Left ParserError
err
    toValue (Right (a
_, Value
v)) = (String -> ParserError) -> Either String b -> Either ParserError b
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> ParserError
AesonParserError (Either String b -> Either ParserError b)
-> Either String b -> Either ParserError b
forall a b. (a -> b) -> a -> b
$ (Value -> Parser b) -> Value -> Either String b
forall a b. (a -> Parser b) -> a -> Either String b
Aeson.parseEither Value -> Parser b
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
v

-- | Parse a top level array as a stream of JSON values. Expects opening and
-- closing braket @'['@ and @']'@ at the beginning and the end of the stream
-- respectfully. `Nothing` indicates terminating closing square braket has been
-- reached, but it does not mean there are no left over bytes in the input stream.
--
-- @since 0.1.0
conduitArrayParserEither ::
     Monad m
  => ConduitM  BS.ByteString (Either ParseError (PositionRange, Maybe Value)) m ()
conduitArrayParserEither :: forall (m :: * -> *).
Monad m =>
ConduitM
  ByteString (Either ParseError (PositionRange, Maybe Value)) m ()
conduitArrayParserEither = do
  Parser ByteString ()
-> ConduitT
     ByteString
     (Either ParseError (PositionRange, Maybe Value))
     m
     (Either ParseError ())
forall a (m :: * -> *) b o.
(AttoparsecInput a, Monad m) =>
Parser a b -> ConduitT a o m (Either ParseError b)
sinkParserEither Parser ByteString ()
valuePrefixParser ConduitT
  ByteString
  (Either ParseError (PositionRange, Maybe Value))
  m
  (Either ParseError ())
-> (Either ParseError ()
    -> ConduitM
         ByteString (Either ParseError (PositionRange, Maybe Value)) m ())
-> ConduitM
     ByteString (Either ParseError (PositionRange, Maybe Value)) m ()
forall a b.
ConduitT
  ByteString (Either ParseError (PositionRange, Maybe Value)) m a
-> (a
    -> ConduitT
         ByteString (Either ParseError (PositionRange, Maybe Value)) m b)
-> ConduitT
     ByteString (Either ParseError (PositionRange, Maybe Value)) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ParseError
err -> Either ParseError (PositionRange, Maybe Value)
-> ConduitM
     ByteString (Either ParseError (PositionRange, Maybe Value)) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either ParseError (PositionRange, Maybe Value)
 -> ConduitM
      ByteString (Either ParseError (PositionRange, Maybe Value)) m ())
-> Either ParseError (PositionRange, Maybe Value)
-> ConduitM
     ByteString (Either ParseError (PositionRange, Maybe Value)) m ()
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError (PositionRange, Maybe Value)
forall a b. a -> Either a b
Left ParseError
err
    Right () -> Parser ByteString (Maybe Value)
-> ConduitM
     ByteString (Either ParseError (PositionRange, Maybe Value)) m ()
forall (m :: * -> *) a b.
(Monad m, AttoparsecInput a) =>
Parser a b
-> ConduitT a (Either ParseError (PositionRange, b)) m ()
conduitParserEither ((Char -> Parser ByteString ()) -> Parser ByteString (Maybe Value)
forall a. (Char -> Parser a) -> Parser ByteString (Maybe Value)
valueMaybeParser Char -> Parser ByteString ()
commaParser)

-- | Parse a stream of JSON values. Expects that there are no opening or closing
-- top level array braces @[@ and @]@. Could be very useful for consuming
-- infinite streams of log entries, where each entry is formatted as a JSON
-- value.
--
-- ===__Examples__
--
-- Parse a new line delimited JSON values.
--
-- >>> import Conduit
-- >>> import Data.Conduit.Aeson
-- >>> import Data.ByteString.Char8 (ByteString, pack)
-- >>> import Data.Attoparsec.ByteString.Char8 (char8)
-- >>> let input = pack "{\"foo\":1}\n{\"bar\":2}\n" :: ByteString
-- >>> let parser = conduitArrayParserNoStartEither (char8 '\n')
-- >>> runConduit (yield input .| parser .| printC)
-- Right (1:1 (0)-2:1 (10),Object (fromList [("foo",Number 1.0)]))
-- Right (2:1 (10)-3:1 (20),Object (fromList [("bar",Number 2.0)]))
--
-- Or a simple comma delimited list:
--
-- >>> runConduit $ yield (pack "1,2,3,\"Haskell\",") .| conduitArrayParserNoStartEither (char8 ',') .| printC
-- Right (1:1 (0)-1:3 (2),Number 1.0)
-- Right (1:3 (2)-1:5 (4),Number 2.0)
-- Right (1:5 (4)-1:7 (6),Number 3.0)
-- Right (1:7 (6)-1:17 (16),String "Haskell")
--
-- @since 0.1.0
conduitArrayParserNoStartEither ::
     forall m a. Monad m
  => Atto.Parser a
  -- ^ Delimiter parser (in JSON it is a comma @','@)
  -> ConduitM BS.ByteString (Either ParseError (PositionRange, Value)) m ()
conduitArrayParserNoStartEither :: forall (m :: * -> *) a.
Monad m =>
Parser a
-> ConduitM
     ByteString (Either ParseError (PositionRange, Value)) m ()
conduitArrayParserNoStartEither = Parser ByteString Value
-> ConduitT
     ByteString (Either ParseError (PositionRange, Value)) m ()
forall (m :: * -> *) a b.
(Monad m, AttoparsecInput a) =>
Parser a b
-> ConduitT a (Either ParseError (PositionRange, b)) m ()
conduitParserEither (Parser ByteString Value
 -> ConduitT
      ByteString (Either ParseError (PositionRange, Value)) m ())
-> (Parser a -> Parser ByteString Value)
-> Parser a
-> ConduitT
     ByteString (Either ParseError (PositionRange, Value)) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Parser ByteString Value
forall a. Parser a -> Parser ByteString Value
valueParser


-- | Parse a top level object into a stream of key/value pairs. Throws a
-- `ParserError` on invalid input, see `conduitObjectEither` for more graceful
-- error handling.
--
-- ===__Examples__
--
-- >>> :set -XOverloadedStrings
-- >>> :set -XTypeApplications
-- >>> import Conduit
-- >>> import Data.Conduit.Aeson
-- >>> let input = "{ \"foo\": 1, \"bar\": 2, \"baz\": 3 }"
-- >>> runConduit $ yield input .| conduitObject @String @Int .| printC
-- ("foo",1)
-- ("bar",2)
-- ("baz",3)
--
-- @since 0.1.0
conduitObject ::
     forall k v m. (FromJSONKey k, FromJSON v, MonadThrow m)
  => ConduitM BS.ByteString (k, v) m ()
conduitObject :: forall k v (m :: * -> *).
(FromJSONKey k, FromJSON v, MonadThrow m) =>
ConduitM ByteString (k, v) m ()
conduitObject = ConduitM ByteString (Either ParserError (k, v)) m ()
forall k v (m :: * -> *).
(FromJSONKey k, FromJSON v, Monad m) =>
ConduitM ByteString (Either ParserError (k, v)) m ()
conduitObjectEither ConduitM ByteString (Either ParserError (k, v)) m ()
-> ConduitT (Either ParserError (k, v)) (k, v) m ()
-> ConduitT ByteString (k, v) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Either ParserError (k, v) -> m (k, v))
-> ConduitT (Either ParserError (k, v)) (k, v) m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
mapMC ((ParserError -> m (k, v))
-> ((k, v) -> m (k, v)) -> Either ParserError (k, v) -> m (k, v)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParserError -> m (k, v)
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (k, v) -> m (k, v)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)

-- | Same as `conduitObject`, except fails gracefully. Parse a top level object
-- into a stream of key/value pairs with potential failures as @`Left` `ParserError`@.
--
-- @since 0.1.0
conduitObjectEither ::
     forall k v m. (FromJSONKey k, FromJSON v, Monad m)
  => ConduitM BS.ByteString (Either ParserError (k, v)) m ()
conduitObjectEither :: forall k v (m :: * -> *).
(FromJSONKey k, FromJSON v, Monad m) =>
ConduitM ByteString (Either ParserError (k, v)) m ()
conduitObjectEither = ConduitM
  ByteString
  (Either ParseError (PositionRange, Maybe (Text, Value)))
  m
  ()
forall (m :: * -> *).
Monad m =>
ConduitM
  ByteString
  (Either ParseError (PositionRange, Maybe (Text, Value)))
  m
  ()
conduitObjectParserEither ConduitM
  ByteString
  (Either ParseError (PositionRange, Maybe (Text, Value)))
  m
  ()
-> ConduitT
     (Either ParseError (PositionRange, Maybe (Text, Value)))
     (Either ParserError (k, v))
     m
     ()
-> ConduitT ByteString (Either ParserError (k, v)) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitM
  (Either ParseError (PositionRange, Maybe (Text, Value)))
  (Either ParserError (PositionRange, (Text, Value)))
  m
  ()
forall (m :: * -> *) a.
Monad m =>
ConduitM
  (Either ParseError (PositionRange, Maybe a))
  (Either ParserError (PositionRange, a))
  m
  ()
stopOnNothing ConduitM
  (Either ParseError (PositionRange, Maybe (Text, Value)))
  (Either ParserError (PositionRange, (Text, Value)))
  m
  ()
-> ConduitT
     (Either ParserError (PositionRange, (Text, Value)))
     (Either ParserError (k, v))
     m
     ()
-> ConduitT
     (Either ParseError (PositionRange, Maybe (Text, Value)))
     (Either ParserError (k, v))
     m
     ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Either ParserError (PositionRange, (Text, Value))
 -> Either ParserError (k, v))
-> ConduitT
     (Either ParserError (PositionRange, (Text, Value)))
     (Either ParserError (k, v))
     m
     ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC Either ParserError (PositionRange, (Text, Value))
-> Either ParserError (k, v)
forall {a} {b} {a}.
(FromJSONKey a, FromJSON b) =>
Either ParserError (a, (Text, Value)) -> Either ParserError (a, b)
toKeyValue
  where
    _id :: p -> p
_id p
x = p
x -- work around an aeson rewrite rule.
    toKeyValue :: Either ParserError (a, (Text, Value)) -> Either ParserError (a, b)
toKeyValue (Left ParserError
err) = ParserError -> Either ParserError (a, b)
forall a b. a -> Either a b
Left ParserError
err
    toKeyValue (Right (a
_, (Text
k, Value
v))) =
      (String -> ParserError)
-> Either String (a, b) -> Either ParserError (a, b)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> ParserError
AesonParserError (Either String (a, b) -> Either ParserError (a, b))
-> Either String (a, b) -> Either ParserError (a, b)
forall a b. (a -> b) -> a -> b
$ do
        a
key <-
          case FromJSONKeyFunction a
forall a. FromJSONKey a => FromJSONKeyFunction a
fromJSONKey of
#if MIN_VERSION_aeson(1,5,0)
            FromJSONKeyFunction a
FromJSONKeyCoerce       -> a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a b. Coercible a b => a -> b
coerce Text
k
#else
            FromJSONKeyCoerce {}
               | FromJSONKeyText f <- fmap _id fromJSONKey -> Right $ f k
               | otherwise -> error "Impossible: failed to convert coercible FromJSONKeyCoerce"
#endif
            FromJSONKeyText Text -> a
f       -> a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ Text -> a
f Text
k
            FromJSONKeyTextParser Text -> Parser a
p -> (Text -> Parser a) -> Text -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
Aeson.parseEither Text -> Parser a
p Text
k
            FromJSONKeyValue Value -> Parser a
p      -> (Value -> Parser a) -> Value -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
Aeson.parseEither Value -> Parser a
p (Text -> Value
String Text
k)
        b
val <- (Value -> Parser b) -> Value -> Either String b
forall a b. (a -> Parser b) -> a -> Either String b
Aeson.parseEither Value -> Parser b
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
v
        (a, b) -> Either String (a, b)
forall a b. b -> Either a b
Right (a
key, b
val)

-- | Parse a top level key value mapping. Expects opening and closing braces
-- @'{'@ and @'}'@. `Nothing` indicates terminating closing curly brace has been
-- reached, but it does not mean there are no left over bytes in the input stream.
--
-- @since 0.1.0
conduitObjectParserEither ::
     Monad m
  => ConduitM BS.ByteString (Either ParseError (PositionRange, Maybe (T.Text, Value))) m ()
conduitObjectParserEither :: forall (m :: * -> *).
Monad m =>
ConduitM
  ByteString
  (Either ParseError (PositionRange, Maybe (Text, Value)))
  m
  ()
conduitObjectParserEither = do
  Parser ByteString ()
-> ConduitT
     ByteString
     (Either ParseError (PositionRange, Maybe (Text, Value)))
     m
     (Either ParseError ())
forall a (m :: * -> *) b o.
(AttoparsecInput a, Monad m) =>
Parser a b -> ConduitT a o m (Either ParseError b)
sinkParserEither Parser ByteString ()
objectEntryPrefixParser ConduitT
  ByteString
  (Either ParseError (PositionRange, Maybe (Text, Value)))
  m
  (Either ParseError ())
-> (Either ParseError ()
    -> ConduitM
         ByteString
         (Either ParseError (PositionRange, Maybe (Text, Value)))
         m
         ())
-> ConduitM
     ByteString
     (Either ParseError (PositionRange, Maybe (Text, Value)))
     m
     ()
forall a b.
ConduitT
  ByteString
  (Either ParseError (PositionRange, Maybe (Text, Value)))
  m
  a
-> (a
    -> ConduitT
         ByteString
         (Either ParseError (PositionRange, Maybe (Text, Value)))
         m
         b)
-> ConduitT
     ByteString
     (Either ParseError (PositionRange, Maybe (Text, Value)))
     m
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left ParseError
err -> Either ParseError (PositionRange, Maybe (Text, Value))
-> ConduitM
     ByteString
     (Either ParseError (PositionRange, Maybe (Text, Value)))
     m
     ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either ParseError (PositionRange, Maybe (Text, Value))
 -> ConduitM
      ByteString
      (Either ParseError (PositionRange, Maybe (Text, Value)))
      m
      ())
-> Either ParseError (PositionRange, Maybe (Text, Value))
-> ConduitM
     ByteString
     (Either ParseError (PositionRange, Maybe (Text, Value)))
     m
     ()
forall a b. (a -> b) -> a -> b
$ ParseError
-> Either ParseError (PositionRange, Maybe (Text, Value))
forall a b. a -> Either a b
Left ParseError
err
    Right () -> Parser ByteString (Maybe (Text, Value))
-> ConduitM
     ByteString
     (Either ParseError (PositionRange, Maybe (Text, Value)))
     m
     ()
forall (m :: * -> *) a b.
(Monad m, AttoparsecInput a) =>
Parser a b
-> ConduitT a (Either ParseError (PositionRange, b)) m ()
conduitParserEither ((Char -> Parser ByteString ())
-> Parser ByteString (Maybe (Text, Value))
forall a.
(Char -> Parser a) -> Parser ByteString (Maybe (Text, Value))
objectEntryMaybeParser Char -> Parser ByteString ()
commaParser)

-- | Parse a stream of key/value pairs. Expects that there are no opening or
-- closing top level curly braces @'{'@ and @'}'@. It is suitable for infinite
-- streams of key value/pairs delimited by a custom character, eg. a new line.
--
-- ===__Examples__
--
-- >>> import Conduit
-- >>> import Data.Conduit.Aeson
-- >>> import Data.ByteString.Char8 (ByteString, pack)
-- >>> import Data.Attoparsec.ByteString.Char8 (char8)
-- >>> let input = pack "\"foo\":1|\"bar\":2|" :: ByteString
-- >>> let parser = conduitObjectParserNoStartEither (char8 '|')
-- >>> runConduit (yield input .| parser .| printC)
-- Right (1:1 (0)-1:9 (8),("foo",Number 1.0))
-- Right (1:9 (8)-1:17 (16),("bar",Number 2.0))
--
-- @since 0.1.0
conduitObjectParserNoStartEither ::
     forall m a. Monad m
  => Atto.Parser a
  -- ^ Delimiter parser (in JSON it is a comma @','@)
  -> ConduitM BS.ByteString (Either ParseError (PositionRange, (T.Text, Value))) m ()
conduitObjectParserNoStartEither :: forall (m :: * -> *) a.
Monad m =>
Parser a
-> ConduitM
     ByteString (Either ParseError (PositionRange, (Text, Value))) m ()
conduitObjectParserNoStartEither = Parser ByteString (Text, Value)
-> ConduitT
     ByteString (Either ParseError (PositionRange, (Text, Value))) m ()
forall (m :: * -> *) a b.
(Monad m, AttoparsecInput a) =>
Parser a b
-> ConduitT a (Either ParseError (PositionRange, b)) m ()
conduitParserEither (Parser ByteString (Text, Value)
 -> ConduitT
      ByteString (Either ParseError (PositionRange, (Text, Value))) m ())
-> (Parser a -> Parser ByteString (Text, Value))
-> Parser a
-> ConduitT
     ByteString (Either ParseError (PositionRange, (Text, Value))) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> Parser ByteString (Text, Value)
forall a. Parser a -> Parser ByteString (Text, Value)
objectEntryParser


stopOnNothing ::
     Monad m
  => ConduitM (Either ParseError (PositionRange, Maybe a))
              (Either ParserError (PositionRange, a)) m ()
stopOnNothing :: forall (m :: * -> *) a.
Monad m =>
ConduitM
  (Either ParseError (PositionRange, Maybe a))
  (Either ParserError (PositionRange, a))
  m
  ()
stopOnNothing = do
  ConduitT
  (Either ParseError (PositionRange, Maybe a))
  (Either ParserError (PositionRange, a))
  m
  (Maybe (Either ParseError (PositionRange, Maybe a)))
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT
  (Either ParseError (PositionRange, Maybe a))
  (Either ParserError (PositionRange, a))
  m
  (Maybe (Either ParseError (PositionRange, Maybe a)))
-> (Maybe (Either ParseError (PositionRange, Maybe a))
    -> ConduitM
         (Either ParseError (PositionRange, Maybe a))
         (Either ParserError (PositionRange, a))
         m
         ())
-> ConduitM
     (Either ParseError (PositionRange, Maybe a))
     (Either ParserError (PositionRange, a))
     m
     ()
forall a b.
ConduitT
  (Either ParseError (PositionRange, Maybe a))
  (Either ParserError (PositionRange, a))
  m
  a
-> (a
    -> ConduitT
         (Either ParseError (PositionRange, Maybe a))
         (Either ParserError (PositionRange, a))
         m
         b)
-> ConduitT
     (Either ParseError (PositionRange, Maybe a))
     (Either ParserError (PositionRange, a))
     m
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Either ParseError (PositionRange, Maybe a))
Nothing -> Either ParserError (PositionRange, a)
-> ConduitM
     (Either ParseError (PositionRange, Maybe a))
     (Either ParserError (PositionRange, a))
     m
     ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Either ParserError (PositionRange, a)
 -> ConduitM
      (Either ParseError (PositionRange, Maybe a))
      (Either ParserError (PositionRange, a))
      m
      ())
-> Either ParserError (PositionRange, a)
-> ConduitM
     (Either ParseError (PositionRange, Maybe a))
     (Either ParserError (PositionRange, a))
     m
     ()
forall a b. (a -> b) -> a -> b
$ ParserError -> Either ParserError (PositionRange, a)
forall a b. a -> Either a b
Left ParserError
NonTerminatedInput
    Just Either ParseError (PositionRange, Maybe a)
e
      | Left ParseError
err <- Either ParseError (PositionRange, Maybe a)
e -> Either ParserError (PositionRange, a)
-> ConduitM
     (Either ParseError (PositionRange, Maybe a))
     (Either ParserError (PositionRange, a))
     m
     ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (ParserError -> Either ParserError (PositionRange, a)
forall a b. a -> Either a b
Left (ParseError -> ParserError
AttoParserError ParseError
err)) ConduitM
  (Either ParseError (PositionRange, Maybe a))
  (Either ParserError (PositionRange, a))
  m
  ()
-> ConduitM
     (Either ParseError (PositionRange, Maybe a))
     (Either ParserError (PositionRange, a))
     m
     ()
-> ConduitM
     (Either ParseError (PositionRange, Maybe a))
     (Either ParserError (PositionRange, a))
     m
     ()
forall a b.
ConduitT
  (Either ParseError (PositionRange, Maybe a))
  (Either ParserError (PositionRange, a))
  m
  a
-> ConduitT
     (Either ParseError (PositionRange, Maybe a))
     (Either ParserError (PositionRange, a))
     m
     b
-> ConduitT
     (Either ParseError (PositionRange, Maybe a))
     (Either ParserError (PositionRange, a))
     m
     b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitM
  (Either ParseError (PositionRange, Maybe a))
  (Either ParserError (PositionRange, a))
  m
  ()
forall (m :: * -> *) a.
Monad m =>
ConduitM
  (Either ParseError (PositionRange, Maybe a))
  (Either ParserError (PositionRange, a))
  m
  ()
stopOnNothing
      | Right (PositionRange
p, Just a
r) <- Either ParseError (PositionRange, Maybe a)
e -> Either ParserError (PositionRange, a)
-> ConduitM
     (Either ParseError (PositionRange, Maybe a))
     (Either ParserError (PositionRange, a))
     m
     ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ((PositionRange, a) -> Either ParserError (PositionRange, a)
forall a b. b -> Either a b
Right (PositionRange
p, a
r)) ConduitM
  (Either ParseError (PositionRange, Maybe a))
  (Either ParserError (PositionRange, a))
  m
  ()
-> ConduitM
     (Either ParseError (PositionRange, Maybe a))
     (Either ParserError (PositionRange, a))
     m
     ()
-> ConduitM
     (Either ParseError (PositionRange, Maybe a))
     (Either ParserError (PositionRange, a))
     m
     ()
forall a b.
ConduitT
  (Either ParseError (PositionRange, Maybe a))
  (Either ParserError (PositionRange, a))
  m
  a
-> ConduitT
     (Either ParseError (PositionRange, Maybe a))
     (Either ParserError (PositionRange, a))
     m
     b
-> ConduitT
     (Either ParseError (PositionRange, Maybe a))
     (Either ParserError (PositionRange, a))
     m
     b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitM
  (Either ParseError (PositionRange, Maybe a))
  (Either ParserError (PositionRange, a))
  m
  ()
forall (m :: * -> *) a.
Monad m =>
ConduitM
  (Either ParseError (PositionRange, Maybe a))
  (Either ParserError (PositionRange, a))
  m
  ()
stopOnNothing
      | Right (PositionRange
_, Maybe a
Nothing) <- Either ParseError (PositionRange, Maybe a)
e -> ()
-> ConduitM
     (Either ParseError (PositionRange, Maybe a))
     (Either ParserError (PositionRange, a))
     m
     ()
forall a.
a
-> ConduitT
     (Either ParseError (PositionRange, Maybe a))
     (Either ParserError (PositionRange, a))
     m
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- Attoparsec

-- | Skips all spaces and newlines
--
-- @since 0.1.0
skipSpace :: Atto.Parser ()
skipSpace :: Parser ByteString ()
skipSpace = (Word8 -> Bool) -> Parser ByteString ()
Atto.skipWhile ((Word8 -> Bool) -> Parser ByteString ())
-> (Word8 -> Bool) -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ \Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x20 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0a Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0d Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x09

-- | Use a comma for delimiter.
--
-- @since 0.1.0
commaParser ::
     Char
  -- ^ Terminating character.
  -> Atto.Parser ()
commaParser :: Char -> Parser ByteString ()
commaParser = Parser Word8 -> Char -> Parser ByteString ()
forall a. Parser a -> Char -> Parser ByteString ()
delimiterParser (Word8 -> Parser Word8
Atto.word8 Word8
0x2c Parser Word8 -> String -> Parser Word8
forall i a. Parser i a -> String -> Parser i a
Atto8.<?> String
"','")

-- | Parser for delimiter with terminating character
--
-- @since 0.1.0
delimiterParser :: Atto.Parser a -> Char -> Atto.Parser ()
delimiterParser :: forall a. Parser a -> Char -> Parser ByteString ()
delimiterParser Parser a
dp Char
t =
  Parser ByteString ()
skipSpace Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser a -> Parser ByteString ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser a
dp Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ()
expectTermination)
  where
    expectTermination :: Parser ByteString ()
expectTermination =
      Parser (Maybe Char)
Atto8.peekChar Parser (Maybe Char)
-> (Maybe Char -> Parser ByteString ()) -> Parser ByteString ()
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Char
c
          | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
t -> String -> Parser ByteString ()
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ByteString ()) -> String -> Parser ByteString ()
forall a b. (a -> b) -> a -> b
$ String
"Unexpected delimiter: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c
        Maybe Char
_ -> () -> Parser ByteString ()
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Consume @'['@ with all preceeding space characters
--
-- @since 0.1.0
valuePrefixParser :: Atto.Parser ()
valuePrefixParser :: Parser ByteString ()
valuePrefixParser = Parser ByteString ()
skipSpace Parser ByteString ()
-> Parser ByteString Char -> Parser ByteString ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
Atto8.char Char
'['

-- | Parse a JSON value potentially prefixed by whitespace followed by a suffix
--
-- @since 0.1.0
valueParser ::
     Atto.Parser a
  -- ^ Suffix parser
  -> Atto.Parser Aeson.Value
valueParser :: forall a. Parser a -> Parser ByteString Value
valueParser Parser a
dp = Parser ByteString ()
skipSpace Parser ByteString ()
-> Parser ByteString Value -> Parser ByteString Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Value
Aeson.json' Parser ByteString Value -> Parser a -> Parser ByteString Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser a
dp

-- | Parse a JSON value followed either by a delimiter or terminating
-- character @']'@, which is also supplied to the delimiter parser. Nothing is
-- returned when terminating character is reached.
--
-- @since 0.1.1
valueMaybeParser ::
     (Char -> Atto.Parser a)
  -- ^ Delimiter parser (accepts terminating character as argument)
  -> Atto.Parser (Maybe Aeson.Value)
valueMaybeParser :: forall a. (Char -> Parser a) -> Parser ByteString (Maybe Value)
valueMaybeParser Char -> Parser a
dp =
  let t :: Char
t = Char
']'
   in Parser ByteString ()
skipSpace Parser ByteString ()
-> Parser ByteString (Maybe Value)
-> Parser ByteString (Maybe Value)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((Maybe Value
forall a. Maybe a
Nothing Maybe Value
-> Parser ByteString Char -> Parser ByteString (Maybe Value)
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ByteString Char
Atto8.char Char
t) Parser ByteString (Maybe Value)
-> Parser ByteString (Maybe Value)
-> Parser ByteString (Maybe Value)
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value)
-> Parser ByteString Value -> Parser ByteString (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Value
Aeson.json' Parser ByteString (Maybe Value)
-> Parser a -> Parser ByteString (Maybe Value)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser a
dp Char
t))

-- | Consume @'{'@ with all preceeding space characters
--
-- @since 0.1.0
objectEntryPrefixParser :: Atto.Parser ()
objectEntryPrefixParser :: Parser ByteString ()
objectEntryPrefixParser = Parser ByteString ()
skipSpace Parser ByteString ()
-> Parser ByteString Char -> Parser ByteString ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
Atto8.char Char
'{'


-- | Parse JSON object key followed by a colon
--
-- @since 0.1.0
keyParser :: Atto.Parser T.Text
keyParser :: Parser Text
keyParser =
  Parser ByteString ()
skipSpace Parser ByteString () -> Parser Text -> Parser Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
  (Parser Text
Aeson.jstring Parser Text -> String -> Parser Text
forall i a. Parser i a -> String -> Parser i a
Atto.<?> String
"key") Parser Text -> Parser ByteString () -> Parser Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
  Parser ByteString ()
skipSpace Parser Text -> Parser Word8 -> Parser Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
  (Word8 -> Parser Word8
Atto.word8 Word8
0x3a Parser Word8 -> String -> Parser Word8
forall i a. Parser i a -> String -> Parser i a
Atto.<?> String
"':'")

-- | Parse a JSON key value pair followed by a suffix
--
-- @since 0.1.0
objectEntryParser ::
     Atto.Parser a
  -- ^ Suffix parser
  -> Atto.Parser (T.Text, Aeson.Value)
objectEntryParser :: forall a. Parser a -> Parser ByteString (Text, Value)
objectEntryParser Parser a
dp = (,) (Text -> Value -> (Text, Value))
-> Parser Text -> Parser ByteString (Value -> (Text, Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
keyParser Parser ByteString (Value -> (Text, Value))
-> Parser ByteString Value -> Parser ByteString (Text, Value)
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a -> Parser ByteString Value
forall a. Parser a -> Parser ByteString Value
valueParser Parser a
dp


-- | Parse JSON key value pairs followed either by a delimiter or terminating
-- character @']'@, which is also supplied to the delimiter parser. Nothing is
-- returned when terminating character is reached.
--
-- @since 0.1.0
objectEntryMaybeParser :: (Char -> Atto.Parser a) -> Atto.Parser (Maybe (T.Text, Aeson.Value))
objectEntryMaybeParser :: forall a.
(Char -> Parser a) -> Parser ByteString (Maybe (Text, Value))
objectEntryMaybeParser Char -> Parser a
dp =
  let t :: Char
t = Char
'}'
   in Parser ByteString ()
skipSpace Parser ByteString ()
-> Parser ByteString (Maybe (Text, Value))
-> Parser ByteString (Maybe (Text, Value))
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
      ((Maybe (Text, Value)
forall a. Maybe a
Nothing Maybe (Text, Value)
-> Parser ByteString Char
-> Parser ByteString (Maybe (Text, Value))
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ByteString Char
Atto8.char Char
t) Parser ByteString (Maybe (Text, Value))
-> Parser ByteString (Maybe (Text, Value))
-> Parser ByteString (Maybe (Text, Value))
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Text, Value) -> Maybe (Text, Value)
forall a. a -> Maybe a
Just ((Text, Value) -> Maybe (Text, Value))
-> Parser ByteString (Text, Value)
-> Parser ByteString (Maybe (Text, Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> Parser ByteString (Text, Value)
forall a. Parser a -> Parser ByteString (Text, Value)
objectEntryParser (Char -> Parser a
dp Char
t)))