conduit-aeson (empty) → 0.1.0.0
raw patch · 10 files changed
+585/−0 lines, 10 filesdep +QuickCheckdep +aesondep +attoparsecsetup-changed
Dependencies added: QuickCheck, aeson, attoparsec, base, bytestring, conduit, conduit-aeson, conduit-extra, containers, doctest-parallel, hspec, scientific, text
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- README.md +29/−0
- Setup.hs +6/−0
- conduit-aeson.cabal +91/−0
- src/Data/Conduit/Aeson.hs +341/−0
- tests/Data/Conduit/AesonSpec.hs +53/−0
- tests/Main.hs +11/−0
- tests/Spec.hs +1/−0
- tests/doctests.hs +18/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Changelog for `conduit-aeson`++## 0.1.0.0++* Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Alexey Kuleshevich (c) 2021-2022++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Alexey Kuleshevich nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,29 @@+# conduit-aeson++## Overview++A simple library that allows streaming parsing of large JSON objects and arrays+using Aeson, Attoparsec and Conduit.++It is important to note that only the top level elements of arrays and objects+can be streamed, in other words streaming of nested objects is not supported.++This library is suitable for parsing of very large json files as well as+infinite streams of JSON objects.++## Status++| Github Actions | Coveralls | Hackage | Nightly | LTS |+|:--------------:|:---------:|:-------:|:-------:|:---:|+| [![Build Status][GA-badge]][GA-link] | [![Coverage Status][Coveralls-badge]][Coveralls-link] | [![Hackage][Hackage-badge]][Hackage-link] | [![Nightly][Nightly-badge]][Nightly-link] | [![LTS][LTS-badge]][LTS-link]++[GA-badge]: https://github.com/lehins/conduit-aeson/workflows/CI/badge.svg+[GA-link]: https://github.com/lehins/conduit-aeson/actions+[Coveralls-badge]: https://coveralls.io/repos/github/lehins/conduit-aeson/badge.svg?branch=master+[Coveralls-link]: https://coveralls.io/github/lehins/conduit-aeson?branch=master+[Hackage-badge]: https://img.shields.io/hackage/v/conduit-aeson.svg+[Hackage-link]: https://hackage.haskell.org/package/conduit-aeson+[Nightly-badge]: https://www.stackage.org/package/conduit-aeson/badge/nightly+[Nightly-link]: https://www.stackage.org/nightly/package/conduit-aeson+[LTS-badge]: https://www.stackage.org/package/conduit-aeson/badge/lts+[LTS-link]: https://www.stackage.org/lts/package/conduit-aeson
+ Setup.hs view
@@ -0,0 +1,6 @@+import Distribution.Simple++main :: IO ()+main = defaultMain+#endif+
+ conduit-aeson.cabal view
@@ -0,0 +1,91 @@+name: conduit-aeson+version: 0.1.0.0+synopsis: Short description+description: Please see the README on GitHub at <https://github.com/lehins/conduit-aeson#readme>+homepage: https://github.com/lehins/conduit-aeson+license: BSD3+license-file: LICENSE+author: Alexey Kuleshevich+maintainer: alexey@kuleshevi.ch+copyright: 2021-2022 Alexey Kuleshevich+category: Algorithms+build-type: Simple+extra-source-files: README.md+ , CHANGELOG.md+cabal-version: 1.18+tested-with: GHC == 8.4.3+ , GHC == 8.4.4+ , GHC == 8.6.3+ , GHC == 8.6.4+ , GHC == 8.6.5+ , GHC == 8.8.1+ , GHC == 8.8.2+ , GHC == 8.10.1++library+ hs-source-dirs: src+ exposed-modules: Data.Conduit.Aeson++ other-modules:+ build-depends: aeson >= 1.0+ , attoparsec+ , base >= 4.9 && < 5+ , bytestring+ , conduit+ , conduit-extra+ , text++ default-language: Haskell2010+ ghc-options: -Wall+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wredundant-constraints+++test-suite doctests+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: doctests.hs+ build-depends: base+ if impl(ghc >= 8.2)+ build-depends: attoparsec+ , bytestring+ , conduit+ , conduit-aeson+ , doctest-parallel+ default-language: Haskell2010+ ghc-options: -Wall+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wredundant-constraints+ -threaded++test-suite tests+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ main-is: Main.hs+ other-modules: Data.Conduit.AesonSpec+ , Spec+ build-depends: base+ , aeson+ , conduit+ , containers+ , conduit-aeson+ , hspec+ , QuickCheck+ , scientific+ , text+ build-tool-depends: hspec-discover:hspec-discover++ default-language: Haskell2010+ ghc-options: -Wall+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wredundant-constraints+ -fno-warn-orphans+ -threaded+ -with-rtsopts=-N2++source-repository head+ type: git+ location: https://github.com/lehins/conduit-aeson
+ src/Data/Conduit/Aeson.hs view
@@ -0,0 +1,341 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE LambdaCase #-}+-- |+-- 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+ , 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 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+-- >>> 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 = conduitArrayEither .| mapMC (either throwM 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 = conduitArrayParserEither .| stopOnNothing .| mapC toValue+ where+ toValue (Left err) = Left err+ toValue (Right (_, v)) = first AesonParserError $ Aeson.parseEither Aeson.parseJSON 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 = do+ sinkParserEither valuePrefixParser >>= \case+ Left err -> yield $ Left err+ Right () -> conduitParserEither (valueMaybeParser 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.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 = conduitParserEither . 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+-- >>> 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 = conduitObjectEither .| mapMC (either throwM 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 = conduitObjectParserEither .| stopOnNothing .| mapC toKeyValue+ where+ _id x = x -- work around an aeson rewrite rule.+ toKeyValue (Left err) = Left err+ toKeyValue (Right (_, (k, v))) =+ first AesonParserError $ do+ key <-+ case fromJSONKey of+#if MIN_VERSION_aeson(1,5,0)+ FromJSONKeyCoerce -> Right $ coerce k+#else+ FromJSONKeyCoerce {}+ | FromJSONKeyText f <- fmap _id fromJSONKey -> Right $ f k+ | otherwise -> error "Impossible: failed to convert coercible FromJSONKeyCoerce"+#endif+ FromJSONKeyText f -> Right $ f k+ FromJSONKeyTextParser p -> Aeson.parseEither p k+ FromJSONKeyValue p -> Aeson.parseEither p (String k)+ val <- Aeson.parseEither Aeson.parseJSON v+ Right (key, 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 = do+ sinkParserEither objectEntryPrefixParser >>= \case+ Left err -> yield $ Left err+ Right () -> conduitParserEither (objectEntryMaybeParser 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.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 = conduitParserEither . objectEntryParser+++stopOnNothing ::+ Monad m+ => ConduitM (Either ParseError (PositionRange, Maybe a))+ (Either ParserError (PositionRange, a)) m ()+stopOnNothing = do+ await >>= \case+ Nothing -> yield $ Left NonTerminatedInput+ Just e+ | Left err <- e -> yield (Left (AttoParserError err)) >> stopOnNothing+ | Right (p, Just r) <- e -> yield (Right (p, r)) >> stopOnNothing+ | Right (_, Nothing) <- e -> pure ()++-- Attoparsec++-- | Skips all spaces and newlines+--+-- @since 0.1.0+skipSpace :: Atto.Parser ()+skipSpace = Atto.skipWhile $ \w -> w == 0x20 || w == 0x0a || w == 0x0d || w == 0x09++-- | Use a comma for delimiter.+--+-- @since 0.1.0+commaParser ::+ Char+ -- ^ Terminating character.+ -> Atto.Parser ()+commaParser = delimiterParser (Atto.word8 0x2c Atto8.<?> "','")++-- | Parser for delimiter with terminating character+--+-- @since 0.1.0+delimiterParser :: Atto.Parser a -> Char -> Atto.Parser ()+delimiterParser dp t =+ skipSpace <* (void dp <|> expectTermination)+ where+ expectTermination =+ Atto8.peekChar >>= \case+ Just c+ | c /= t -> fail $ "Unexpected delimiter: " ++ show c+ _ -> pure ()++-- | Consume @'['@ with all preceeding space characters+--+-- @since 0.1.0+valuePrefixParser :: Atto.Parser ()+valuePrefixParser = skipSpace <* Atto8.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 dp = skipSpace *> json' <* 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.0+valueMaybeParser ::+ (Char -> Atto.Parser a)+ -- ^ Delimiter parser (accepts terminating character as argument)+ -> Atto.Parser (Maybe Aeson.Value)+valueMaybeParser dp =+ let t = ']'+ in skipSpace *> ((Nothing <$ Atto8.char t) <|> (Just <$> json' <* dp t))++-- | Consume @'{'@ with all preceeding space characters+--+-- @since 0.1.0+objectEntryPrefixParser :: Atto.Parser ()+objectEntryPrefixParser = skipSpace <* Atto8.char '{'+++-- | Parse JSON object key followed by a colon+--+-- @since 0.1.0+keyParser :: Atto.Parser T.Text+keyParser =+ skipSpace *>+ (Aeson.jstring Atto.<?> "key") <*+ skipSpace <*+ (Atto.word8 0x3a Atto.<?> "':'")++-- | 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 dp = (,) <$> keyParser <*> valueParser 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 dp =+ let t = '}'+ in skipSpace *>+ ((Nothing <$ Atto8.char t) <|> (Just <$> objectEntryParser (dp t)))
+ tests/Data/Conduit/AesonSpec.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Data.Conduit.AesonSpec (spec) where++import Conduit+import Data.Aeson+import Data.Conduit.Aeson+import qualified Data.Map.Strict as Map+import Data.Scientific+import qualified Data.Text as T+import GHC.Exts+import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck++instance Arbitrary T.Text where+ arbitrary = T.pack <$> arbitrary++instance Arbitrary Value where+ arbitrary = sized sizedArbitraryValue++sizedArbitraryValue :: Int -> Gen Value+sizedArbitraryValue n+ | n <= 0 = oneof [pure Null, bool, number, string]+ | otherwise = resize n' $ oneof [pure Null, bool, number, string, array, object']+ where+ n' = n `div` 2+ bool = Bool <$> arbitrary+ number = Number <$> (scientific <$> arbitrary <*> arbitrary)+ string = String <$> arbitrary+ array = Array . fromList <$> arbitrary+ object' = listToObject <$> arbitrary++listToObject :: [(String, Value)] -> Value+listToObject xs = object [(fromString k, v) | (k, v) <- xs]++spec :: Spec+spec = do+ describe "roundtrips" $ do+ prop "conduitArray" $ \(xs :: [Value]) -> do+ xs' <-+ runConduit+ (sourceLazy (encode (Array (fromList xs))) .| conduitArray .| sinkList)+ xs' `shouldBe` xs+ prop "conduitObject" $ \(ls :: [(String, Value)]) -> do+ let xs = Map.fromList ls+ xs' <-+ runConduit+ (sourceLazy (encode (listToObject (Map.toAscList xs))) .|+ conduitObject .|+ sinkList)+ Map.fromList xs' `shouldBe` xs
+ tests/Main.hs view
@@ -0,0 +1,11 @@+module Main where++import Spec+import System.IO (BufferMode (LineBuffering), hSetBuffering, hSetEncoding, stdout, utf8)+import Test.Hspec++main :: IO ()+main = do+ hSetBuffering stdout LineBuffering+ hSetEncoding stdout utf8+ hspec spec
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-}
+ tests/doctests.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE CPP #-}++module Main where++#if __GLASGOW_HASKELL__ >= 802+import Test.DocTest (mainFromCabal)+import System.Environment (getArgs)++main :: IO ()+main = mainFromCabal "conduit-aeson" =<< getArgs+#else++import System.IO++main :: IO ()+main = hPutStrLn stderr "GHC version older than 8.2 are not supported"++#endif