binary-ext 2.0 → 2.0.1
raw patch · 16 files changed
+313/−267 lines, 16 filesdep ~basedep ~conduit
Dependency ranges changed: base, conduit
Files
- binary-ext.cabal +91/−96
- src/Control/Monad/Error/Map.hs +1/−1
- src/Data/Conduit/Parsers.hs +6/−6
- src/Data/Conduit/Parsers/Binary/ByteOffset.hs +0/−10
- src/Data/Conduit/Parsers/Binary/Get.hs +41/−41
- src/Data/Conduit/Parsers/Binary/Put.hs +1/−1
- src/Data/Conduit/Parsers/GetC.hs +75/−70
- src/Data/Conduit/Parsers/PutS.hs +6/−4
- src/Data/Conduit/Parsers/Text/Gen.hs +18/−4
- src/Data/Conduit/Parsers/Text/Parser.hs +11/−11
- src/Data/Conduit/Parsers/Text/TextOffset.hs +1/−1
- test/Data/Conduit/Parsers/Binary/Get/Spec.hs +20/−20
- test/Data/Conduit/Parsers/Binary/Put/Spec.hs +1/−1
- test/Data/Conduit/Parsers/Text/Gen/Spec.hs +38/−0
- test/Data/Conduit/Parsers/Text/Parser/Spec.hs +1/−1
- test/Spec.hs +2/−0
binary-ext.cabal view
@@ -1,104 +1,99 @@-name: binary-ext-version: 2.0-synopsis: An alternate with strong-typed errors for `Data.Binary.Get` monad from `binary` package.-description: An alternate with strong-typed errors for `Data.Binary.Get` monad from `binary` package.-homepage: https://github.com/A1-Triard/binary-ext#readme-license: Apache-license-file: LICENSE-author: Warlock <internalmike@gmail.com>-maintainer: Warlock <internalmike@gmail.com>-copyright: 2017 Warlock <internalmike@gmail.com>-category: Data, Parsing-build-type: Simple--- extra-source-files:-cabal-version: >=1.10+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 2b14ea0ba0ef4c6bc5bea0c2bf4b212481d986cb9267ece31ab81e2b88c012b2 +name: binary-ext+version: 2.0.1+synopsis: An alternate with strong-typed errors for `Data.Binary.Get` monad from `binary` package.+description: An alternate with strong-typed errors for `Data.Binary.Get` monad from `binary` package.+category: Data, Parsing+homepage: https://github.com/A1-Triard/binary-ext#readme+bug-reports: https://github.com/A1-Triard/binary-ext/issues+author: Warlock <internalmike@gmail.com>+maintainer: Warlock <internalmike@gmail.com>+copyright: 2017, 2018 Warlock <internalmike@gmail.com>+license: Apache+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10++source-repository head+ type: git+ location: https://github.com/A1-Triard/binary-ext+ library- hs-source-dirs: src- exposed-modules: Control.Monad.Error.Map- , Data.Conduit.Parsers- , Data.Conduit.Parsers.GetC- , Data.Conduit.Parsers.PutS- , Data.Conduit.Parsers.Binary- , Data.Conduit.Parsers.Binary.ByteOffset- , Data.Conduit.Parsers.Binary.Get- , Data.Conduit.Parsers.Binary.Put- , Data.Conduit.Parsers.Text- , Data.Conduit.Parsers.Text.Gen- , Data.Conduit.Parsers.Text.Parser- , Data.Conduit.Parsers.Text.TextOffset- build-depends: base >= 4.7 && < 5- , attoparsec- , binary- , bytestring- , conduit >= 1.2.12- , conduit-combinators- , data-binary-ieee754- , errors- , exceptions- , monad-control- , monad-loops- , mono-traversable- , mtl- , scientific- , text- , transformers- , transformers-base- default-extensions: BangPatterns- , FlexibleContexts- , FlexibleInstances- , FunctionalDependencies- , GeneralizedNewtypeDeriving- , MultiParamTypeClasses- , StandaloneDeriving- , RankNTypes- , TupleSections- , TypeFamilies- , UndecidableInstances- ghc-options: -fmax-pmcheck-iterations=100000000 -Wall -fprint-potential-instances -fsimpl-tick-factor=110+ exposed-modules:+ Control.Monad.Error.Map+ Data.Conduit.Parsers+ Data.Conduit.Parsers.Binary+ Data.Conduit.Parsers.Binary.ByteOffset+ Data.Conduit.Parsers.Binary.Get+ Data.Conduit.Parsers.Binary.Put+ Data.Conduit.Parsers.GetC+ Data.Conduit.Parsers.PutS+ Data.Conduit.Parsers.Text+ Data.Conduit.Parsers.Text.Gen+ Data.Conduit.Parsers.Text.Parser+ Data.Conduit.Parsers.Text.TextOffset+ other-modules:+ Paths_binary_ext+ hs-source-dirs:+ src+ default-extensions: BangPatterns FlexibleContexts FlexibleInstances FunctionalDependencies GeneralizedNewtypeDeriving MultiParamTypeClasses StandaloneDeriving RankNTypes TupleSections TypeFamilies UndecidableInstances+ ghc-options: -fmax-pmcheck-iterations=100000000 -Wall -fno-warn-unused-imports -fprint-potential-instances -fsimpl-tick-factor=110+ build-depends:+ attoparsec+ , base >=4.7 && <5+ , binary+ , bytestring+ , conduit >=1.3.0+ , conduit-combinators+ , data-binary-ieee754+ , errors+ , exceptions+ , monad-control+ , monad-loops+ , mono-traversable+ , mtl+ , scientific+ , text+ , transformers+ , transformers-base default-language: Haskell2010 test-suite binary-ext-test type: exitcode-stdio-1.0- hs-source-dirs: test main-is: Spec.hs- other-modules: Data.Conduit.Parsers.Binary.Get.Spec- , Data.Conduit.Parsers.Binary.Put.Spec- , Data.Conduit.Parsers.Text.Parser.Spec- build-depends: base- , HUnit- , binary-ext- , attoparsec- , binary- , bytestring- , conduit >= 1.2.12- , conduit-combinators- , data-binary-ieee754- , errors- , exceptions- , monad-control- , monad-loops- , mono-traversable- , mtl- , scientific- , text- , transformers- , transformers-base- default-extensions: BangPatterns- , FlexibleContexts- , FlexibleInstances- , FunctionalDependencies- , GeneralizedNewtypeDeriving- , MultiParamTypeClasses- , OverloadedStrings- , StandaloneDeriving- , RankNTypes- , TupleSections- , TypeFamilies- , UndecidableInstances- ghc-options: -threaded -rtsopts -with-rtsopts=-N -fmax-pmcheck-iterations=100000000 -Wall -fprint-potential-instances -fsimpl-tick-factor=110+ other-modules:+ Data.Conduit.Parsers.Binary.Get.Spec+ Data.Conduit.Parsers.Binary.Put.Spec+ Data.Conduit.Parsers.Text.Gen.Spec+ Data.Conduit.Parsers.Text.Parser.Spec+ Paths_binary_ext+ hs-source-dirs:+ test+ default-extensions: BangPatterns FlexibleContexts FlexibleInstances FunctionalDependencies GeneralizedNewtypeDeriving MultiParamTypeClasses StandaloneDeriving RankNTypes TupleSections TypeFamilies UndecidableInstances OverloadedStrings+ ghc-options: -fmax-pmcheck-iterations=100000000 -Wall -fno-warn-unused-imports -fprint-potential-instances -fsimpl-tick-factor=110 -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ HUnit+ , attoparsec+ , base >=4.7 && <5+ , binary+ , binary-ext+ , bytestring+ , conduit >=1.3.0+ , conduit-combinators+ , data-binary-ieee754+ , errors+ , exceptions+ , monad-control+ , monad-loops+ , mono-traversable+ , mtl+ , scientific+ , text+ , transformers+ , transformers-base default-language: Haskell2010--source-repository head- type: git- location: https://github.com/A1-Triard/binary-ext
src/Control/Monad/Error/Map.hs view
@@ -48,7 +48,7 @@ mapError f = ExceptT . (mapError f <$>) . runExceptT {-# INLINE mapError #-} -instance MonadMapError e m_e e' m_e' => MonadMapError e (ConduitM i o m_e) e' (ConduitM i o m_e') where+instance MonadMapError e m_e e' m_e' => MonadMapError e (ConduitT i o m_e) e' (ConduitT i o m_e') where mapError f = transPipe (mapError f) {-# INLINE mapError #-}
src/Data/Conduit/Parsers.hs view
@@ -53,12 +53,12 @@ {-# INLINE decodingElemsRead #-} -- | Get the total number of bytes read to this point.-elemsRead :: (DecodingState s, DecodingElemsRead s, Monad m) => GetM s i o e m Word64+elemsRead :: (DecodingState s, DecodingElemsRead s, Monad m) => GetT s i o e m Word64 elemsRead = getC $ \ !x -> return (Right $ decodingElemsRead x, x) {-# INLINE elemsRead #-} -- | Skip ahead @n@ bytes. Fails if fewer than @n@ bytes are available.-skip :: (DecodingState s, Chunk (DecodingToken s), Monad m) => Word64 -> GetM s (DecodingToken s) o () m ()+skip :: (DecodingState s, Chunk (DecodingToken s), Monad m) => Word64 -> GetT s (DecodingToken s) o () m () skip !n = getC $ go 0 where@@ -86,8 +86,8 @@ -- offset from 'bytesRead' will NOT be relative to the start of @isolate@. isolate :: (DecodingState s, Chunk (DecodingToken s), DecodingElemsRead s, Monad m) => Word64 -- ^ The number of bytes that must be consumed.- -> GetM s (DecodingToken s) o e m a -- ^ The decoder to isolate.- -> GetM s (DecodingToken s) o (Either (Maybe Word64) e) m a+ -> GetT s (DecodingToken s) o e m a -- ^ The decoder to isolate.+ -> GetT s (DecodingToken s) o (Either (Maybe Word64) e) m a isolate !n !g = do !o1 <- elemsRead !r <- getC $ flip runStateC $ runExceptC $ fuseLeftovers id (go 0) (exceptC $ stateC $ flip runGetC $ mapError Right g)@@ -112,12 +112,12 @@ yield h {-# INLINE isolate #-} -endOfInput :: (DecodingState s, MonoFoldable (DecodingToken s), Monad m) => GetM s (DecodingToken s) o () m ()+endOfInput :: (DecodingState s, MonoFoldable (DecodingToken s), Monad m) => GetT s (DecodingToken s) o () m () endOfInput = do end <- N.nullE if end then return () else throwError () {-# INLINE endOfInput #-} -matchP :: (DecodingState s, Monoid (DecodingToken s), Monad m) => GetM s (DecodingToken s) o e m a -> GetM s (DecodingToken s) o e m (DecodingToken s, a)+matchP :: (DecodingState s, Monoid (DecodingToken s), Monad m) => GetT s (DecodingToken s) o e m a -> GetT s (DecodingToken s) o e m (DecodingToken s, a) matchP !p = (\(!t, !r) -> (foldl (flip mappend) mempty t, r)) <$> mapError snd (trackP p) {-# INLINE matchP #-}
src/Data/Conduit/Parsers/Binary/ByteOffset.hs view
@@ -14,16 +14,6 @@ -- limitations under the License. -- --- | At the first look, Data.Binary.Conduit.Get module is very similar with Data.Binary.Get.--- The main differences between them are the following.--- While the 'S.Get' from binary is a very custom monad,--- the local 'Get' is 'ConduitM', which leads to easy integration in complicated format parsing.--- The Data.Binary.Get module does not have a function to create custom 'S.Get' monad,--- this module provides 'getC'.--- Unlike 'isolate' from binary, local 'isolate' does not "cut" bytes counter.--- While the binary's 'S.Get' is 'MonadFail', which leads to very ugly errors handling--- in complicated cases, local 'Get' is 'MonadError'.- module Data.Conduit.Parsers.Binary.ByteOffset ( ByteOffset (..) ) where
src/Data/Conduit/Parsers/Binary/Get.hs view
@@ -17,7 +17,7 @@ -- | At the first look, Data.Binary.Conduit.Get module is very similar with Data.Binary.Get. -- The main differences between them are the following. -- While the 'S.Get' from binary is a very custom monad,--- the local 'Get' is 'ConduitM', which leads to easy integration in complicated format parsing.+-- the local 'Get' is 'ConduitT', which leads to easy integration in complicated format parsing. -- The Data.Binary.Get module does not have a function to create custom 'S.Get' monad, -- this module provides 'getC'. -- Unlike 'isolate' from binary, local 'isolate' does not "cut" bytes counter.@@ -29,7 +29,7 @@ , (?=>>) , (?>>) , DefaultDecodingState- , GetM+ , GetT , Get , runGet , bytesRead@@ -93,23 +93,23 @@ instance (DecodingState s, DecodingToken s ~ S.ByteString, DecodingElemsRead s) => DefaultDecodingState s where --- | The shortening of 'GetM' for the most common use case.-type Get e a = forall s o m. (DefaultDecodingState s, Monad m) => GetM s S.ByteString o e m a+-- | The shortening of 'GetT' for the most common use case.+type Get e a = forall s o m. (DefaultDecodingState s, Monad m) => GetT s S.ByteString o e m a -- | Run a decoder presented as a 'Get' monad. -- Returns decoder result and consumed bytes count.-runGet :: Monad m => GetM ByteOffset i o e m a -> ConduitM i o m (Either e a)+runGet :: Monad m => GetT ByteOffset i o e m a -> ConduitT i o m (Either e a) runGet !g = fst <$> runGetC (startDecoding $ ByteOffset 0) g {-# INLINE runGet #-} -- | Get the total number of bytes read to this point.-bytesRead :: (DecodingState s, DecodingElemsRead s, Monad m) => GetM s i o e m Word64+bytesRead :: (DecodingState s, DecodingElemsRead s, Monad m) => GetT s i o e m Word64 bytesRead = elemsRead {-# INLINE bytesRead #-} -- | Run the given 'S.Get' monad from binary package -- and convert result into 'Get'.-castGet :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => S.Get a -> GetM s S.ByteString o String m a+castGet :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => S.Get a -> GetT s S.ByteString o String m a castGet !g = getC $ go (S.runGetIncremental g) SB.empty where@@ -123,13 +123,13 @@ go (continue next) (fromMaybe SB.empty next) (decoded chunk decoding) {-# INLINE castGet #-} -voidError :: Monad m => GetM s i o e m a -> GetM s i o () m a+voidError :: Monad m => GetT s i o e m a -> GetT s i o () m a voidError = mapError (const ()) {-# INLINE voidError #-} -- | An efficient get method for strict 'S.ByteString's. Fails if fewer than @n@ -- bytes are left in the input. If @n <= 0@ then the empty string is returned.-getByteString :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => Int -> GetM s S.ByteString o () m S.ByteString+getByteString :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => Int -> GetT s S.ByteString o () m S.ByteString getByteString !n = getC $ go SB.empty 0 where@@ -152,7 +152,7 @@ -- | An efficient get method for lazy 'ByteString's. Fails if fewer than @n@ -- bytes are left in the input. If @n <= 0@ then the empty string is returned.-getLazyByteString :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => Int64 -> GetM s S.ByteString o () m ByteString+getLazyByteString :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => Int64 -> GetT s S.ByteString o () m ByteString getLazyByteString n = getC $ go B.empty 0 where@@ -176,7 +176,7 @@ -- | Get a lazy 'ByteString' that is terminated with a NUL byte. -- The returned string does not contain the NUL byte. -- Fails if it reaches the end of input without finding a NUL.-getLazyByteStringNul :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m ByteString+getLazyByteStringNul :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m ByteString getLazyByteStringNul = getC $ go B.empty where@@ -199,7 +199,7 @@ -- | Get the remaining bytes as a lazy 'ByteString'. -- Note that this can be an expensive function to use as it -- forces reading all input and keeping the string in-memory.-getRemainingLazyByteString :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o e m ByteString+getRemainingLazyByteString :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o e m ByteString getRemainingLazyByteString = getC $ go B.empty where@@ -209,148 +209,148 @@ Nothing -> return (Right consumed, decoding) Just !i -> go (consumed <> B.fromStrict i) (decoded i decoding) -voidCastGet :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => S.Get a -> GetM s S.ByteString o () m a+voidCastGet :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => S.Get a -> GetT s S.ByteString o () m a voidCastGet = voidError . castGet {-# INLINE voidCastGet #-} -- | Read a 'Word8' from the monad state.-getWord8 :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Word8+getWord8 :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word8 getWord8 = voidCastGet S.getWord8 {-# INLINE getWord8 #-} -- | Read an 'Int8' from the monad state.-getInt8 :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Int8+getInt8 :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int8 getInt8 = voidCastGet S.getInt8 {-# INLINE getInt8 #-} -- | Read a 'Word16' in big endian format.-getWord16be :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Word16+getWord16be :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word16 getWord16be = voidCastGet S.getWord16be {-# INLINE getWord16be #-} -- | Read a 'Word32' in big endian format.-getWord32be :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Word32+getWord32be :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word32 getWord32be = voidCastGet S.getWord32be {-# INLINE getWord32be #-} -- | Read a 'Word64' in big endian format.-getWord64be :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Word64+getWord64be :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word64 getWord64be = voidCastGet S.getWord64be {-# INLINE getWord64be #-} -- | Read a 'Word16' in little endian format.-getWord16le :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Word16+getWord16le :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word16 getWord16le = voidCastGet S.getWord16le {-# INLINE getWord16le #-} -- | Read a 'Word32' in little endian format.-getWord32le :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Word32+getWord32le :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word32 getWord32le = voidCastGet S.getWord32le {-# INLINE getWord32le #-} -- | Read a 'Word64' in little endian format.-getWord64le :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Word64+getWord64le :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word64 getWord64le = voidCastGet S.getWord64le {-# INLINE getWord64le #-} -- | Read a single native machine word. The word is read in -- host order, host endian form, for the machine you're on. On a 64 bit -- machine the Word is an 8 byte value, on a 32 bit machine, 4 bytes.-getWordhost :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Word+getWordhost :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word getWordhost = voidCastGet S.getWordhost {-# INLINE getWordhost #-} -- | Read a 2 byte 'Word16' in native host order and host endianness.-getWord16host :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Word16+getWord16host :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word16 getWord16host = voidCastGet S.getWord16host {-# INLINE getWord16host #-} -- | Read a 4 byte 'Word32' in native host order and host endianness.-getWord32host :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Word32+getWord32host :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word32 getWord32host = voidCastGet S.getWord32host {-# INLINE getWord32host #-} -- | Read a 8 byte 'Word64' in native host order and host endianness.-getWord64host :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Word64+getWord64host :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Word64 getWord64host = voidCastGet S.getWord64host {-# INLINE getWord64host #-} -- | Read an 'Int16' in big endian format.-getInt16be :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Int16+getInt16be :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int16 getInt16be = voidCastGet S.getInt16be {-# INLINE getInt16be #-} -- | Read an 'Int32' in big endian format.-getInt32be :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Int32+getInt32be :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int32 getInt32be = voidCastGet S.getInt32be {-# INLINE getInt32be #-} -- | Read an 'Int64' in big endian format.-getInt64be :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Int64+getInt64be :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int64 getInt64be = voidCastGet S.getInt64be {-# INLINE getInt64be #-} -- | Read an 'Int16' in little endian format.-getInt16le :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Int16+getInt16le :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int16 getInt16le = voidCastGet S.getInt16le {-# INLINE getInt16le #-} -- | Read an 'Int32' in little endian format.-getInt32le :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Int32+getInt32le :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int32 getInt32le = voidCastGet S.getInt32le {-# INLINE getInt32le #-} -- | Read an 'Int64' in little endian format.-getInt64le :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Int64+getInt64le :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int64 getInt64le = voidCastGet S.getInt64le {-# INLINE getInt64le #-} -- | Read a single native machine word. It works in the same way as 'getWordhost'.-getInthost :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Int+getInthost :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int getInthost = voidCastGet S.getInthost {-# INLINE getInthost #-} -- | Read a 2 byte 'Int16' in native host order and host endianness.-getInt16host :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Int16+getInt16host :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int16 getInt16host = voidCastGet S.getInt16host {-# INLINE getInt16host #-} -- | Read a 4 byte 'Int32' in native host order and host endianness.-getInt32host :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Int32+getInt32host :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int32 getInt32host = voidCastGet S.getInt32host {-# INLINE getInt32host #-} -- | Read a 8 byte 'Int64' in native host order and host endianness.-getInt64host :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Int64+getInt64host :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Int64 getInt64host = voidCastGet S.getInt64host {-# INLINE getInt64host #-} -- | Read a 'Float' in big endian IEEE-754 format.-getFloatbe :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Float+getFloatbe :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Float getFloatbe = voidCastGet S.getFloat32be {-# INLINE getFloatbe #-} -- | Read a 'Float' in little endian IEEE-754 format.-getFloatle :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Float+getFloatle :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Float getFloatle = voidCastGet S.getFloat32le {-# INLINE getFloatle #-} -- | Read a 'Float' in IEEE-754 format and host endian.-getFloathost :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Float+getFloathost :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Float getFloathost = wordToFloat <$> voidCastGet S.getWord32host {-# INLINE getFloathost #-} -- | Read a 'Double' in big endian IEEE-754 format.-getDoublebe :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Double+getDoublebe :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Double getDoublebe = voidCastGet S.getFloat64be {-# INLINE getDoublebe #-} -- | Read a 'Double' in little endian IEEE-754 format.-getDoublele :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Double+getDoublele :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Double getDoublele = voidCastGet S.getFloat64le {-# INLINE getDoublele #-} -- | Read a 'Double' in IEEE-754 format and host endian.-getDoublehost :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetM s S.ByteString o () m Double+getDoublehost :: (DecodingState s, DecodingToken s ~ S.ByteString, Monad m) => GetT s S.ByteString o () m Double getDoublehost = wordToDouble <$> voidCastGet S.getWord64host {-# INLINE getDoublehost #-}
src/Data/Conduit/Parsers/Binary/Put.hs view
@@ -83,7 +83,7 @@ -- | Run an encoder presented as a 'Put' monad. -- Returns 'Producer'.-runPut :: PutM ByteOffset i o m () -> ConduitM i o m ()+runPut :: PutM ByteOffset i o m () -> ConduitT i o m () runPut !p = runEncoding $ snd $ runPutS p $ startEncoding $ ByteOffset 0 {-# INLINE runPut #-}
src/Data/Conduit/Parsers/GetC.hs view
@@ -24,7 +24,7 @@ , continueDecoding , decodingRead , GetC- , GetM+ , GetT , runGetC , getC , trackP@@ -97,6 +97,7 @@ startDecoding !bytes_read_before = Decoding { decodingRead = bytes_read_before, tracking = Nothing } {-# INLINE startDecoding #-} +-- | Adjust 'GetC' state. This is low-level function, not supposed to directly use. continueDecoding :: s -> [i] -> Decoding s i -> Decoding s i continueDecoding new delta old = Decoding { decodingRead = new, tracking = (delta ++) <$> tracking old } {-# INLINE continueDecoding #-}@@ -109,7 +110,7 @@ } {-# INLINE decoded #-} --- | Internal transformers for 'Get' with error type @e@, host monad @m@ and decoder result @a@.+-- | Internal transformers for 'GetT' with error type @e@, base monad @m@, and decoder result @a@. newtype GetC s i e m a = C { runC :: ExceptT e (StateT (Decoding s i) m) a } instance MonadTrans (GetC s i e) where@@ -146,23 +147,23 @@ instance Monad m => MonadMapError e (GetC s i e m) e' (GetC s i e' m) where mapError f = C . mapError f . runC --- | A 'ConduitM' with internal transformers supposed to a binary deserialization.-type GetM s i o e m = ConduitM i o (GetC s i e m)+-- | A 'ConduitT' with internal transformers supposed to a binary deserialization.+type GetT s i o e m = ConduitT i o (GetC s i e m) -instance (Monoid e, Monad m) => Alternative (GetM s i o e m) where+instance (Monoid e, Monad m) => Alternative (GetT s i o e m) where empty = throwError mempty {-# INLINE empty #-} a <|> b = catchError (tryP a) $ \ !ea -> catchError (tryP b) $ \ !eb -> throwError (ea `mappend` eb) {-# INLINE (<|>) #-} -instance (Monoid e, Monad m) => MonadPlus (GetM s i o e m) where+instance (Monoid e, Monad m) => MonadPlus (GetT s i o e m) where mzero = empty {-# INLINE mzero #-} mplus a b = a <|> b {-# INLINE mplus #-} -- | Leftover consumed input on error.-tryP :: Monad m => GetM s i o e m a -> GetM s i o e m a+tryP :: Monad m => GetT s i o e m a -> GetT s i o e m a tryP !g = getC $ \ !c -> do (!t, !d) <- runGetC (startDecoding $ decodingRead c) $ trackP g case t of@@ -171,22 +172,26 @@ {-# INLINE tryP #-} -- | Run a decoder, storing input stream.-trackP :: Monad m => GetM s i o e m a -> GetM s i o ([i], e) m ([i], a)+trackP :: Monad m => GetT s i o e m a -> GetT s i o ([i], e) m ([i], a) trackP !g = getC $ \ !c -> do (!r, !f) <- runGetC (Decoding { decodingRead = decodingRead c, tracking = Just [] }) g let !tracking_f = fromMaybe (error "Data.Conduit.Parsers.GetC.track") $ tracking f return (either (Left . (tracking_f,)) (Right . (tracking_f,)) r, Decoding { decodingRead = decodingRead f, tracking = (tracking_f ++) <$> tracking c }) {-# INLINE trackP #-} --- | Run a 'Get' monad, unwrapping all internal transformers in a reversible way.+-- | Run a 'GetT' monad, unwrapping all internal transformers in a reversible way.+-- -- @'getC' . 'flip' runGetC = 'id'@-runGetC :: Monad m => Decoding s i -> GetM s i o e m a -> ConduitM i o m (Either e a, Decoding s i)+runGetC :: Monad m => Decoding s i -> GetT s i o e m a -> ConduitT i o m (Either e a, Decoding s i) runGetC !decoding = runStateC decoding . runExceptC . transPipe runC {-# INLINE runGetC #-} --- | Custom 'Get'.+-- | Custom 'GetT'.+-- -- @getC . 'flip' 'runGetC' = 'id'@--- Example:+--+-- Example ('Data.Conduit.Parsers.Binary.Get.Get' is a shortening of 'GetT'):+-- -- > skipUntilZero :: Get e Bool -- > skipUntilZero = getC $ flip runStateC $ untilJust $ do -- > !m_inp <- await@@ -202,12 +207,12 @@ -- > leftover t -- > lift $ modify' $ decoded h -- > return $ Just $ Right True-getC :: Monad m => (Decoding s i -> ConduitM i o m (Either e a, Decoding s i)) -> GetM s i o e m a+getC :: Monad m => (Decoding s i -> ConduitT i o m (Either e a, Decoding s i)) -> GetT s i o e m a getC = transPipe C . exceptC . stateC {-# INLINE getC #-} --- | Wrap the base monad in `ExceptT`, pushing `Either` to a monad transformers stack.-exceptG :: Monad m => GetM s i o e' m (Either e a) -> GetM s i o e' (ExceptT (e, Decoding s i) m) a+-- | Wrap the base monad in 'ExceptT', pushing 'Either' to a monad transformers stack.+exceptG :: Monad m => GetT s i o e' m (Either e a) -> GetT s i o e' (ExceptT (e, Decoding s i) m) a exceptG g = getC $ \ !x -> exceptC $ ee <$> runGetC x g where@@ -217,8 +222,8 @@ ee (Left x, b) = Right (Left x, b) {-# INLINE exceptG #-} --- | Run `ExceptT` in the base monad, pulling `Either` from a monad transformers stack.-runExceptG :: Monad m => GetM s i o e' (ExceptT (e, Decoding s i) m) a -> GetM s i o e' m (Either e a)+-- | Run 'ExceptT' in the base monad, pulling 'Either' from a monad transformers stack.+runExceptG :: Monad m => GetT s i o e' (ExceptT (e, Decoding s i) m) a -> GetT s i o e' m (Either e a) runExceptG g = getC $ \ !x -> (ee <$>) $ runExceptC $ runGetC x g where@@ -229,13 +234,13 @@ {-# INLINE runExceptG #-} -- | Catch an error in the base monad.-catchExceptG :: Monad m => GetM s i o e' (ExceptT (e, Decoding s i) m) r -> (e -> GetM s i o e' (ExceptT (e, Decoding s i) m) r) -> GetM s i o e' (ExceptT (e, Decoding s i) m) r+catchExceptG :: Monad m => GetT s i o e' (ExceptT (e, Decoding s i) m) r -> (e -> GetT s i o e' (ExceptT (e, Decoding s i) m) r) -> GetT s i o e' (ExceptT (e, Decoding s i) m) r catchExceptG g c = getC $ \ !x -> catchExceptC (runGetC x g) (\(e, b) -> runGetC b (c e)) {-# INLINE catchExceptG #-} --- | Wrap the base monad in `ExceptT`, pushing `Maybe` to a monad transformers stack.-maybeG :: Monad m => GetM s i o e m (Maybe a) -> GetM s i o e (ExceptT (Decoding s i) m) a+-- | Wrap the base monad in 'ExceptT', pushing 'Maybe' to a monad transformers stack.+maybeG :: Monad m => GetT s i o e m (Maybe a) -> GetT s i o e (ExceptT (Decoding s i) m) a maybeG g = getC $ \ !x -> exceptC $ em <$> runGetC x g where@@ -245,8 +250,8 @@ em (Left e, b) = Right (Left e, b) {-# INLINE maybeG #-} --- | Run `ExceptT` in the base monad, pulling `Maybe` from a monad transformers stack.-runMaybeG :: Monad m => GetM s i o e (ExceptT (Decoding s i) m) a -> GetM s i o e m (Maybe a)+-- | Run 'ExceptT' in the base monad, pulling 'Maybe' from a monad transformers stack.+runMaybeG :: Monad m => GetT s i o e (ExceptT (Decoding s i) m) a -> GetT s i o e m (Maybe a) runMaybeG g = getC $ \ !x -> (me <$>) $ runExceptC $ runGetC x g where@@ -256,18 +261,18 @@ me (Left b) = (Right Nothing, b) {-# INLINE runMaybeG #-} --- | Wrap the base monad in `ReaderT`.-readerG :: Monad m => (r -> GetM s i o e m a) -> GetM s i o e (ReaderT r m) a+-- | Wrap the base monad in 'ReaderT'.+readerG :: Monad m => (r -> GetT s i o e m a) -> GetT s i o e (ReaderT r m) a readerG g = getC $ \ !x -> readerC $ \r -> runGetC x (g r) {-# INLINE readerG #-} --- | Run `ReaderT` in the base monad.-runReaderG :: Monad m => r -> GetM s i o e (ReaderT r m) a -> GetM s i o e m a+-- | Run 'ReaderT' in the base monad.+runReaderG :: Monad m => r -> GetT s i o e (ReaderT r m) a -> GetT s i o e m a runReaderG r g = getC $ \ !x -> runReaderC r $ runGetC x g {-# INLINE runReaderG #-} --- | Wrap the base monad in `L.StateT`.-stateLG :: Monad m => (t -> GetM s i o e m (a, t)) -> GetM s i o e (L.StateT t m) a+-- | Wrap the base monad in 'L.StateT'.+stateLG :: Monad m => (t -> GetT s i o e m (a, t)) -> GetT s i o e (L.StateT t m) a stateLG g = getC $ \ !x -> stateLC $ \t -> st <$> runGetC x (g t) where@@ -276,8 +281,8 @@ st (Left e, b) = ((Left e, b), error "stateLG") {-# INLINE stateLG #-} --- | Run `L.StateT` in the base monad.-runStateLG :: Monad m => t -> GetM s i o e (L.StateT t m) a -> GetM s i o e m (a, t)+-- | Run 'L.StateT' in the base monad.+runStateLG :: Monad m => t -> GetT s i o e (L.StateT t m) a -> GetT s i o e m (a, t) runStateLG t g = getC $ \ !x -> (ts <$>) $ runStateLC t $ runGetC x g where@@ -286,18 +291,18 @@ ts ((Left e, b), _) = (Left e, b) {-# INLINE runStateLG #-} --- | Evaluate `L.StateT` in the base monad.-evalStateLG :: Monad m => t -> GetM s i o e (L.StateT t m) a -> GetM s i o e m a+-- | Evaluate 'L.StateT' in the base monad.+evalStateLG :: Monad m => t -> GetT s i o e (L.StateT t m) a -> GetT s i o e m a evalStateLG t = (fst <$>) . runStateLG t {-# INLINE evalStateLG #-} --- | Execute `L.StateT` in the base monad.-execStateLG :: Monad m => t -> GetM s i o e (L.StateT t m) a -> GetM s i o e m t+-- | Execute 'L.StateT' in the base monad.+execStateLG :: Monad m => t -> GetT s i o e (L.StateT t m) a -> GetT s i o e m t execStateLG t = (snd <$>) . runStateLG t {-# INLINE execStateLG #-} --- | Wrap the base monad in `StateT`.-stateG :: Monad m => (t -> GetM s i o e m (a, t)) -> GetM s i o e (StateT t m) a+-- | Wrap the base monad in 'StateT'.+stateG :: Monad m => (t -> GetT s i o e m (a, t)) -> GetT s i o e (StateT t m) a stateG g = getC $ \ !x -> stateC $ \t -> st <$> runGetC x (g t) where@@ -306,8 +311,8 @@ st (Left e, b) = ((Left e, b), error "stateLG") {-# INLINE stateG #-} --- | Run `StateT` in the base monad.-runStateG :: Monad m => t -> GetM s i o e (StateT t m) a -> GetM s i o e m (a, t)+-- | Run 'StateT' in the base monad.+runStateG :: Monad m => t -> GetT s i o e (StateT t m) a -> GetT s i o e m (a, t) runStateG t g = getC $ \ !x -> (ts <$>) $ runStateC t $ runGetC x g where@@ -316,18 +321,18 @@ ts ((Left e, b), _) = (Left e, b) {-# INLINE runStateG #-} --- | Evaluate `StateT` in the base monad.-evalStateG :: Monad m => t -> GetM s i o e (StateT t m) a -> GetM s i o e m a+-- | Evaluate 'StateT' in the base monad.+evalStateG :: Monad m => t -> GetT s i o e (StateT t m) a -> GetT s i o e m a evalStateG t = (fst <$>) . runStateG t {-# INLINE evalStateG #-} --- | Execute `StateT` in the base monad.-execStateG :: Monad m => t -> GetM s i o e (StateT t m) a -> GetM s i o e m t+-- | Execute 'StateT' in the base monad.+execStateG :: Monad m => t -> GetT s i o e (StateT t m) a -> GetT s i o e m t execStateG t = (snd <$>) . runStateG t {-# INLINE execStateG #-} --- | Wrap the base monad in `L.WriterT`.-writerLG :: (Monad m, Monoid t) => GetM s i o e m (a, t) -> GetM s i o e (L.WriterT t m) a+-- | Wrap the base monad in 'L.WriterT'.+writerLG :: (Monad m, Monoid t) => GetT s i o e m (a, t) -> GetT s i o e (L.WriterT t m) a writerLG g = getC $ \ !x -> writerLC $ st <$> runGetC x g where@@ -336,8 +341,8 @@ st (Left e, b) = ((Left e, b), error "writerLG") {-# INLINE writerLG #-} --- | Run `L.WriterT` in the base monad.-runWriterLG :: (Monad m, Monoid t) => GetM s i o e (L.WriterT t m) a -> GetM s i o e m (a, t)+-- | Run 'L.WriterT' in the base monad.+runWriterLG :: (Monad m, Monoid t) => GetT s i o e (L.WriterT t m) a -> GetT s i o e m (a, t) runWriterLG g = getC $ \ !x -> (ts <$>) $ runWriterLC $ runGetC x g where@@ -346,13 +351,13 @@ ts ((Left e, b), _) = (Left e, b) {-# INLINE runWriterLG #-} --- | Execute `L.WriterT` in the base monad.-execWriterLG :: (Monad m, Monoid t) => GetM s i o e (L.WriterT t m) a -> GetM s i o e m t+-- | Execute 'L.WriterT' in the base monad.+execWriterLG :: (Monad m, Monoid t) => GetT s i o e (L.WriterT t m) a -> GetT s i o e m t execWriterLG = (snd <$>) . runWriterLG {-# INLINE execWriterLG #-} --- | Wrap the base monad in `WriterT`.-writerG :: (Monad m, Monoid t) => GetM s i o e m (a, t) -> GetM s i o e (WriterT t m) a+-- | Wrap the base monad in 'WriterT'.+writerG :: (Monad m, Monoid t) => GetT s i o e m (a, t) -> GetT s i o e (WriterT t m) a writerG g = getC $ \ !x -> writerC $ st <$> runGetC x g where@@ -361,8 +366,8 @@ st (Left e, b) = ((Left e, b), error "writerG") {-# INLINE writerG #-} --- | Run `WriterT` in the base monad.-runWriterG :: (Monad m, Monoid t) => GetM s i o e (WriterT t m) a -> GetM s i o e m (a, t)+-- | Run 'WriterT' in the base monad.+runWriterG :: (Monad m, Monoid t) => GetT s i o e (WriterT t m) a -> GetT s i o e m (a, t) runWriterG g = getC $ \ !x -> (ts <$>) $ runWriterC $ runGetC x g where@@ -371,13 +376,13 @@ ts ((Left e, b), _) = (Left e, b) {-# INLINE runWriterG #-} --- | Execute `WriterT` in the base monad.-execWriterG :: (Monad m, Monoid t) => GetM s i o e (WriterT t m) a -> GetM s i o e m t+-- | Execute 'WriterT' in the base monad.+execWriterG :: (Monad m, Monoid t) => GetT s i o e (WriterT t m) a -> GetT s i o e m t execWriterG = (snd <$>) . runWriterG {-# INLINE execWriterG #-} --- | Wrap the base monad in `L.RWST`.-rwsLG :: (Monad m, Monoid w) => (r -> t -> GetM s i o e m (a, t, w)) -> GetM s i o e (L.RWST r w t m) a+-- | Wrap the base monad in 'L.RWST'.+rwsLG :: (Monad m, Monoid w) => (r -> t -> GetT s i o e m (a, t, w)) -> GetT s i o e (L.RWST r w t m) a rwsLG g = getC $ \ !x -> rwsLC $ \r t -> st <$> runGetC x (g r t) where@@ -386,8 +391,8 @@ st (Left e, b) = ((Left e, b), error "rwsLG.s", error "rwsLG.w") {-# INLINE rwsLG #-} --- | Run `L.RWST` in the base monad.-runRWSLG :: (Monad m, Monoid w) => r -> t -> GetM s i o e (L.RWST r w t m) a -> GetM s i o e m (a, t, w)+-- | Run 'L.RWST' in the base monad.+runRWSLG :: (Monad m, Monoid w) => r -> t -> GetT s i o e (L.RWST r w t m) a -> GetT s i o e m (a, t, w) runRWSLG r t g = getC $ \ !x -> (ts <$>) $ runRWSLC r t $ runGetC x g where@@ -396,24 +401,24 @@ ts ((Left e, b), _, _) = (Left e, b) {-# INLINE runRWSLG #-} --- | Evaluate `L.RWST` in the base monad.-evalRWSLG :: (Monad m, Monoid w) => r -> t -> GetM s i o e (L.RWST r w t m) a -> GetM s i o e m (a, w)+-- | Evaluate 'L.RWST' in the base monad.+evalRWSLG :: (Monad m, Monoid w) => r -> t -> GetT s i o e (L.RWST r w t m) a -> GetT s i o e m (a, w) evalRWSLG r t = (res <$>) . runRWSLG r t where res (a, _, b) = (a, b) {-# INLINE evalRWSLG #-} --- | Execute `L.RWST` in the base monad.-execRWSLG :: (Monad m, Monoid w) => r -> t -> GetM s i o e (L.RWST r w t m) a -> GetM s i o e m (t, w)+-- | Execute 'L.RWST' in the base monad.+execRWSLG :: (Monad m, Monoid w) => r -> t -> GetT s i o e (L.RWST r w t m) a -> GetT s i o e m (t, w) execRWSLG r t = (res <$>) . runRWSLG r t where res (_, a, b) = (a, b) {-# INLINE execRWSLG #-} --- | Wrap the base monad in `RWST`.-rwsG :: (Monad m, Monoid w) => (r -> t -> GetM s i o e m (a, t, w)) -> GetM s i o e (RWST r w t m) a+-- | Wrap the base monad in 'RWST'.+rwsG :: (Monad m, Monoid w) => (r -> t -> GetT s i o e m (a, t, w)) -> GetT s i o e (RWST r w t m) a rwsG g = getC $ \ !x -> rwsC $ \r t -> st <$> runGetC x (g r t) where@@ -422,8 +427,8 @@ st (Left e, b) = ((Left e, b), error "rwsG.s", error "rwsG.w") {-# INLINE rwsG #-} --- | Run `RWST` in the base monad.-runRWSG :: (Monad m, Monoid w) => r -> t -> GetM s i o e (RWST r w t m) a -> GetM s i o e m (a, t, w)+-- | Run 'RWST' in the base monad.+runRWSG :: (Monad m, Monoid w) => r -> t -> GetT s i o e (RWST r w t m) a -> GetT s i o e m (a, t, w) runRWSG r t g = getC $ \ !x -> (ts <$>) $ runRWSC r t $ runGetC x g where@@ -432,16 +437,16 @@ ts ((Left e, b), _, _) = (Left e, b) {-# INLINE runRWSG #-} --- | Evaluate `RWST` in the base monad.-evalRWSG :: (Monad m, Monoid w) => r -> t -> GetM s i o e (RWST r w t m) a -> GetM s i o e m (a, w)+-- | Evaluate 'RWST' in the base monad.+evalRWSG :: (Monad m, Monoid w) => r -> t -> GetT s i o e (RWST r w t m) a -> GetT s i o e m (a, w) evalRWSG r t = (res <$>) . runRWSG r t where res (a, _, b) = (a, b) {-# INLINE evalRWSG #-} --- | Execute `RWST` in the base monad.-execRWSG :: (Monad m, Monoid w) => r -> t -> GetM s i o e (RWST r w t m) a -> GetM s i o e m (t, w)+-- | Execute 'RWST' in the base monad.+execRWSG :: (Monad m, Monoid w) => r -> t -> GetT s i o e (RWST r w t m) a -> GetT s i o e m (t, w) execRWSG r t = (res <$>) . runRWSG r t where
src/Data/Conduit/Parsers/PutS.hs view
@@ -37,10 +37,12 @@ import Data.String import qualified Data.Text as S (Text) +-- | Collects encoding process feedback. class EncodingState s where type EncodingToken s :: * encoded :: EncodingToken s -> s -> s +-- | Trivial encoding state. data VoidEncodingState = VoidEncodingState instance EncodingState VoidEncodingState where@@ -48,7 +50,7 @@ encoded () = id {-# INLINE encoded #-} --- | 'PutS' functor state.+-- | 'PutS' monad state. data Encoding s m = Encoding { encodingWrote :: !s -- ^ Get the total number of bytes wrote to this point. , runEncoding :: !(m ()) -- ^ Get the 'Producer'.@@ -70,7 +72,7 @@ } {-# INLINE startEncoding #-} --- | Wrappers for 'Put' with inner monad @m@ and result @a@ (usually @()@).+-- | Wrappers for 'PutM' with inner monad @m@ and result @a@ (usually @()@). newtype PutS s m a = S { runS :: State (Encoding s m) a } deriving instance Monad (PutS s m)@@ -82,8 +84,8 @@ a <> b = a >> b {-# INLINE (<>) #-} --- | A 'ConduitM' with wrappers supposed to a binary serialization.-type PutM s i o m a = PutS s (ConduitM i o m) a+-- | A 'ConduitT' with wrappers supposed to a binary serialization.+type PutM s i o m a = PutS s (ConduitT i o m) a instance (EncodingState s, EncodingToken s ~ (), Monad m) => IsString (PutM s i S.Text m ()) where fromString x = putS $ \ !t -> ((), encoded (yield (fromString x), ()) t)
src/Data/Conduit/Parsers/Text/Gen.hs view
@@ -14,8 +14,7 @@ -- limitations under the License. -- --- | Despite binary's 'S.Put' is fully-functional construction (unlike 'S.Get'),--- we decided to provide this module for symmetry with 'Data.Binary.Conduit.Get'.+-- | Text generator. The 'PutM' specialization for text output. module Data.Conduit.Parsers.Text.Gen ( PutM@@ -47,30 +46,35 @@ -- | The shortening of 'PutM' for the most common use case. type TextGen = forall s i m. (DefaultTextGenState s, Monad m) => PutM s i S.Text m () --- | Run an encoder presented as a 'Put' monad.+-- | Run an encoder presented as a 'PutM' monad. -- Returns 'Producer'.-runTextGen :: PutM VoidEncodingState i o m () -> ConduitM i o m ()+runTextGen :: PutM VoidEncodingState i o m () -> ConduitT i o m () runTextGen !p = runEncoding $ snd $ runPutS p $ startEncoding VoidEncodingState {-# INLINE runTextGen #-} +-- | Output a strict string. genString :: S.Text -> TextGen genString !x = putS $ \ !t -> ((), encoded (yield x, ()) t) {-# INLINE genString #-} +-- | Output a string. genLazyString :: Text -> TextGen genLazyString !x = putS $ \ !t -> ((), encoded (mapM_ yield $ T.toChunks x, ()) t) {-# INLINE genLazyString #-} +-- | Output a showable object. genShow :: Show a => a -> TextGen genShow = genLazyString . T.pack . show {-# INLINE genShow #-} +-- | Output a decimal digit. genDigit :: Integral a => a -> TextGen genDigit !x | x < 0 || x >= 10 = error "genDigit" | otherwise = genString $ ST.singleton $ chr $ ord '0' + fromIntegral x {-# INLINE genDigit #-} +-- | Output a hexadecimal digit. genHexDigit :: Integral a => Bool -> a -> TextGen genHexDigit !uppercase = genString . ST.singleton . chr . toCharCode . fromIntegral@@ -81,12 +85,22 @@ | otherwise = (if uppercase then ord 'A' else ord 'a') + (x - 10) {-# INLINE genHexDigit #-} +-- | Output a byte as a hexadecimal digit pair. genHexByte :: Bool -> Word8 -> TextGen genHexByte !uppercase !c = do genHexDigit uppercase $ c `shiftR` 4 genHexDigit uppercase $ c .&. 0xF {-# INLINE genHexByte #-} +-- | Output an enum value.+--+-- For example, for+--+-- > data CharKind = CharKindWhitespace | CharKindOrdinar deriving (Eq, Ord, Enum, Bounded, Show)+--+-- the following statement is true:+--+-- > runConduitPure $ runTextGen (genEnum 8 CharKindWhitespace) .| sinkLazy = "Whitespace" genEnum :: (Eq a, Ord a, Enum a, Bounded a, Show a) => Int -> a -> TextGen genEnum !prefix = genString . ST.drop prefix . ST.pack . show {-# INLINE genEnum #-}
src/Data/Conduit/Parsers/Text/Parser.hs view
@@ -17,7 +17,7 @@ -- | At the first look, Data.Binary.Conduit.Get module is very similar with Data.Binary.Get. -- The main differences between them are the following. -- While the 'S.Get' from binary is a very custom monad,--- the local 'Get' is 'ConduitM', which leads to easy integration in complicated format parsing.+-- the local 'Get' is 'ConduitT', which leads to easy integration in complicated format parsing. -- The Data.Binary.Get module does not have a function to create custom 'S.Get' monad, -- this module provides 'getC'. -- Unlike 'isolate' from binary, local 'isolate' does not "cut" bytes counter.@@ -29,7 +29,7 @@ , (?=>>) , (?>>) , DefaultParsingState- , GetM+ , GetT , Parser , runParser , charsRead@@ -120,33 +120,33 @@ instance (DecodingState s, DecodingToken s ~ S.Text, DecodingTextRead s) => DefaultParsingState s where --- | The shortening of 'GetM' for the most common use case.-type Parser e a = forall s o m. (DefaultParsingState s, Monad m) => GetM s S.Text o e m a+-- | The shortening of 'GetT' for the most common use case.+type Parser e a = forall s o m. (DefaultParsingState s, Monad m) => GetT s S.Text o e m a -- | Run a decoder presented as a 'Get' monad. -- Returns decoder result and consumed bytes count.-runParser :: Monad m => GetM TextOffset i o e m a -> ConduitM i o m (Either e a)+runParser :: Monad m => GetT TextOffset i o e m a -> ConduitT i o m (Either e a) runParser !g = fst <$> runGetC (startDecoding $ TextOffset 0 0 0) g {-# INLINE runParser #-} -- | Get the total number of bytes read to this point.-charsRead :: (DecodingState s, DecodingElemsRead s, Monad m) => GetM s i o e m Word64+charsRead :: (DecodingState s, DecodingElemsRead s, Monad m) => GetT s i o e m Word64 charsRead = elemsRead {-# INLINE charsRead #-} -- | Get the total number of bytes read to this point.-linesRead :: (DecodingState s, DecodingLinesRead s, Monad m) => GetM s i o e m Word64+linesRead :: (DecodingState s, DecodingLinesRead s, Monad m) => GetT s i o e m Word64 linesRead = getC $ \ !x -> return (Right $ decodingLinesRead x, x) {-# INLINE linesRead #-} -- | Get the total number of bytes read to this point.-columnsRead :: (DecodingState s, DecodingColumnsRead s, Monad m) => GetM s i o e m Word64+columnsRead :: (DecodingState s, DecodingColumnsRead s, Monad m) => GetT s i o e m Word64 columnsRead = getC $ \ !x -> return (Right $ decodingColumnsRead x, x) {-# INLINE columnsRead #-} -- | Run the given 'S.Get' monad from binary package -- and convert result into 'Get'.-castParser :: (DecodingState s, DecodingToken s ~ S.Text, Monad m) => T.Parser a -> GetM s S.Text o (NonEmpty String) m a+castParser :: (DecodingState s, DecodingToken s ~ S.Text, Monad m) => T.Parser a -> GetT s S.Text o (NonEmpty String) m a castParser !g = getC $ go (TP.Partial $ TP.parse g) ST.empty where@@ -160,11 +160,11 @@ go (continue next) next (decoded chunk decoding) {-# INLINE castParser #-} -voidError :: Monad m => GetM s i o e m a -> GetM s i o () m a+voidError :: Monad m => GetT s i o e m a -> GetT s i o () m a voidError = mapError (const ()) {-# INLINE voidError #-} -anyError :: Monad m => GetM s i o e' m a -> GetM s i o e m a+anyError :: Monad m => GetT s i o e' m a -> GetT s i o e m a anyError = mapError (const $ error "Data.Conduit.Parsers.Text.Parser.anyError") {-# INLINE anyError #-}
src/Data/Conduit/Parsers/Text/TextOffset.hs view
@@ -17,7 +17,7 @@ -- | At the first look, Data.Binary.Conduit.Get module is very similar with Data.Binary.Get. -- The main differences between them are the following. -- While the 'S.Get' from binary is a very custom monad,--- the local 'Get' is 'ConduitM', which leads to easy integration in complicated format parsing.+-- the local 'Get' is 'ConduitT', which leads to easy integration in complicated format parsing. -- The Data.Binary.Get module does not have a function to create custom 'S.Get' monad, -- this module provides 'getC'. -- Unlike 'isolate' from binary, local 'isolate' does not "cut" bytes counter.
test/Data/Conduit/Parsers/Binary/Get/Spec.hs view
@@ -62,7 +62,7 @@ , TestCase testErrorMap ] -runGet :: Monad m => GetM G.ByteOffset i o e m a -> ConduitM i o m (Either e a, Word64)+runGet :: Monad m => GetT G.ByteOffset i o e m a -> ConduitT i o m (Either e a, Word64) runGet !g = (\(!r, !s) -> (r, G.decodingElemsRead s)) <$> G.runGetC (G.startDecoding $ G.ByteOffset 0) g testInput1 :: [S.ByteString]@@ -116,7 +116,7 @@ eof <- N.nullE if eof then return () else throwError e -get1 :: (DefaultDecodingState s, Monad m) => GetM s S.ByteString Word16 Bool m ()+get1 :: (DefaultDecodingState s, Monad m) => GetT s S.ByteString Word16 Bool m () get1 = do yield =<< mapError (const False) getWord16le yield =<< mapError (const False) getWord16le@@ -136,33 +136,33 @@ getBytes1 :: Assertion getBytes1 = do- let ((!e, !c), !r) = runIdentity $ N.yieldMany testInput1 $$ (runGet get1 `fuseBoth` N.sinkList)+ let ((!e, !c), !r) = runIdentity $ N.yieldMany testInput1 `connect` (runGet get1 `fuseBoth` N.sinkList) assertEqual "" (Right ()) e assertEqual "" [0x13 `shiftL` 8 .|. 0x12, 0x15 `shiftL` 8 .|. 0x14, 0x18 `shiftL` 8 .|. 0xF3] r assertEqual "" 6 c getBytes2 :: Assertion getBytes2 = do- let ((!e, !c), !r) = runIdentity $ N.yieldMany testInput2 $$ (runGet get1 `fuseBoth` N.sinkList)+ let ((!e, !c), !r) = runIdentity $ N.yieldMany testInput2 `connect` (runGet get1 `fuseBoth` N.sinkList) assertEqual "" (Left True) e assertEqual "" [0x13 `shiftL` 8 .|. 0x12, 0x15 `shiftL` 8 .|. 0x14, 0x18 `shiftL` 8 .|. 0xF3] r assertEqual "" 6 c testSkip :: Assertion testSkip = do- let (!e, !c) = runIdentity $ N.yieldMany testInput3 $$ runGet get2+ let (!e, !c) = runIdentity $ N.yieldMany testInput3 `connect` runGet get2 assertEqual "" (Right 3) e assertEqual "" 3 c eofError :: Assertion eofError = do- let (!e, !c) = runIdentity $ N.yieldMany testInput4 $$ runGet getInt64host+ let (!e, !c) = runIdentity $ N.yieldMany testInput4 `connect` runGet getInt64host assertEqual "" (Left ()) e assertEqual "" 3 c eofOrNotEof :: Assertion eofOrNotEof = do- let (!e, !c) = runIdentity $ N.yieldMany testInput4 $$ runGet (Right <$> getInt64host <|> Left <$> getTailBytes)+ let (!e, !c) = runIdentity $ N.yieldMany testInput4 `connect` runGet (Right <$> getInt64host <|> Left <$> getTailBytes) assertEqual "" (Right $ Left "ABC") e assertEqual "" 3 c @@ -170,7 +170,7 @@ testIsolateOverAlternativeIsolateNotEnough = do let (!e, !c) = runIdentity $ N.yieldMany testInput5- $$ runGet (isolate 2 $ Right <$> getInt32le <|> Left <$> getWord8)+ `connect` runGet (isolate 2 $ Right <$> getInt32le <|> Left <$> getWord8) assertEqual "" (Left $ Left $ Just 1) e assertEqual "" 1 c @@ -178,7 +178,7 @@ testIsolateOverAlternativeIsolateExactly = do let (!e, !c) = runIdentity $ N.yieldMany testInput5- $$ runGet (isolate 1 $ Right <$> getInt32le <|> Left <$> getWord8)+ `connect` runGet (isolate 1 $ Right <$> getInt32le <|> Left <$> getWord8) assertEqual "" (Right $ Left $ fromIntegral $ ord 'A') e assertEqual "" 1 c @@ -186,7 +186,7 @@ testIsolateOverAlternativeIsolateEnough = do let (!e, !c) = runIdentity $ N.yieldMany testInput5- $$ runGet (isolate 4 $ Right <$> getInt32le <|> Left <$> getWord8)+ `connect` runGet (isolate 4 $ Right <$> getInt32le <|> Left <$> getWord8) assertEqual "" (Right $ Right 1145258561) e assertEqual "" 4 c @@ -194,7 +194,7 @@ testIsolateOverAlternativeIsolateEnoughButEof = do let (!e, !c) = runIdentity $ N.yieldMany testInput4- $$ runGet (isolate 4 $ Right <$> getInt32le <|> Left <$> getWord8)+ `connect` runGet (isolate 4 $ Right <$> getInt32le <|> Left <$> getWord8) assertEqual "" (Left $ Left Nothing) e assertEqual "" 0 c @@ -202,7 +202,7 @@ testIsolateIsolateEnoughButEof = do let (!e, !c) = runIdentity $ N.yieldMany testInput4- $$ runGet (isolate 4 getWord8)+ `connect` runGet (isolate 4 getWord8) assertEqual "" (Left $ Left $ Just 1) e assertEqual "" 1 c @@ -210,13 +210,13 @@ testIsolateIsolateEnoughButEofEarly = do let (!e, !c) = runIdentity $ N.yieldMany testInput7- $$ runGet (isolate 4 $ getWord8 >> getWord8 >> getWord8 >> getWord8)+ `connect` runGet (isolate 4 $ getWord8 >> getWord8 >> getWord8 >> getWord8) assertEqual "" (Left $ Left Nothing) e assertEqual "" 0 c testAlternativeRollback :: Assertion testAlternativeRollback = do- let (!e, !c) = runIdentity $ N.yieldMany testInput6 $$ runGet ((skip 9 >> throwError ()) <|> getWord64le)+ let (!e, !c) = runIdentity $ N.yieldMany testInput6 `connect` runGet ((skip 9 >> throwError ()) <|> getWord64le) assertEqual "" (Right $ 0x01 .|. 0x02 `shiftL` 8 .|. 0x03 `shiftL` 16 .|. 0x04 `shiftL` 24 .|. 0x05 `shiftL` 32 .|. 0x06 `shiftL` 40 .|. 0x07 `shiftL` 48 .|. 0x08 `shiftL` 56) e assertEqual "" 8 c @@ -226,7 +226,7 @@ record :: Word64 -> Get (Either (Maybe Word64) ()) [Word64] record z = isolate z recordBody -records :: (DefaultDecodingState s, Monad m) => GetM s S.ByteString [Word64] (Either (Maybe Word64) ()) m ()+records :: (DefaultDecodingState s, Monad m) => GetT s S.ByteString [Word64] (Either (Maybe Word64) ()) m () records = do yield =<< record 24 yield =<< record 16@@ -240,12 +240,12 @@ testRecords :: Assertion testRecords = do- let ((!e, !c), !r) = runIdentity $ N.yieldMany recordsInput $$ (runGet records `fuseBoth` N.sinkList)+ let ((!e, !c), !r) = runIdentity $ N.yieldMany recordsInput `connect` (runGet records `fuseBoth` N.sinkList) assertEqual (show c) (Right ()) e assertEqual "" [[3978425819141910832, 3978425819141910832, 3978425819141910832], [3978425819141910832, 3978425819141910832], [3978425819141910832]] r assertEqual "" 48 c -takeE :: Monad m => Int -> ConduitM S.ByteString o m S.ByteString+takeE :: Monad m => Int -> ConduitT S.ByteString o m S.ByteString takeE !n = go SB.empty 0 where@@ -274,7 +274,7 @@ !r <- mapError Right $ getByteString 2 ensureEof $ Right () return r- let (!e, !c) = runIdentity $ yield "ABCD" $$ runGet g+ let (!e, !c) = runIdentity $ yield "ABCD" `connect` runGet g assertEqual "" (Right "CD") e assertEqual "" 4 c @@ -303,7 +303,7 @@ testSkipUntilZero :: Assertion testSkipUntilZero = do- let (!r, !c) = runIdentity $ N.yieldMany testZeroInput1 $$ runGet (skipUntilZero >> getRemainingLazyByteString)+ let (!r, !c) = runIdentity $ N.yieldMany testZeroInput1 `connect` runGet (skipUntilZero >> getRemainingLazyByteString) assertEqual "" ((Right "\0zx8") :: Either Void ByteString) r assertEqual "" 10 c @@ -312,5 +312,5 @@ testErrorMap :: Assertion testErrorMap = do- let !r = runIdentity $ N.yieldMany [] $$ G.runGet w32+ let !r = runIdentity $ N.yieldMany [] `connect` G.runGet w32 assertEqual "" (Left "Unexpected EOF at 0") r
test/Data/Conduit/Parsers/Binary/Put/Spec.hs view
@@ -49,7 +49,7 @@ testExample :: Assertion testExample = do- runPut (putWithSize $ testPut1 3) $$ testResult+ runPut (putWithSize $ testPut1 3) `connect` testResult where testResult = do (\x -> lift $ assertEqual "" (Right $ 3 * fromIntegral (finiteBitSize (0 :: Word))) x) =<< runGet getWord64le
+ test/Data/Conduit/Parsers/Text/Gen/Spec.hs view
@@ -0,0 +1,38 @@+--+-- Copyright 2017 Warlock <internalmike@gmail.com>+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+-- http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--++module Data.Conduit.Parsers.Text.Gen.Spec+ ( tests+ ) where++import Data.Conduit+import qualified Data.Conduit.Combinators as N+import Data.Functor.Identity+import qualified Data.Text as S (Text)+import Test.HUnit.Base hiding (Label)+import Data.Conduit.Parsers.Binary.Put hiding (runPut)+import Data.Conduit.Parsers.Text.Gen++tests :: Test+tests = TestList+ [ TestCase testGenEnum+ ]++data CharKind = CharKindWhitespace | CharKindOrdinar deriving (Eq, Ord, Enum, Bounded, Show)++testGenEnum :: Assertion+testGenEnum = do+ assertEqual "" "Whitespace" $ runConduitPure $ runTextGen (genEnum 8 CharKindWhitespace) .| N.sinkLazy
test/Data/Conduit/Parsers/Text/Parser/Spec.hs view
@@ -33,7 +33,7 @@ testLinesRead :: Assertion testLinesRead = do- let !r = runIdentity $ N.yieldMany testInput1 $$ runParser parser1+ let !r = runIdentity $ N.yieldMany testInput1 `connect` runParser parser1 assertEqual "" (Right ('t', 'x')) r parser1 :: Parser () (Char, Char)
test/Spec.hs view
@@ -20,6 +20,7 @@ import qualified Data.Conduit.Parsers.Binary.Get.Spec import qualified Data.Conduit.Parsers.Binary.Put.Spec import qualified Data.Conduit.Parsers.Text.Parser.Spec+import qualified Data.Conduit.Parsers.Text.Gen.Spec main :: IO () main = void $ runTestTT tests@@ -29,4 +30,5 @@ [ Data.Conduit.Parsers.Binary.Get.Spec.tests , Data.Conduit.Parsers.Binary.Put.Spec.tests , Data.Conduit.Parsers.Text.Parser.Spec.tests+ , Data.Conduit.Parsers.Text.Gen.Spec.tests ]