packages feed

conduit-combinators 0.2.2 → 0.2.3

raw patch · 4 files changed

+216/−6 lines, 4 filesdep +base16-bytestringdep +base64-bytestring

Dependencies added: base16-bytestring, base64-bytestring

Files

Data/Conduit/Combinators.hs view
@@ -141,6 +141,14 @@     , concatMapAccum     , intersperse +      -- *** Binary base encoding+    , encodeBase64+    , decodeBase64+    , encodeBase64URL+    , decodeBase64URL+    , encodeBase16+    , decodeBase16+       -- ** Monadic     , mapM     , mapME@@ -168,7 +176,12 @@ import Data.Builder import qualified Data.NonNull as NonNull import qualified Data.Traversable+import qualified Data.ByteString as S+import qualified Data.ByteString.Base16 as B16+import qualified Data.ByteString.Base64 as B64+import qualified Data.ByteString.Base64.URL as B64U import           Control.Applicative         ((<$>))+import           Control.Exception           (assert) import           Control.Category            (Category (..)) import           Control.Monad               (unless, when, (>=>), liftM, forever) import           Control.Monad.Base          (MonadBase (liftBase))@@ -190,7 +203,8 @@ import           Prelude                     (Bool (..), Eq (..), Int,                                               Maybe (..), Monad (..), Num (..),                                               Ord (..), fromIntegral, maybe,-                                              ($), Functor (..), Enum, seq, Show, Char, (||))+                                              ($), Functor (..), Enum, seq, Show, Char, (||),+                                              mod, otherwise, Either (..)) import Data.Word (Word8) import qualified Prelude import           System.IO                   (Handle)@@ -1371,6 +1385,101 @@   where     go y = yield y >> concatMap (\z -> [x, z]) {-# INLINE intersperse #-}++codeWith :: Monad m+         => Int+         -> (ByteString -> Either e ByteString)+         -> Conduit ByteString m ByteString+codeWith size f =+    loop+  where+    loop = await >>= maybe (return ()) push++    loopWith bs+        | S.null bs = loop+        | otherwise = await >>= maybe (finish bs) (pushWith bs)++    finish bs =+        case f bs of+            Left _ -> leftover bs+            Right x -> yield x++    push bs = do+        let (x, y) = S.splitAt (len - (len `mod` size)) bs+        if S.null x+            then loopWith y+            else do+                case f x of+                    Left _ -> leftover bs+                    Right x' -> yield x' >> loopWith y+      where+        len = olength bs++    pushWith bs1 bs2 | S.length bs1 + S.length bs2 < size = loopWith (S.append bs1 bs2)+    pushWith bs1 bs2 = assertion1 $ assertion2 $ assertion3 $+        case f bs1' of+            Left _ -> leftover bs2 >> leftover bs1+            Right toYield -> yield toYield >> push y+      where+        m = S.length bs1 `mod` size+        (x, y) = S.splitAt (size - m) bs2+        bs1' = mappend bs1 x++        assertion1 = assert $ olength bs1 < size+        assertion2 = assert $ olength bs1' `mod` size == 0+        assertion3 = assert $ olength bs1' > 0++-- | Apply base64-encoding to the stream.+--+-- Since 1.0.0+encodeBase64 :: Monad m => Conduit ByteString m ByteString+encodeBase64 = codeWith 3 (Right . B64.encode)+{-# INLINE encodeBase64 #-}++-- | Apply base64-decoding to the stream. Will stop decoding on the first+-- invalid chunk.+--+-- Since 1.0.0+decodeBase64 :: Monad m => Conduit ByteString m ByteString+decodeBase64 = codeWith 4 B64.decode+{-# INLINE decodeBase64 #-}++-- | Apply URL-encoding to the stream.+--+-- Since 1.0.0+encodeBase64URL :: Monad m => Conduit ByteString m ByteString+encodeBase64URL = codeWith 3 (Right . B64U.encode)+{-# INLINE encodeBase64URL #-}++-- | Apply lenient base64URL-decoding to the stream. Will stop decoding on the+-- first invalid chunk.+--+-- Since 1.0.0+decodeBase64URL :: Monad m => Conduit ByteString m ByteString+decodeBase64URL = codeWith 4 B64U.decode+{-# INLINE decodeBase64URL #-}++-- | Apply base16-encoding to the stream.+--+-- Since 1.0.0+encodeBase16 :: Monad m => Conduit ByteString m ByteString+encodeBase16 = map B16.encode+{-# INLINE encodeBase16 #-}++-- | Apply base16-decoding to the stream. Will stop decoding on the first+-- invalid chunk.+--+-- Since 1.0.0+decodeBase16 :: Monad m => Conduit ByteString m ByteString+decodeBase16 =+    codeWith 2 decode'+  where+    decode' x+        | onull z = Right y+        | otherwise = Left ()+      where+        (y, z) = B16.decode x+{-# INLINE decodeBase16 #-}  -- | Apply a monadic transformation to all values in a stream. --
Data/Conduit/Combinators/Unqualified.hs view
@@ -130,6 +130,14 @@     , concatMapAccumC     , intersperseC +      -- **** Binary base encoding+    , encodeBase64C+    , decodeBase64C+    , encodeBase64URLC+    , decodeBase64URLC+    , encodeBase16C+    , decodeBase16C+       -- *** Monadic     , mapMC     , mapMCE@@ -160,7 +168,12 @@ import Data.Builder import qualified Data.NonNull as NonNull import qualified Data.Traversable+import qualified Data.ByteString as S+import qualified Data.ByteString.Base16 as B16+import qualified Data.ByteString.Base64 as B64+import qualified Data.ByteString.Base64.URL as B64U import           Control.Applicative         ((<$>))+import           Control.Exception           (assert) import           Control.Category            (Category (..)) import           Control.Monad               (unless, when, (>=>), liftM, forever) import           Control.Monad.Base          (MonadBase (liftBase))@@ -177,12 +190,13 @@ import qualified Data.Vector.Generic         as V import qualified Data.Vector.Generic.Mutable as VM import qualified Filesystem                  as F-import           Filesystem.Path             (FilePath)-import           Filesystem.Path.CurrentOS   (encodeString)+import           Filesystem.Path             (FilePath, (</>))+import           Filesystem.Path.CurrentOS   (encodeString, decodeString) import           Prelude                     (Bool (..), Eq (..), Int,                                               Maybe (..), Monad (..), Num (..),                                               Ord (..), fromIntegral, maybe,-                                              ($), Functor (..), Enum, seq, Show, Char)+                                              ($), Functor (..), Enum, seq, Show, Char, (||),+                                              mod, otherwise, Either (..)) import Data.Word (Word8) import qualified Prelude import           System.IO                   (Handle)@@ -193,7 +207,8 @@ import Data.Text (Text) import qualified System.Random.MWC as MWC import Data.Conduit.Combinators.Internal-import qualified System.PosixCompat.Files as Posix+import qualified System.PosixCompat.Files as PosixC+import qualified System.Posix.Directory as Dir   -- END IMPORTS@@ -1131,6 +1146,51 @@ intersperseC :: Monad m => a -> Conduit a m a intersperseC = CC.intersperse {-# INLINE intersperseC #-}++-- | Apply base64-encoding to the stream.+--+-- Since 1.0.0+encodeBase64C :: Monad m => Conduit ByteString m ByteString+encodeBase64C = CC.encodeBase64+{-# INLINE encodeBase64C #-}++-- | Apply base64-decoding to the stream. Will stop decoding on the first+-- invalid chunk.+--+-- Since 1.0.0+decodeBase64C :: Monad m => Conduit ByteString m ByteString+decodeBase64C = CC.decodeBase64+{-# INLINE decodeBase64C #-}++-- | Apply URL-encoding to the stream.+--+-- Since 1.0.0+encodeBase64URLC :: Monad m => Conduit ByteString m ByteString+encodeBase64URLC = CC.encodeBase64URL+{-# INLINE encodeBase64URLC #-}++-- | Apply lenient base64URL-decoding to the stream. Will stop decoding on the+-- first invalid chunk.+--+-- Since 1.0.0+decodeBase64URLC :: Monad m => Conduit ByteString m ByteString+decodeBase64URLC = CC.decodeBase64URL+{-# INLINE decodeBase64URLC #-}++-- | Apply base16-encoding to the stream.+--+-- Since 1.0.0+encodeBase16C :: Monad m => Conduit ByteString m ByteString+encodeBase16C = CC.encodeBase16+{-# INLINE encodeBase16C #-}++-- | Apply base16-decoding to the stream. Will stop decoding on the first+-- invalid chunk.+--+-- Since 1.0.0+decodeBase16C :: Monad m => Conduit ByteString m ByteString+decodeBase16C = CC.decodeBase16+{-# INLINE decodeBase16C #-}  -- | Apply a monadic transformation to all values in a stream. --
conduit-combinators.cabal view
@@ -1,5 +1,5 @@ name:                conduit-combinators-version:             0.2.2+version:             0.2.3 synopsis:            Commonly used conduit functions, for both chunked and unchunked data description:         Provides a replacement for Data.Conduit.List, as well as a convenient Conduit module. homepage:            https://github.com/fpco/conduit-combinators@@ -32,6 +32,8 @@                      , void                      , mwc-random                      , unix-compat+                     , base16-bytestring+                     , base64-bytestring        >= 0.1.1.1   if os(windows)       cpp-options:     -DWINDOWS   else@@ -54,6 +56,8 @@                 , silently                 , bytestring                 , mwc-random+                , base16-bytestring+                , base64-bytestring   ghc-options:    -Wall  source-repository head
test/Spec.hs view
@@ -24,7 +24,14 @@ import GHC.IO.Handle (hDuplicateTo) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as L import System.Random.MWC (createSystemRandom)+import qualified Data.ByteString.Base16 as B16+import qualified Data.ByteString.Base16.Lazy as B16L+import qualified Data.ByteString.Base64 as B64+import qualified Data.ByteString.Base64.Lazy as B64L+import qualified Data.ByteString.Base64.URL.Lazy as B64LU+import qualified Data.ByteString.Base64.URL as B64U  main :: IO () main = hspec $ do@@ -443,6 +450,36 @@     prop "intersperse" $ \xs x ->         runIdentity (yieldMany xs $$ intersperseC x =$ sinkList)         `shouldBe` intersperse (x :: Int) xs+    describe "binary base encoding" $ do+        describe "encode/decode is idempotent" $ do+            prop "64 non-url" $ \(map S.pack -> bss) ->+                mconcat bss == runIdentity (yieldMany bss $$ encodeBase64C =$ decodeBase64C =$ foldC)+            prop "64 url" $ \(map S.pack -> bss) ->+                mconcat bss == runIdentity (yieldMany bss $$ encodeBase64URLC =$ decodeBase64URLC =$ foldC)+            prop "16" $ \(map S.pack -> bss) ->+                mconcat bss == runIdentity (yieldMany bss $$ encodeBase16C =$ decodeBase16C =$ foldC)+        describe "encode is identical" $ do+            prop "64 non-url" $ \(map S.pack -> bss) ->+                B64.encode (mconcat bss) == runIdentity (yieldMany bss $$ encodeBase64C =$ foldC)+            prop "64 url" $ \(map S.pack -> bss) ->+                B64U.encode (mconcat bss) == runIdentity (yieldMany bss $$ encodeBase64URLC =$ foldC)+            prop "16" $ \(map S.pack -> bss) ->+                B16.encode (mconcat bss) == runIdentity (yieldMany bss $$ encodeBase16C =$ foldC)+        describe "decode leftovers work" $ do+            let test name encL dec decC = prop name $ \(L.toChunks . encL . L.pack -> bss) -> do+                    let invalid = "\0INVALID"+                        src = yieldMany bss >> yield invalid+                        sink = (,) <$> (decC =$ foldC) <*> foldC+                        expected = (dec $ mconcat bss, invalid)+                    actual <- src $$ sink+                    actual `shouldBe` expected+            test "64 non-url" B64L.encode B64.decodeLenient decodeBase64C+            test "64 url" B64LU.encode B64U.decodeLenient decodeBase64URLC+            let b16Decode x =+                    case B16.decode x of+                        (y, "") -> y+                        _ -> error "FIXME!"+            test "16" B16L.encode b16Decode decodeBase16C     prop "mapM" $ \input ->         runIdentity (yieldMany input $$ mapMC (return . succChar) =$ sinkList)         `shouldBe` map succChar input