Copyright | (c) Alexey Kuleshevich 2021-2022 |
---|---|
License | BSD3 |
Maintainer | Alexey Kuleshevich <alexey@kuleshevi.ch> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Data.Conduit.Aeson
Contents
Description
Synopsis
- data ParserError
- conduitArray :: forall v m. (FromJSON v, MonadThrow m) => ConduitM ByteString v m ()
- conduitArrayEither :: forall v m. (FromJSON v, Monad m) => ConduitM ByteString (Either ParserError v) m ()
- conduitObject :: forall k v m. (FromJSONKey k, FromJSON v, MonadThrow m) => ConduitM ByteString (k, v) m ()
- conduitObjectEither :: forall k v m. (FromJSONKey k, FromJSON v, Monad m) => ConduitM ByteString (Either ParserError (k, v)) m ()
- conduitArrayParserEither :: Monad m => ConduitM ByteString (Either ParseError (PositionRange, Maybe Value)) m ()
- conduitArrayParserNoStartEither :: forall m a. Monad m => Parser a -> ConduitM ByteString (Either ParseError (PositionRange, Value)) m ()
- conduitObjectParserEither :: Monad m => ConduitM ByteString (Either ParseError (PositionRange, Maybe (Text, Value))) m ()
- conduitObjectParserNoStartEither :: forall m a. Monad m => Parser a -> ConduitM ByteString (Either ParseError (PositionRange, (Text, Value))) m ()
- skipSpace :: Parser ()
- commaParser :: Char -> Parser ()
- delimiterParser :: Parser a -> Char -> Parser ()
- valuePrefixParser :: Parser ()
- valueParser :: Parser a -> Parser Value
- valueMaybeParser :: (Char -> Parser a) -> Parser (Maybe Value)
- objectEntryPrefixParser :: Parser ()
- objectEntryParser :: Parser a -> Parser (Text, Value)
- objectEntryMaybeParser :: (Char -> Parser a) -> Parser (Maybe (Text, Value))
Documentation
data ParserError Source #
Various reason for failed parsing.
Since: 0.1.0
Constructors
AttoParserError ParseError | Attoparsec parser failure |
AesonParserError String | Aeson parser failure |
NonTerminatedInput | Parser failure when end of input was reached without proper termination. |
Instances
Exception ParserError Source # | |
Defined in Data.Conduit.Aeson Methods toException :: ParserError -> SomeException # fromException :: SomeException -> Maybe ParserError # displayException :: ParserError -> String # | |
Show ParserError Source # | |
Defined in Data.Conduit.Aeson Methods showsPrec :: Int -> ParserError -> ShowS # show :: ParserError -> String # showList :: [ParserError] -> ShowS # |
conduitArray :: forall v m. (FromJSON v, MonadThrow m) => ConduitM ByteString v m () Source #
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
conduitArrayEither :: forall v m. (FromJSON v, Monad m) => ConduitM ByteString (Either ParserError v) m () Source #
Same as conduitArray
, parse a top level array into a stream of values,
but produce
instead of failing immediately with an
exception.Left
ParserError
Since: 0.1.0
conduitObject :: forall k v m. (FromJSONKey k, FromJSON v, MonadThrow m) => ConduitM ByteString (k, v) m () Source #
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
conduitObjectEither :: forall k v m. (FromJSONKey k, FromJSON v, Monad m) => ConduitM ByteString (Either ParserError (k, v)) m () Source #
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
Helpers
Conduit
conduitArrayParserEither :: Monad m => ConduitM ByteString (Either ParseError (PositionRange, Maybe Value)) m () Source #
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
conduitArrayParserNoStartEither Source #
Arguments
:: forall m a. Monad m | |
=> Parser a | Delimiter parser (in JSON it is a comma |
-> ConduitM ByteString (Either ParseError (PositionRange, Value)) m () |
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
conduitObjectParserEither :: Monad m => ConduitM ByteString (Either ParseError (PositionRange, Maybe (Text, Value))) m () Source #
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
conduitObjectParserNoStartEither Source #
Arguments
:: forall m a. Monad m | |
=> Parser a | Delimiter parser (in JSON it is a comma |
-> ConduitM ByteString (Either ParseError (PositionRange, (Text, Value))) m () |
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
Attoparsec
Use a comma for delimiter.
Since: 0.1.0
delimiterParser :: Parser a -> Char -> Parser () Source #
Parser for delimiter with terminating character
Since: 0.1.0
valuePrefixParser :: Parser () Source #
Consume '['
with all preceeding space characters
Since: 0.1.0
Parse a JSON value potentially prefixed by whitespace followed by a suffix
Since: 0.1.0
Arguments
:: (Char -> Parser a) | Delimiter parser (accepts terminating character as argument) |
-> Parser (Maybe Value) |
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
objectEntryPrefixParser :: Parser () Source #
Consume '{'
with all preceeding space characters
Since: 0.1.0
Parse a JSON key value pair followed by a suffix
Since: 0.1.0