{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} -- | 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 "Pipes.Aeson" module instead. module Pipes.Aeson.Internal ( DecodingError(..) , consecutively , skipSpace , fromLazy ) where import Control.Exception (Exception) import qualified Control.Monad.Trans.Error as E 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 Data.Data (Data, Typeable) import Pipes import qualified Pipes.Attoparsec as PA import qualified Pipes.Parse as Pp import qualified Pipes.Lift as P -------------------------------------------------------------------------------- -- | 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 instance E.Error DecodingError instance Monad m => E.Error (DecodingError, Producer a m r) -------------------------------------------------------------------------------- -- | Consecutively parse 'b' 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. 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 {-# 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 #-} -- 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 #-}