diff --git a/PEOPLE b/PEOPLE --- a/PEOPLE +++ b/PEOPLE @@ -5,3 +5,4 @@ Renzo Carbonara Michael Thompson David Flemström +Gabriel Gonzalez diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,10 @@ +# 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'`. 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.2.1 +version: 0.3.0 license: BSD3 license-file: LICENSE copyright: Copyright (c) Renzo Carbonara 2013-2014 @@ -27,16 +27,16 @@ library hs-source-dirs: src exposed-modules: Pipes.Aeson - Pipes.Aeson.Unsafe + Pipes.Aeson.Unchecked other-modules: Pipes.Aeson.Internal build-depends: aeson (>=0.6.1 && <0.8) , attoparsec (>=0.10 && <0.12) , base (>=4.5 && <5.0) - , pipes (>=4.0 && <4.1) - , pipes-attoparsec (>=0.3.1 && <0.4) - , pipes-parse (>=2.0 && <2.1) + , pipes (>=4.1 && <4.2) + , pipes-attoparsec (>=0.4 && <0.5) + , pipes-bytestring (>=2.0 && <2.1) + , pipes-parse (>=3.0.1 && <3.1) , bytestring (>=0.9.2.1) , transformers (>=0.2 && <0.4) ghc-options: -Wall -O2 - ghc-prof-options: -fprof-auto diff --git a/src/Pipes/Aeson.hs b/src/Pipes/Aeson.hs --- a/src/Pipes/Aeson.hs +++ b/src/Pipes/Aeson.hs @@ -4,26 +4,39 @@ -- through Pipes streams. -- -- This module builds on top of the @aeson@, @pipes@ and @pipes-parse@ --- libraries, and assumes you know how to use them. +-- libraries, and assumes you know how to use them. Please read the examples +-- in "Pipes.Parse.Tutorial" to understand how to use these functions. +-- +-- In this module, the following type synonym compatible with the @lens@, +-- @lens-family@ and @lens-family-core@ libraries is used but not exported: +-- +-- @ +-- type Lens' s a = forall f . 'Functor' f => (a -> f a) -> (s -> f s) +-- @ module Pipes.Aeson ( -- * Encoding encode + -- * Decoding -- $decoding , decode - , decodeMany + , decoded + -- ** Including lengths + , decodeL + , decodedL + -- * Types , I.DecodingError(..) ) where +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.Unsafe as U -import qualified Pipes.Attoparsec as PA -import qualified Control.Monad.Trans.State.Strict as S -import qualified Data.Aeson as Ae -import qualified Data.ByteString.Char8 as B +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 -------------------------------------------------------------------------------- @@ -33,7 +46,7 @@ -- /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 -- prefer to ignore the standard and encode any 'Ae.Value', then use 'U.encode' --- from the "Pipes.Aeson.Unsafe" module. +-- from the "Pipes.Aeson.Unchecked" module. -- -- /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: @@ -42,13 +55,17 @@ -- 'for' 'cat' 'encode' :: ('Monad' m) => 'Pipe' ('Either' 'Ae.Object' 'Ae.Array') 'B.ByteString' m r -- @ encode :: Monad m => Either Ae.Object Ae.Array -> Producer' B.ByteString m () -encode = either U.encode U.encode +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) + #-} -------------------------------------------------------------------------------- -- $decoding -- --- Decoding JSON as a Haskell value in involves two different steps: +-- Decoding JSON as a Haskell value involves two different steps: -- -- * Parsing a raw JSON 'B.ByteString' into an 'Ae.Object' or an 'Ae.Array'. -- @@ -56,55 +73,100 @@ -- 'Ae.FromJSON' instance. -- -- Any of those steps can fail, in which case a 'I.DecodingError' will report --- the precise error and at which the step it appened. +-- the precise error and at which the step it happened. -- | Decodes an 'Ae.Object' or 'Ae.Array' JSON value from the underlying state. -- --- Returns either the decoded entitiy and the number of decoded bytes, --- or a 'I.DecodingError' in case of failures. +-- 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. -- -- /Note:/ The JSON RFC-4627 standard only allows arrays or objects as top-level --- entities, which is why this 'Producer' restricts its output to them. If you --- prefer to ignore the standard and decode any 'Ae.Value', then use 'U.decode' --- from the "Pipes.Aeson.Unsafe" module. +-- entities, which is why this 'Pipes.Parser' restricts its output to them. If +-- you prefer to ignore the standard and decode any 'Ae.Value', then use +-- 'U.decode' from the "Pipes.Aeson.Unchecked" module. decode - :: (Monad m, Ae.FromJSON b) - => S.StateT (Producer B.ByteString m r) m (Either I.DecodingError (Int, b)) + :: (Monad m, Ae.FromJSON a) + => Pipes.Parser B.ByteString m (Either I.DecodingError a) decode = do - ev <- PA.parse Ae.json' - return $ do - case ev of - Left e -> Left (I.ParserError e) - Right (len, v) -> do - case Ae.fromJSON v of - Ae.Error e -> Left (I.ValueError e) - Ae.Success b -> Right (len, b) + x <- decodeL + return (case x of + Left e -> Left e + Right (_, a) -> Right a) {-# INLINABLE decode #-} --- | Continuously 'decode' the JSON output from the given 'Producer', sending --- downstream pairs of each successfully decoded entity together with the number --- of bytes consumed in order to produce it. Whitespace in between JSON content --- is ignored. +-- | 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 +-- 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)) +{-# INLINABLE decodeL #-} + + +-- | /Improper lens/ that turns a stream of raw JSON input into a stream of +-- 'Ae.FromJSON' and back. -- --- This 'Producer' runs until it either runs out of input or until a decoding --- failure occurs, in which case it returns 'Left' with a 'I.DecodingError' and --- a 'Producer' with any leftovers. You can use 'Pipes.Lift.errorP' to turn the --- 'Either' return value into an 'Control.Monad.Trans.Error.ErrorT' monad --- transformer. +-- By /improper lens/ we mean that in practice you can't expect the +-- /Monad Morphism Laws/ to be true when using 'decoded' with +-- 'Control.Lens.zoom'. -- +-- @ +-- 'Control.Lens.zoom' 'decoded' ('return' r) /= 'return' r +-- 'Control.Lens.zoom' 'decoded' (m >>= k) /= 'Control.Lens.zoom' m >>= 'Control.Lens.zoom' . f +-- @ +-- -- /Note:/ The JSON RFC-4627 standard only allows arrays or objects as top-level --- entities, which is why this 'Producer' restricts its output to them. If you --- prefer to ignore the standard and decode any 'Ae.Value', then use --- 'U.decodeMany' from the "Pipes.Aeson.Unsafe" module. -decodeMany - :: (Monad m, Ae.FromJSON b) - => Producer B.ByteString m r -- ^Producer from which to draw JSON. - -> Producer (Int, b) m - (Either (I.DecodingError, Producer B.ByteString m r) r) -decodeMany = I.consecutively decode -{-# INLINABLE decodeMany #-} +-- entities, which is why this function restricts its stream values to them. If +-- you prefer to ignore the standard and encode or decode any 'Ae.Value', then +-- use 'U.decoded' from the "Pipes.Aeson.Unchecked" module. +decoded + :: (Monad m, Ae.FromJSON a, Ae.ToJSON a) + => (Ae.Value -> Either Ae.Object Ae.Array) + -- ^ A witness that @a@ can be represented either as an 'Ae.Object' or as + -- an 'Ae.Array'. The passed in 'Ae.Value' is @'Ae.toJSON' a@ + -> Lens' (Producer B.ByteString m r) + (Producer a m (Either (I.DecodingError, Producer B.ByteString m r) r)) +decoded f k p0 = fmap _encode (k (I.consecutively decode p0)) + where + _encode = \p -> do + er <- for p (\a -> encode (f (Ae.toJSON a))) + case er of + Left (_, p') -> p' + Right r -> return r +{-# 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) + => (Ae.Value -> Either Ae.Object Ae.Array) + -- ^ A witness that @a@ can be represented either as an 'Ae.Object' or as + -- an 'Ae.Array'. The passed in 'Ae.Value' is @'Ae.toJSON' a@ + -> Lens' (Producer B.ByteString m r) + (Producer (Int, a) m (Either (I.DecodingError, Producer B.ByteString m r) r)) +decodedL f k p0 = fmap _encode (k (I.consecutively decode p0)) + where + _encode = \p -> do + er <- for p (\(_, a) -> encode (f (Ae.toJSON a))) + case er of + Left (_, p') -> p' + Right r -> return r +{-# INLINABLE decodedL #-} + + +-------------------------------------------------------------------------------- +-- 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 @@ -1,7 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} -- | This module provides internal utilities and it is likely -- to be modified in backwards-incompatible ways in the future. @@ -10,95 +9,79 @@ module Pipes.Aeson.Internal ( DecodingError(..) , consecutively - , skipSpace - , fromLazy ) where import Control.Exception (Exception) -import qualified Control.Monad.Trans.Error as E +import Control.Monad.Trans.Error (Error) import qualified Control.Monad.Trans.State.Strict as S -import qualified Data.Aeson as Ae -import qualified Data.ByteString.Char8 as B -import qualified Data.ByteString.Lazy.Internal as BLI -import qualified Data.Char as Char +import qualified Data.ByteString as B +import qualified Data.ByteString.Internal as B (isSpaceWord8) import Data.Data (Data, Typeable) import Pipes -import qualified Pipes.Attoparsec as PA -import qualified Pipes.Parse as Pp -import qualified Pipes.Lift as P +import Pipes.Attoparsec (ParsingError) +import qualified Pipes.ByteString as PB +import qualified Pipes.Parse as Pipes -------------------------------------------------------------------------------- -- | An error while decoding a JSON value. data DecodingError - = ParserError PA.ParsingError - -- ^An Attoparsec error that happened while parsing the raw JSON string. - | ValueError String - -- ^An Aeson error that happened while trying to convert a - -- 'Data.Aeson.Value' to an 'A.FromJSON' instance, as reported by + = AttoparsecError ParsingError + -- ^An @attoparsec@ error that happened while parsing the raw JSON string. + | FromJSONError String + -- ^An @aeson@ error that happened while trying to convert a + -- 'Data.Aeson.Value' to an 'A.FromJSON' instance, as reported by -- 'Data.Aeson.Error'. deriving (Show, Eq, Data, Typeable) instance Exception DecodingError -instance E.Error DecodingError -instance Monad m => E.Error (DecodingError, Producer a m r) +instance Error DecodingError +-- | This instance allows using 'Pipes.Lift.errorP' with 'Pipes.Aeson.decoded' +-- and 'Pipes.Aeson.decodedL' +instance Error (DecodingError, Producer a m r) + -------------------------------------------------------------------------------- --- | Consecutively parse 'b' elements from the given 'Producer' using the given +-- | Consecutively parse 'a' elements from the given 'Producer' using the given -- parser (such as 'Pipes.Aeson.decode' or 'Pipes.Aeson.parseValue'), skipping -- any leading whitespace each time. -- -- This 'Producer' runs until it either runs out of input or until a decoding --- failure occurs, in which case it returns 'Left' with a 'I.DecodingError' and --- a 'Producer' with any leftovers. You can use 'P.errorP' to turn the 'Either' --- return value into an 'Control.Monad.Trans.Error.ErrorT' monad transformer. +-- failure occurs, in which case it returns 'Left' with a 'DecodingError' and +-- a 'Producer' with any leftovers. You can use 'Pipes.Lift.errorP' to turn the +-- 'Either' return value into an 'Control.Monad.Trans.Error.ErrorT' +-- monad transformer. consecutively - :: (Monad m, Ae.FromJSON b) - => S.StateT (Producer B.ByteString m r) m (Either DecodingError (Int, b)) - -> Producer B.ByteString m r -- ^Producer from which to draw JSON. - -> Producer (Int, b) m - (Either (DecodingError, Producer B.ByteString m r) r) -consecutively parser = \src -> do - (er, src') <- P.runStateP src prod - return $ case er of - Left e -> Left (e, src') - Right r -> Right r - where - prod = do - eof <- lift (skipSpace >> PA.isEndOfParserInput) - if eof - then do - ra <- lift Pp.draw - case ra of - Left r -> return (Right r) - Right _ -> error "Pipes.Aeson.parseMany: impossible!!" - else do - eb <- lift parser - case eb of - Left e -> return (Left e) - Right b -> yield b >> prod + :: (Monad m) + => Pipes.Parser B.ByteString m (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 {-# INLINABLE consecutively #-} -------------------------------------------------------------------------------- - --- XXX we define the following proxies here until 'pipes-bytestring' is released - --- | Consumes and discards leading 'I.ParserInput' characters from upstream as --- long as the given predicate holds 'True'. -skipSpace :: Monad m => S.StateT (Producer B.ByteString m r) m () -skipSpace = do - ma <- Pp.draw - case ma of - Left _ -> return () - Right a -> do - let a' = B.dropWhile Char.isSpace a - if B.null a' - then skipSpace - else Pp.unDraw a' -{-# INLINABLE skipSpace #-} +-- Internal tools -------------------------------------------------------------- --- Sends each of the 'BLI.ByteString''s strict chunks downstream. -fromLazy :: Monad m => BLI.ByteString -> Producer' B.ByteString m () -fromLazy = BLI.foldrChunks (\e a -> yield e >> a) (return ()) -{-# INLINABLE fromLazy #-} +-- | 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) + 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 #-} diff --git a/src/Pipes/Aeson/Unchecked.hs b/src/Pipes/Aeson/Unchecked.hs new file mode 100644 --- /dev/null +++ b/src/Pipes/Aeson/Unchecked.hs @@ -0,0 +1,110 @@ +{-# 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 + -- ** Including lenghts + , decodeL + , decodedL + ) where + +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 + +-------------------------------------------------------------------------------- + +-- | 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) +{-# 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 (Either I.DecodingError a) -- ^ +decode = do + x <- decodeL + return (case x of + Left e -> Left e + Right (_, a) -> Right a) +{-# 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 (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)) +{-# 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 k p = fmap _encode (k (I.consecutively decode p)) + where + _encode = \p0 -> do + er <- for p0 (\a -> encode a) + case er of + Left (_, p1) -> p1 + Right r -> return 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 k p = fmap _encode (k (I.consecutively decodeL p)) + where + _encode = \p0 -> do + er <- for p0 (\(_, a) -> encode a) + case er of + Left (_, p1) -> p1 + Right r -> return r + {-# INLINE _encode #-} +{-# INLINABLE decodedL #-} + + +-------------------------------------------------------------------------------- +-- Internal tools -------------------------------------------------------------- + +type Lens' s a = forall f . Functor f => (a -> f a) -> (s -> f s) diff --git a/src/Pipes/Aeson/Unsafe.hs b/src/Pipes/Aeson/Unsafe.hs deleted file mode 100644 --- a/src/Pipes/Aeson/Unsafe.hs +++ /dev/null @@ -1,60 +0,0 @@ -{-# 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.Unsafe - ( -- * Encoding - encode - -- * Decoding - , decode - , decodeMany - ) where - -import Pipes -import qualified Pipes.Aeson.Internal as I -import qualified Pipes.Attoparsec as PA -import qualified Control.Monad.Trans.State.Strict as S -import qualified Data.Aeson as Ae -import qualified Data.Aeson.Parser as Ae (value') -import qualified Data.ByteString as B - --------------------------------------------------------------------------------- - --- | 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 = I.fromLazy . Ae.encode -{-# INLINABLE encode #-} - --------------------------------------------------------------------------------- - --- | Like 'Pipes.Aeson.decode', except it will decode any 'Ae.ToJSON' instance, --- not just 'Ae.Array' or 'Ae.Object'. -decode - :: (Monad m, Ae.FromJSON b) - => S.StateT (Producer B.ByteString m r) m (Either I.DecodingError (Int, b)) -decode = do - ev <- PA.parse Ae.value' - return $ do - case ev of - Left e -> Left (I.ParserError e) - Right (len, v) -> do - case Ae.fromJSON v of - Ae.Error e -> Left (I.ValueError e) - Ae.Success b -> Right (len, b) -{-# INLINABLE decode #-} - --- | Like 'Pipes.Aeson.decodeMany', except it will decode any 'Ae.ToJSON' --- instance, not just 'Ae.Array' or 'Ae.Object'. -decodeMany - :: (Monad m, Ae.FromJSON b) - => Producer B.ByteString m r -- ^Producer from which to draw JSON. - -> Producer (Int, b) m - (Either (I.DecodingError, Producer B.ByteString m r) r) -decodeMany = I.consecutively decode -{-# INLINABLE decodeMany #-} -