diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2013, Renzo Carbonara + +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 Renzo Carbonara 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. diff --git a/NEWS b/NEWS new file mode 100644 --- /dev/null +++ b/NEWS @@ -0,0 +1,3 @@ +# 0.1.0.0 + +* First version. diff --git a/PEOPLE b/PEOPLE new file mode 100644 --- /dev/null +++ b/PEOPLE @@ -0,0 +1,5 @@ +The following people have participated in creating this library, either +by directly contributing code or by providing thoughtful input in +discussions about the library design. + +Renzo Carbonara diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,13 @@ +# pipes-aeson + +Utilities to encode and decode streams of **JSON** values using **Pipes** and +**Aeson**. + +Check the source or rendered Haddocks for documentation. + +This code is licensed under the terms of the so called **3-clause BSD +license**. Read the file named ``LICENSE`` found in this same directory +for details. + +See the ``PEOPLE`` file to learn about the people involved in this +effort. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/pipes-aeson.cabal b/pipes-aeson.cabal new file mode 100644 --- /dev/null +++ b/pipes-aeson.cabal @@ -0,0 +1,42 @@ +name: pipes-aeson +version: 0.1.0.0 +license: BSD3 +license-file: LICENSE +copyright: Copyright (c) Renzo Carbonara 2013 +author: Renzo Carbonara +maintainer: renzocarbonaraλgmail.com +stability: Experimental +tested-with: GHC ==7.4.1 +homepage: https://github.com/k0001/pipes-aeson +bug-reports: https://github.com/k0001/pipes-aeson/issues +category: Pipes, Parser +build-type: Simple +cabal-version: >=1.8 +synopsis: Encode and decode JSON streams using aeson and pipes. +extra-source-files: README.md PEOPLE NEWS +description: + Utilities to encode and decode JSON streams using @aeson@ and @pipes@, + possibly interleaving other stream effects too. + . + See the @NEWS@ file in the source distribution to learn about any + important changes between version. + +source-repository head + type: git + location: git://github.com/k0001/pipes-aeson.git + +library + hs-source-dirs: src + exposed-modules: Control.Proxy.Aeson + Control.Proxy.Aeson.Unsafe + other-modules: Control.Proxy.Aeson.Internal + build-depends: + aeson (>=0.6.1 && < 0.7) + , attoparsec + , base (>=4.5 && < 5.0) + , pipes (>=3.3 && <3.4) + , pipes-attoparsec (>=0.2 && <0.3) + , pipes-parse (>=1.0 && <1.1) + , bytestring (>=0.9.2.1) + ghc-options: -Wall -O2 + ghc-prof-options: -fprof-auto diff --git a/src/Control/Proxy/Aeson.hs b/src/Control/Proxy/Aeson.hs new file mode 100644 --- /dev/null +++ b/src/Control/Proxy/Aeson.hs @@ -0,0 +1,274 @@ +-- | This module allows you to encode and decode JSON values flowing downstream +-- through Pipes streams, possibly interleaving other stream effects. +-- +-- This module builds on top of the @pipes-parse@ and @pipes-attoparsec@ +-- packages and assumes you have read "Control.Proxy.Parse.Tutorial". + +module Control.Proxy.Aeson + ( -- * Top level JSON values + -- $top-level-value + TopLevelValue(..) + , toTopLevelValue + -- * Encoding + -- $encoding + , encode + , encodeD + -- * Decoding + -- $decoding + , decode + , decodeD + -- ** Lower level parsing + , parseValue + , parseValueD + , fromValue + , fromValueD + -- * Types + , I.DecodingError(..) + ) where + + +import Control.Monad (unless) +import qualified Control.Proxy as P +import qualified Control.Proxy.Aeson.Internal as I +import qualified Control.Proxy.Aeson.Unsafe as U +import qualified Control.Proxy.Attoparsec as PA +import qualified Control.Proxy.Trans.Either as P +import qualified Control.Proxy.Trans.State as P +import qualified Data.Aeson as Ae +import qualified Data.ByteString.Char8 as B +import Data.Maybe (fromJust) + +-------------------------------------------------------------------------------- +-- $top-level-value +-- +-- The JSON RFC-4627 standard only allows 'Ae.Array' or 'Ae.Object' values as +-- top-level. The 'TopLevelValue' type used throughout this module in +-- replacement of Aesons's 'Ae.Value' enforces that restricion in a type-safe +-- manner. +-- +-- If you want to ignore the standard and encode or decode any 'Ae.Value', then +-- use the facilities exported by the "Control.Proxy.Aeson.Unsafe" module. +-- +-- * You may use the 'toTopLevelValue' function to convert any 'Ae.ToJSON' +-- instance to a 'TopLevelValue', if possible. Remember that 'Ae.Value' is +-- one such instance. +-- +-- * Use the 'Ae.toJSON' method on a 'TopLevelValue' to obtain its underlying +-- 'Ae.Value' representation. + + +-- | A JSON top-level value must be an 'Ae.Object' or an 'Ae.Array', according +-- to RFC-4627. +data TopLevelValue + = Object !Ae.Object + | Array !Ae.Array + deriving (Show, Eq) + +instance Ae.ToJSON TopLevelValue where + toJSON (Object o) = Ae.Object o + toJSON (Array a) = Ae.Array a + +instance Ae.FromJSON TopLevelValue where + parseJSON (Ae.Object o) = return (Object o) + parseJSON (Ae.Array a) = return (Array a) + parseJSON _ = fail "Not a valid top-level value" + +-- | Converts the given 'Ae.ToJSON' instance to a 'TopLevelValue' as long as its +-- 'Ae.Value' representation is one of 'Ae.Object' or 'Ae.Array', otherwise +-- 'Nothing'. Remember that 'Ae.Value' itself is a 'Ae.ToJSON' instance. +toTopLevelValue :: Ae.ToJSON a => a -> Maybe TopLevelValue +toTopLevelValue = \a -> + case Ae.toJSON a of + Ae.Object x -> Just (Object x) + Ae.Array x -> Just (Array x) + _ -> Nothing +{-# INLINABLE toTopLevelValue #-} + +-------------------------------------------------------------------------------- +-- $encoding +-- +-- There are two different JSON encoding facilities exported by this module, and +-- choosing between them is easy: If you need to interleave JSON encoding +-- with other stream effects you must use 'encode', otherwise you may use the +-- simpler 'encodeD'. +-- +-- Both encoding proxies enforce the JSON RFC-4627 requirement that top-level +-- values are either 'Ae.Array's or 'Ae.Object's, as witnessed by the +-- 'TopLevelValue' type. However, if you need to ignore this requirement you may +-- use the similar encoding proxies exported by the "Control.Proxy.Aeson.Unsafe" +-- module. + +-- | Encodes the given 'TopLevelValue' as JSON and sends it downstream, possibly +-- in more than one 'BS.ByteString' chunk. +encode :: (P.Proxy p, Monad m) => TopLevelValue -> p x' x () B.ByteString m () +encode = U.encode +{-# INLINABLE encode #-} + +-- | Encodes 'TopLevelValue's flowing downstream as JSON, each in possibly more +-- than one 'BS.ByteString' chunk, and sends each chunk downstream. +encodeD :: (P.Proxy p, Monad m) => () -> P.Pipe p TopLevelValue B.ByteString m r +encodeD = U.encodeD +{-# INLINABLE encodeD #-} + +-------------------------------------------------------------------------------- +-- $decoding +-- +-- Decoding a JSON value as a Haskell type in involves two different steps: +-- +-- * Parsing a raw JSON 'B.ByteString' into a 'TopLevelValue'. +-- +-- * Converting the obtained 'TopLevelValue' to the desired type, which must be +-- a 'Ae.FromJSON' instance. +-- +-- Any of those steps can fail, and in case of errors, the 'I.DecodingError' +-- type explicitly states at which the step the error happened. +-- +-- There are two different JSON decoding facilities exported by this module, +-- both perform those steps at once. Choosing between them is easy: If you +-- need to interleave JSON decoding with other stream effects you must use +-- 'decode', otherwise you may use the simpler 'decodeD'. +-- +-- These proxies use the 'P.EitherP' proxy transformer to report decoding +-- errors, you might use any of the facilities exported by +-- "Control.Proxy.Trans.Either" to recover from them. +-- +-- If you prefer to perform each of the decoding steps separately, you +-- could use instead the 'parseValue', 'parseValueD', 'fromValue' or +-- 'fromValueD' proxies. + + +-- | Decodes one JSON value flowing downstream. +-- +-- * In case of decoding errors, a 'I.DecodingError' exception is thrown in +-- the 'Pe.EitherP' proxy transformer. +-- +-- * Requests more input from upstream using 'Pa.draw' when needed. +-- +-- * /Do not/ use this proxy if your stream has leading empty chunks or +-- whitespace, otherwise you may get unexpected parsing errors. +-- +-- Here is an example parsing loop that allows interleaving stream effects +-- together with 'decode': +-- +-- @ +-- loop = do +-- -- Skip any leading whitespace and check that we haven't reached EOF. +-- eof <- 'P.liftP' $ 'Control.Proxy.ByteString.dropWhile' 'Data.Char.isSpace' >> 'PA.isEndOfParserInput' +-- 'unless' eof $ do +-- -- 1. Possibly perform some stream effects here. +-- -- 2. Decode one JSON element from the stream. +-- exampleElement <- 'decode' +-- -- 3. Do something with exampleElement and possibly perform +-- -- some more stream effects. +-- -- 4. Start all over again. +-- loop +-- @ +decode + :: (Monad m, P.Proxy p, Ae.FromJSON r) + => P.EitherP I.DecodingError (P.StateP [B.ByteString] p) + () (Maybe B.ByteString) y' y m r +decode = do + ev <- P.liftP . P.runEitherP $ PA.parse Ae.json' + case ev of + Left e -> P.throw (I.ParserError e) + Right v -> + case Ae.fromJSON v of + Ae.Error e -> P.throw (I.ValueError e) + Ae.Success r -> return r +{-# INLINABLE decode #-} + + +-- | Decodes consecutive JSON values flowing downstream until end of input. +-- +-- * In case of decoding errors, a 'I.DecodingError' exception is thrown in +-- the 'Pe.EitherP' proxy transformer. +-- +-- * Requests more input from upstream using 'Pa.draw' when needed. +-- +-- * Empty input chunks flowing downstream and whitespace in between JSON +-- values will be discarded. +decodeD + :: (Monad m, P.Proxy p, Ae.FromJSON b) + => () + -> P.Pipe (P.EitherP I.DecodingError (P.StateP [B.ByteString] p)) + (Maybe B.ByteString) b m () +decodeD = \() -> loop where + loop = do + eof <- P.liftP $ I.skipSpace >> PA.isEndOfParserInput + unless eof $ decode >>= P.respond >> loop +{-# INLINABLE decodeD #-} + +-------------------------------------------------------------------------------- + +-- | Parses a JSON value flowing downstream into a 'TopLevelValue'. +-- +-- * In case of parsing errors, a 'PA.ParsingError' exception is thrown in +-- the 'Pe.EitherP' proxy transformer. +-- +-- * Requests more input from upstream using 'Pa.draw' when needed. +-- +-- * /Do not/ use this proxy if your stream has leading empty chunks or +-- whitespace, otherwise you may get unexpected parsing errors. +-- +-- See the documentation of 'decode' for an example of how to interleave +-- other stream effects together with this proxy. +parseValue + :: (Monad m, P.Proxy p) + => P.EitherP PA.ParsingError (P.StateP [B.ByteString] p) + () (Maybe B.ByteString) y' y m TopLevelValue +parseValue = return . fromJust . toTopLevelValue =<< PA.parse Ae.json' +{-# INLINABLE parseValue #-} + + +-- | Parses consecutive JSON values flowing downstream as 'TopLevelValue's, +-- until end of input. +-- +-- * In case of parsing errors, a 'I.DecodingError' exception is thrown in +-- the 'Pe.EitherP' proxy transformer. +-- +-- * Requests more input from upstream using 'Pa.draw' when needed. +-- +-- * Empty input chunks flowing downstream and whitespace in between JSON +-- values will be discarded. +parseValueD + :: (Monad m, P.Proxy p) + => () + -> P.Pipe (P.EitherP PA.ParsingError (P.StateP [B.ByteString] p)) + (Maybe B.ByteString) TopLevelValue m () +parseValueD = \() -> loop where + loop = do + eof <- P.liftP $ I.skipSpace >> PA.isEndOfParserInput + unless eof $ parseValue >>= P.respond >> loop +{-# INLINABLE parseValueD #-} + +-------------------------------------------------------------------------------- + +-- | Converts any 'Ae.Value' flowing downstream to a 'Ae.FromJSON' instance. +-- +-- * In case of parsing errors, a 'String' exception holding the value provided +-- by Aeson's 'Ae.Error' is thrown in the 'Pe.EitherP' proxy transformer. +-- +-- See the documentation of 'decode' for an example of how to interleave +-- other stream effects together with this proxy. +fromValue + :: (Monad m, P.Proxy p, Ae.FromJSON r) + => x -> P.EitherP String p x Ae.Value y' y m r +fromValue = \x -> do + v <- P.request x + case Ae.fromJSON v of + Ae.Error e -> P.throw e + Ae.Success r -> return r +{-# INLINABLE fromValue #-} + + +-- | Converts any 'Ae.Value's flowing downstream to 'Ae.FromJSON' instances and +-- forwards them downstream. +-- +-- * In case of parsing errors, a 'String' exception holding the value provided +-- by Aeson's 'Ae.Error' is thrown in the 'Pe.EitherP' proxy transformer. +fromValueD + :: (Monad m, P.Proxy p, Ae.FromJSON b) + => x -> P.EitherP String p x Ae.Value x b m r +fromValueD = fromValue P.\>\ P.pull +{-# INLINABLE fromValueD #-} + diff --git a/src/Control/Proxy/Aeson/Internal.hs b/src/Control/Proxy/Aeson/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Control/Proxy/Aeson/Internal.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +-- | This module provides internal utilities and it is likely +-- to be modified in backwards-incompatible ways in the future. +-- +-- Use the stable API exported by the "Control.Proxy.Aeson" module instead. +module Control.Proxy.Aeson.Internal + ( DecodingError(..) + , skipSpace + , fromLazy + ) where + +import qualified Control.Proxy.Attoparsec as PA +import qualified Control.Proxy.Trans.State as P +import Control.Exception (Exception) +import qualified Control.Proxy as P +import qualified Control.Proxy.Parse as Pp +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy.Internal as BLI +import qualified Data.Char as Char +import Data.Data (Data, Typeable) +import Data.Function (fix) + +-------------------------------------------------------------------------------- + +-- | 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 + -- 'Data.Aeson.Error'. + deriving (Show, Eq, Data, Typeable) + +instance Exception DecodingError + +-------------------------------------------------------------------------------- +-- 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, P.Proxy p) + => P.StateP [B.ByteString] p () (Maybe B.ByteString) y' y m () +skipSpace = fix $ \loop -> do + ma <- Pp.draw + case ma of + Nothing -> return () + Just a -> do + let a' = B.dropWhile Char.isSpace a + if B.null a' + then loop + else Pp.unDraw a' +{-# INLINABLE skipSpace #-} + +-- Sends each of the 'BLI.ByteString''s strict chunks downstream. +fromLazy + :: (Monad m, P.Proxy p) + => BLI.ByteString -> p x' x y' B.ByteString m () +fromLazy = + P.runIdentityP . BLI.foldrChunks (\e a -> P.respond e >> a) (return ()) +{-# INLINABLE fromLazy #-} diff --git a/src/Control/Proxy/Aeson/Unsafe.hs b/src/Control/Proxy/Aeson/Unsafe.hs new file mode 100644 --- /dev/null +++ b/src/Control/Proxy/Aeson/Unsafe.hs @@ -0,0 +1,103 @@ +-- | This module exports facilities similar to those exported by the +-- "Control.Proxy.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 Control.Proxy.Aeson.Unsafe + (-- * Encoding + -- $encoding + encode + , encodeD + -- * Decoding + -- $decoding + , decode + , decodeD + -- ** Lower level parsing + , parseValue + , parseValueD + -- * Types + , I.DecodingError(..) + ) where + +import Control.Monad (unless) +import qualified Control.Proxy as P +import qualified Control.Proxy.Aeson.Internal as I +import qualified Control.Proxy.Attoparsec as PA +import qualified Control.Proxy.Trans.Either as P +import qualified Control.Proxy.Trans.State as P +import qualified Data.Aeson as Ae +import qualified Data.Aeson.Parser as Ae (value') +import qualified Data.ByteString.Char8 as B + +-------------------------------------------------------------------------------- + +-- | Like 'Control.Proxy.Aeson.encode', except it accepts any 'Ae.ToJSON' +-- instance. +encode + :: (P.Proxy p, Monad m, Ae.ToJSON a) => a -> p x' x () B.ByteString m () +encode = I.fromLazy . Ae.encode +{-# INLINABLE encode #-} + +-- | Like 'Control.Proxy.Aeson.encodeD', except it accepts any 'Ae.ToJSON' +-- instance. +encodeD + :: (P.Proxy p, Monad m, Ae.ToJSON a) => () -> P.Pipe p a B.ByteString m r +encodeD = P.pull P./>/ encode +{-# INLINABLE encodeD #-} + +-------------------------------------------------------------------------------- + +-- | Like 'Control.Proxy.Aeson.decode', except it will decode any 'Ae.ToJSON' +-- instance. +decode + :: (Monad m, P.Proxy p, Ae.FromJSON r) + => P.EitherP I.DecodingError (P.StateP [B.ByteString] p) + () (Maybe B.ByteString) y' y m r +decode = do + ev <- P.liftP . P.runEitherP $ PA.parse Ae.value' + case ev of + Left e -> P.throw (I.ParserError e) + Right v -> + case Ae.fromJSON v of + Ae.Error e -> P.throw (I.ValueError e) + Ae.Success r -> return r +{-# INLINABLE decode #-} + +-- | Like 'Control.Proxy.Aeson.decodeD', except it will decode any 'Ae.ToJSON' +-- instance. +decodeD + :: (Monad m, P.Proxy p, Ae.FromJSON b) + => () + -> P.Pipe (P.EitherP I.DecodingError (P.StateP [B.ByteString] p)) + (Maybe B.ByteString) b m () +decodeD = \() -> loop where + loop = do + eof <- P.liftP $ I.skipSpace >> PA.isEndOfParserInput + unless eof $ decode >>= P.respond >> loop +{-# INLINABLE decodeD #-} + +-------------------------------------------------------------------------------- + +-- | Like 'Control.Proxy.Aeson.parseValue', except it will parse into any +-- 'Ae.Value'. +parseValue + :: (Monad m, P.Proxy p) + => P.EitherP PA.ParsingError (P.StateP [B.ByteString] p) + () (Maybe B.ByteString) y' y m Ae.Value +parseValue = PA.parse Ae.value' +{-# INLINABLE parseValue #-} + +-- | Like 'Control.Proxy.Aeson.parseValueD', except it will parse into any +-- 'Ae.Value'. +parseValueD + :: (Monad m, P.Proxy p) + => () + -> P.Pipe (P.EitherP PA.ParsingError (P.StateP [B.ByteString] p)) + (Maybe B.ByteString) Ae.Value m () +parseValueD = \() -> loop where + loop = do + eof <- P.liftP $ I.skipSpace >> PA.isEndOfParserInput + unless eof $ parseValue >>= P.respond >> loop +{-# INLINABLE parseValueD #-} +