diff --git a/PEOPLE b/PEOPLE --- a/PEOPLE +++ b/PEOPLE @@ -6,3 +6,4 @@ Michael Thompson David Flemström Gabriel Gonzalez +Pierre Radermecker diff --git a/changelog b/changelog deleted file mode 100644 --- a/changelog +++ /dev/null @@ -1,25 +0,0 @@ -# 0.3.0 - -* API revamped to be compatible with `pipes-parse-3.0.*`. - -* Renamed `Pipes.Aeson.Unsafe` module to `Pipes.Aeson.Unchecked`. - - -# 0.2.1 - -* Generalize `encode` from `Producer` to `Producer'`. - -* Depend on newer versions of `aeson`, `attoparsec`, `pipes-attoparsec. - - -# 0.2.0 - -* Version compatible with `pipes-4.0.0` and `pipes-parse-2.0.0`. - -* API radically changed. Removed `parseValue`, `fromValue` and - `TopLevelValue`. Other things renamed. - - -# 0.1.0.0 - -* First version. diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,41 @@ +# 0.4 + +* Remove `Pipes.Aeson.encode` in favour of `encodeObject` and + `encodeArray`. + +* `decode` and `decodeL` now return `Nothing` on end of input, instead + of failing with a `DecodingError`. This follows the approach taken + by `pipes-attoparsec-0.5`. + +* Solved quadratic time complexity issue when decoding (#10). + +* Depend on `pipes-attoparsec-0.5.*`. + +* Raise upper bound for `transformers` to `0.4.*`. + + +# 0.3.0 + +* API revamped to be compatible with `pipes-parse-3.0.*`. + +* Renamed `Pipes.Aeson.Unsafe` module to `Pipes.Aeson.Unchecked`. + + +# 0.2.1 + +* Generalize `encode` from `Producer` to `Producer'`. + +* Depend on newer versions of `aeson`, `attoparsec`, `pipes-attoparsec`. + + +# 0.2.0 + +* Version compatible with `pipes-4.0.0` and `pipes-parse-2.0.0`. + +* API radically changed. Removed `parseValue`, `fromValue` and + `TopLevelValue`. Other things renamed. + + +# 0.1.0.0 + +* First version. diff --git a/pipes-aeson.cabal b/pipes-aeson.cabal --- a/pipes-aeson.cabal +++ b/pipes-aeson.cabal @@ -1,5 +1,5 @@ name: pipes-aeson -version: 0.3.0 +version: 0.4 license: BSD3 license-file: LICENSE copyright: Copyright (c) Renzo Carbonara 2013-2014 @@ -13,11 +13,11 @@ build-type: Simple cabal-version: >=1.8 synopsis: Encode and decode JSON streams using Aeson and Pipes. -extra-source-files: README.md PEOPLE changelog +extra-source-files: README.md PEOPLE changelog.md description: Utilities to encode and decode Pipes streams of JSON. . - See the @changelog@ file in the source distribution to learn about any + See the @changelog.md@ file in the source distribution to learn about any important changes between version. source-repository head @@ -34,9 +34,9 @@ , attoparsec (>=0.10 && <0.12) , base (>=4.5 && <5.0) , pipes (>=4.1 && <4.2) - , pipes-attoparsec (>=0.4 && <0.5) + , pipes-attoparsec (>=0.5 && <0.6) , pipes-bytestring (>=2.0 && <2.1) , pipes-parse (>=3.0.1 && <3.1) , bytestring (>=0.9.2.1) - , transformers (>=0.2 && <0.4) + , transformers (>=0.2 && <0.5) ghc-options: -Wall -O2 diff --git a/src/Pipes/Aeson.hs b/src/Pipes/Aeson.hs --- a/src/Pipes/Aeson.hs +++ b/src/Pipes/Aeson.hs @@ -16,7 +16,9 @@ module Pipes.Aeson ( -- * Encoding - encode + -- $encoding + encodeArray + , encodeObject -- * Decoding -- $decoding @@ -30,38 +32,56 @@ , 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.Attoparsec as PA import qualified Pipes.Parse as Pipes -------------------------------------------------------------------------------- - --- | Encode an 'Ae.Array' or 'Ae.Object' as JSON and send it downstream, +-- $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 this function restricts its input to them. If you +-- 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.Array' or 'Ae.Object' values as JSON as they flow downstream using: +-- 'Ae.Object' values as JSON as they flow downstream using: -- -- @ --- 'for' 'cat' 'encode' :: ('Monad' m) => 'Pipe' ('Either' 'Ae.Object' 'Ae.Array') 'B.ByteString' m r +-- 'for' 'cat' 'encodeObject' :: 'Monad' m => 'Pipe' 'Ae.Object' 'B.ByteString' m r -- @ -encode :: Monad m => Either Ae.Object Ae.Array -> Producer' B.ByteString m () -encode (Left x) = U.encode x -encode (Right x) = U.encode x -{-# INLINABLE encode #-} -{-# RULES "p >-> for cat encode" forall p . - p >-> for cat encode = for p (\a -> encode a) +encodeObject :: Monad m => Ae.Object -> Producer' B.ByteString m () +encodeObject = 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 = U.encode +{-# INLINABLE encodeArray #-} +{-# RULES "p >-> for cat encodeArray" forall p . + p >-> for cat encodeArray = for p encodeArray + #-} + -------------------------------------------------------------------------------- -- $decoding -- @@ -80,8 +100,8 @@ -- -- Returns either the decoded entitiy, or a 'I.DecodingError' in case of error. -- --- /Do not/ use this function if the underlying 'Producer' has leading empty --- chunks or whitespace, otherwise you may get unexpected parsing errors. +-- 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 @@ -89,12 +109,8 @@ -- 'U.decode' from the "Pipes.Aeson.Unchecked" module. decode :: (Monad m, Ae.FromJSON a) - => Pipes.Parser B.ByteString m (Either I.DecodingError a) -decode = do - x <- decodeL - return (case x of - Left e -> Left e - Right (_, a) -> Right a) + => Pipes.Parser B.ByteString m (Maybe (Either I.DecodingError a)) +decode = fmap (fmap snd) `liftM` decodeL {-# INLINABLE decode #-} -- | Like 'decode', except it also returns the length of JSON input that was @@ -102,14 +118,8 @@ -- before nor after the parsed JSON input. decodeL :: (Monad m, Ae.FromJSON a) - => Pipes.Parser B.ByteString m (Either I.DecodingError (Int, a)) -decodeL = do - ev <- PA.parseL Ae.json' - return (case ev of - Left e -> Left (I.AttoparsecError e) - Right (n, v) -> case Ae.fromJSON v of - Ae.Error e -> Left (I.FromJSONError e) - Ae.Success a -> Right (n, a)) + => Pipes.Parser B.ByteString m (Maybe (Either I.DecodingError (Int, a))) +decodeL = I.decodeL Ae.json' {-# INLINABLE decodeL #-} @@ -139,7 +149,7 @@ decoded f k p0 = fmap _encode (k (I.consecutively decode p0)) where _encode = \p -> do - er <- for p (\a -> encode (f (Ae.toJSON a))) + er <- for p (\a -> either encodeObject encodeArray (f (Ae.toJSON a))) case er of Left (_, p') -> p' Right r -> return r @@ -158,7 +168,7 @@ decodedL f k p0 = fmap _encode (k (I.consecutively decode p0)) where _encode = \p -> do - er <- for p (\(_, a) -> encode (f (Ae.toJSON a))) + er <- for p (\(_, a) -> either encodeObject encodeArray (f (Ae.toJSON a))) case er of Left (_, p') -> p' Right r -> return r @@ -169,4 +179,3 @@ -- Internal tools -------------------------------------------------------------- type Lens' s a = forall f . Functor f => (a -> f a) -> (s -> f s) - diff --git a/src/Pipes/Aeson/Internal.hs b/src/Pipes/Aeson/Internal.hs --- a/src/Pipes/Aeson/Internal.hs +++ b/src/Pipes/Aeson/Internal.hs @@ -9,24 +9,25 @@ module Pipes.Aeson.Internal ( DecodingError(..) , consecutively + , decodeL ) where - import Control.Exception (Exception) import Control.Monad.Trans.Error (Error) import qualified Control.Monad.Trans.State.Strict as S +import qualified Data.Aeson as Ae +import qualified Data.Attoparsec.Types as Attoparsec import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B (isSpaceWord8) import Data.Data (Data, Typeable) import Pipes -import Pipes.Attoparsec (ParsingError) -import qualified Pipes.ByteString as PB +import qualified Pipes.Attoparsec as PA import qualified Pipes.Parse as Pipes -------------------------------------------------------------------------------- -- | An error while decoding a JSON value. data DecodingError - = AttoparsecError ParsingError + = AttoparsecError PA.ParsingError -- ^An @attoparsec@ error that happened while parsing the raw JSON string. | FromJSONError String -- ^An @aeson@ error that happened while trying to convert a @@ -54,34 +55,60 @@ -- monad transformer. consecutively :: (Monad m) - => Pipes.Parser B.ByteString m (Either e a) + => Pipes.Parser B.ByteString m (Maybe (Either e a)) -> Producer B.ByteString m r -- ^Producer from which to draw raw input. -> Producer a m (Either (e, Producer B.ByteString m r) r) consecutively parser = step where step p0 = do - (mr, p1) <- lift $ - S.runStateT atEndOfBytes (p0 >-> PB.dropWhile B.isSpaceWord8) - case mr of - Just r -> return (Right r) - Nothing -> do - (ea, p2) <- lift (S.runStateT parser p1) - case ea of - Left e -> return (Left (e, p2)) - Right a -> yield a >> step p2 + x <- lift $ nextSkipBlank p0 + case x of + Left r -> return (Right r) + Right (bs, p1) -> do + (mea, p2) <- lift $ S.runStateT parser (yield bs >> p1) + case mea of + Just (Right a) -> yield a >> step p2 + Just (Left e) -> return (Left (e, p2)) + Nothing -> error "Pipes.Aeson.Internal.consecutively: impossible" {-# INLINABLE consecutively #-} + +-- | Decodes a 'Ae.FromJSON' value from the underlying state using the given +-- 'Attoparsec.Parser' in order to obtain an 'Ae.Value' first. +-- +-- Returns either the decoded entitiy, or a 'I.DecodingError' in case of error. +-- +-- It returns 'Nothing' if the underlying 'Producer' is exhausted, otherwise +-- it returns either the decoded entity or a 'I.DecodingError' in case of error. +decodeL + :: (Monad m, Ae.FromJSON a) + => Attoparsec.Parser B.ByteString Ae.Value + -> Pipes.Parser B.ByteString m (Maybe (Either DecodingError (Int, a))) -- ^ +decodeL parser = do + mev <- PA.parseL parser + return $ case mev of + Nothing -> Nothing + Just (Left l) -> Just (Left (AttoparsecError l)) + Just (Right (n, v)) -> case Ae.fromJSON v of + Ae.Error e -> Just (Left (FromJSONError e)) + Ae.Success a -> Just (Right (n, a)) +{-# INLINABLE decodeL #-} + + -------------------------------------------------------------------------------- --- Internal tools -------------------------------------------------------------- +-- Internal stuff --- | Returns @'Just' r@ if the producer has reached end of input, otherwise --- 'Nothing'. -atEndOfBytes :: Monad m => S.StateT (Producer B.ByteString m r) m (Maybe r) -atEndOfBytes = step =<< S.get where - step p0 = do - x <- lift (next p0) +-- | Like 'Pipes.next', except it skips leading whitespace and 'B.null' chunks. +nextSkipBlank + :: (Monad m) + => Producer B.ByteString m r + -> m (Either r (B.ByteString, Producer B.ByteString m r)) +nextSkipBlank = go where + go p0 = do + x <- next p0 case x of - Left r -> S.put (return r) >> return (Just r) - Right (a,p1) - | B.null a -> step p1 - | otherwise -> S.put (yield a >> p1) >> return Nothing -{-# INLINABLE atEndOfBytes #-} + Left _ -> return x + Right (a,p1) -> do + let a' = B.dropWhile B.isSpaceWord8 a + if B.null a' then go p1 + else return (Right (a', p1)) +{-# INLINABLE nextSkipBlank #-} diff --git a/src/Pipes/Aeson/Unchecked.hs b/src/Pipes/Aeson/Unchecked.hs --- a/src/Pipes/Aeson/Unchecked.hs +++ b/src/Pipes/Aeson/Unchecked.hs @@ -17,21 +17,21 @@ , decodedL ) 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.Parse as Pipes -import qualified Pipes.Aeson.Internal as I -import qualified Pipes.Attoparsec as PA -import qualified Pipes.ByteString as PB -import qualified Data.Aeson as Ae -import qualified Data.Aeson.Parser as Ae (value') -import qualified Data.ByteString as B +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 = \a -> PB.fromLazy (Ae.encode a) +encode = PB.fromLazy . Ae.encode {-# INLINABLE encode #-} {-# RULES "p >-> for cat encode" forall p . p >-> for cat encode = for p (\a -> PB.fromLazy (Ae.encode a)) @@ -43,12 +43,8 @@ -- instance, not just 'Ae.Array' or 'Ae.Object'. decode :: (Monad m, Ae.FromJSON a) - => Pipes.Parser B.ByteString m (Either I.DecodingError a) -- ^ -decode = do - x <- decodeL - return (case x of - Left e -> Left e - Right (_, a) -> Right a) + => Pipes.Parser B.ByteString m ((Maybe (Either I.DecodingError a))) -- ^ +decode = fmap (fmap snd) `liftM` decodeL {-# INLINABLE decode #-} @@ -57,14 +53,8 @@ -- between each parsed JSON input. decodeL :: (Monad m, Ae.FromJSON a) - => Pipes.Parser B.ByteString m (Either I.DecodingError (Int, a)) -- ^ -decodeL = do - ev <- PA.parseL Ae.value' - return (case ev of - Left e -> Left (I.AttoparsecError e) - Right (n, v) -> case Ae.fromJSON v of - Ae.Error e -> Left (I.FromJSONError e) - Ae.Success a -> Right (n, a)) + => Pipes.Parser B.ByteString m (Maybe (Either I.DecodingError (Int, a))) -- ^ +decodeL = I.decodeL Ae.value' {-# INLINABLE decodeL #-} -- | Like 'Pipes.Aeson.decoded', except it will decode and decode any