hw-conduit 0.2.0.3 → 0.2.0.5

raw patch · 4 files changed

+161/−98 lines, 4 filesdep +transformersdep +unliftio-corenew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: transformers, unliftio-core

API changes (from Hackage documentation)

Files

• hw-conduit.cabal +73/−55
• src/HaskellWorks/Data/Conduit/ByteString.hs +13/−5
• src/HaskellWorks/Data/Conduit/Combinator.hs +68/−33
• src/HaskellWorks/Data/Conduit/List.hs +7/−5

@@ -1,62 +1,80 @@-name:                   hw-conduit-version:                0.2.0.3-synopsis:               Conduits for tokenizing streams.-description:            Please see README.md-homepage:               http://github.com/haskell-works/hw-conduit#readme-license:                MIT-license-file:           LICENSE-author:                 John Ky-maintainer:             newhoggy@gmail.com-copyright:              2016 John Ky-category:               Data, Conduit-build-type:             Simple-extra-source-files:     README.md-cabal-version:          >= 1.22--library-  hs-source-dirs:       src-  exposed-modules:      HaskellWorks.Data.Conduit.ByteString-                      , HaskellWorks.Data.Conduit.Combinator-                      , HaskellWorks.Data.Conduit.List-  build-depends:        base                          >= 4          && < 5-                      , array-                      , bytestring-                      , conduit-                      , conduit-combinators-                      , word8-                      , time+-- This file has been generated from package.yaml by hpack version 0.18.1.+--+-- see: https://github.com/sol/hpack -  default-language:     Haskell2010-  ghc-options:          -Wall -O2 -msse4.2+name:           hw-conduit+version:        0.2.0.5+synopsis:       Conduits for tokenizing streams.+description:    Conduits for tokenizing streams. Please see README.md+category:       Data, Conduit+homepage:       http://github.com/haskell-works/hw-conduit#readme+bug-reports:    https://github.com/haskell-works/hw-conduit/issues+author:         John Ky+maintainer:     newhoggy@gmail.com+copyright:      2016 John Ky+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10 -test-suite hw-conduit-test-  type:                 exitcode-stdio-1.0-  hs-source-dirs:       test-  main-is:              Spec.hs-  other-modules:        HaskellWorks.Data.Conduit.ByteStringSpec-                      , HaskellWorks.Data.Conduit.CombinatorSpec-  build-depends:        base                          >= 4          && < 5-                      , bytestring-                      , conduit-                      , hspec-                      , hw-conduit-  ghc-options:          -threaded -rtsopts -with-rtsopts=-N -Wall-  default-language:     Haskell2010+extra-source-files:+    README.md  source-repository head-  type:     git+  type: git   location: https://github.com/haskell-works/hw-conduit +library+  hs-source-dirs:+      src+  ghc-options: -Wall -O2 -msse4.2+  build-depends:+      base >=4.9 && <5+    , bytestring+    , conduit+    , array+    , conduit-combinators+    , transformers+    , word8+    , time+    , unliftio-core+  exposed-modules:+      HaskellWorks.Data.Conduit.ByteString+      HaskellWorks.Data.Conduit.Combinator+      HaskellWorks.Data.Conduit.List+  other-modules:+      Paths_hw_conduit+  default-language: Haskell2010++test-suite hw-conduit-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.9 && <5+    , bytestring+    , conduit+    , hspec+    , hw-conduit+  other-modules:+      HaskellWorks.Data.Conduit.ByteStringSpec+      HaskellWorks.Data.Conduit.CombinatorSpec+  default-language: Haskell2010+ benchmark bench-    Type: exitcode-stdio-1.0-    HS-Source-Dirs: bench-    Main-Is: Main.hs-    GHC-Options: -O2 -Wall -msse4.2-    Default-Language: Haskell2010-    Build-Depends:      base                          >= 4          && < 5-                      , bytestring-                      , conduit-                      , criterion-                      , hw-conduit-                      , mmap-                      , vector+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      bench+  ghc-options: -Wall -O2 -msse4.2+  build-depends:+      base >=4.9 && <5+    , bytestring+    , conduit+    , criterion+    , hw-conduit+    , mmap+    , vector+  default-language: Haskell2010

@@ -2,14 +2,20 @@   ( rechunk   ) where -import           Control.Monad+import Control.Monad+import Data.Conduit+ import qualified Data.ByteString as BS-import           Data.Conduit -rechunk :: Monad m => Int -> Conduit BS.ByteString m BS.ByteString+rechunk :: Monad m+  => Int+  -> ConduitT BS.ByteString BS.ByteString m () rechunk = rechunk' BS.empty -rechunk' :: Monad m => BS.ByteString -> Int -> Conduit BS.ByteString m BS.ByteString+rechunk' :: Monad m+  => BS.ByteString+  -> Int+  -> ConduitT BS.ByteString BS.ByteString m () rechunk' as n | BS.length as >= n = do   yield (BS.take n as)   rechunk' (BS.drop n as) n@@ -22,7 +28,9 @@       rechunk' (BS.drop n bs) n     Nothing -> unless (BS.null as) $ yield as -slurp :: Monad m => Int -> ConduitM BS.ByteString BS.ByteString m (Maybe [BS.ByteString])+slurp :: Monad m+  => Int+  -> ConduitM BS.ByteString BS.ByteString m (Maybe [BS.ByteString]) slurp = go []   where go rs n | n > 0 = do           mbs <- await

@@ -1,81 +1,97 @@ module HaskellWorks.Data.Conduit.Combinator where -import Control.Concurrent     (MVar, putMVar, tryTakeMVar)-import Control.Monad          (void)+import Control.Concurrent        (MVar, putMVar, tryTakeMVar)+import Control.Monad             (void) import Control.Monad.IO.Class+import Control.Monad.Trans.Class (lift) import Data.Conduit import Data.Maybe-import Data.Time.Clock.POSIX  as T+import Data.Time.Clock.POSIX     as T  import qualified Data.Conduit.List as L  -- | Run the provided conduit in the Just case-maybeC :: Monad m => Conduit () m () -> Conduit a m c -> Conduit (Maybe a) m (Maybe c)+maybeC :: Monad m => ConduitT () () m () -> ConduitT a c m () -> ConduitT (Maybe a) (Maybe c) m () maybeC n j = getZipConduit   $   ZipConduit (L.filter isNothing  .| L.map (const ()) .|  n .| L.map (const Nothing))   <*  ZipConduit (L.concat            .|                      j .| L.map Just           )  -- | Run the provided conduit in the Just case-justC :: Monad m => Conduit a m c -> Conduit (Maybe a) m (Maybe c)+justC :: Monad m => ConduitT a c m () -> ConduitT (Maybe a) (Maybe c) m () justC = maybeC (L.map id)  -- | Run the provided conduit in the Just case-nothingC :: Monad m => Conduit () m () -> Conduit (Maybe a) m (Maybe a)+nothingC :: Monad m => ConduitT () () m () -> ConduitT (Maybe a) (Maybe a) m () nothingC n = maybeC n (L.map id)  -- | Run the provided conduits on the left and right side of the either respectively-eitherC :: Monad m => Conduit l m a -> Conduit r m a -> Conduit (Either l r) m a+eitherC :: Monad m => ConduitT l a m () -> ConduitT r a m () -> ConduitT (Either l r) a m () eitherC l r = getZipConduit   $   ZipConduit (projectLefts  .| l)   <*  ZipConduit (projectRights .| r)  -- | Run the conduit on the right side of the either-rightC :: Monad m => Conduit r m a -> Conduit (Either l r) m (Either l a)+rightC :: Monad m => ConduitT r a m () -> ConduitT (Either l r) (Either l a) m () rightC r = eitherC (L.map Left) (r .| L.map Right)  -- | Run the conduit on the left side of the either-leftC :: Monad m => Conduit l m a -> Conduit (Either l r) m (Either a r)+leftC :: Monad m => ConduitT l a m () -> ConduitT (Either l r) (Either a r) m () leftC l = eitherC (l .| L.map Left) (L.map Right)  -- | Performs the effect but ignores its result. -- The original value is propagated downstream.-effectC :: Monad m => (a -> m b) -> Conduit a m a+effectC :: Monad m => (a -> m b) -> ConduitT a a m () effectC f = L.mapM (\a -> f a >> return a)  -- | Performs the effect but ignores its result. -- The original value is propagated downstream.-effectC' :: Monad m => m b -> Conduit a m a+effectC' :: Monad m => m b -> ConduitT a a m () effectC' m = L.mapM (\a -> m >> return a) +-- | Sink that writes the message to an mvar+mvarWriteC :: MonadIO m => MVar a -> ConduitT a Void m ()+mvarWriteC mvar = awaitForever $ \v ->+  liftIO $ tryTakeMVar mvar >> putMVar mvar v++-- | Sink that writes the message to an mvar+mvarWriteMC :: MonadIO m => (a -> b) -> MVar b -> ConduitT a Void m ()+mvarWriteMC f mvar = awaitForever $ \v ->+  liftIO $ tryTakeMVar mvar >> putMVar mvar (f v)++-- | Sink that writes the message to an mvar+mvarWriteSink :: MonadIO m => MVar a -> ConduitT a Void m ()+mvarWriteSink mvar = awaitForever $ \v ->+  liftIO $ tryTakeMVar mvar >> putMVar mvar v+ -- | Creates a unified sink, which is actually two separate sinks with results -- being sent to one or the other based on a predicate.-sinkWithPred :: Monad m => (a -> Bool) -> Sink a m () -> Sink a m () -> Sink a m ()+sinkWithPred :: Monad m => (a -> Bool) -> ConduitT a Void m () -> ConduitT a Void m () -> ConduitT a Void m () sinkWithPred p tr fl =   void $ sequenceSinks [L.filter p .| tr, L.filter (not . p) .| fl] {-# INLINE sinkWithPred #-}  -- | Projects nothings from the stream. -- Returns a stream that only contains nothings (represented by unit)-projectNothings :: Monad m => Conduit (Maybe a) m ()+projectNothings :: Monad m => ConduitT (Maybe a) () m () projectNothings = awaitForever $ maybe (yield ()) (const $ return ()) {-# INLINE projectNothings #-}  -- | Projects left side values for each value in a stream. -- Downstream only receives values that were on the left side, -- the right side is ignored.-projectLefts :: Monad m => Conduit (Either l r) m l+projectLefts :: Monad m => ConduitT (Either l r) l m () projectLefts = awaitForever $ either yield (const $ return ()) {-# INLINE projectLefts #-}  -- | Projects right side values for each value in a stream. -- Downstream only receives values that were on the right side, -- the left side is ignored.-projectRights :: Monad m => Conduit (Either l r) m r+projectRights :: Monad m => ConduitT (Either l r) r m () projectRights = awaitForever $ either (const $ return ()) yield {-# INLINE projectRights #-}  -- | Propagate every N messages and drop all others.-everyN :: Monad m => Int -> Conduit a m a+everyN :: Monad m => Int -> ConduitT a a m () everyN n = go 1   where     go n' = await >>= maybe (return ()) (\x ->@@ -84,8 +100,28 @@         else yield x >> go 1) {-# INLINE everyN #-} +-- | Performs an action every N messages, but ignores its result. All original values are propagted downstream.+onEveryN :: Monad m => Int -> (a -> m b) -> ConduitT a a m ()+onEveryN n f = go 1+  where+    go i = await >>= maybe (pure ()) (\x ->+            if i < n+              then yield x >> go (i + 1)+              else lift (f x) >> yield x >> go 1)+{-# INLINE onEveryN #-}++-- | Performs an action every N messages, but ignores its result. All original values are propagted downstream.+onEveryN' :: Monad m => Int -> m b -> ConduitT a a m ()+onEveryN' n m = go 1+  where+    go i = await >>= maybe (pure ()) (\x ->+            if i < n+              then yield x >> go (i + 1)+              else lift m >> yield x >> go 1)+{-# INLINE onEveryN' #-}+ -- | Propagate a message every N seconds and drop all others.-everyNSeconds :: MonadIO m => Int -> Conduit a m a+everyNSeconds :: MonadIO m => Int -> ConduitT a a m () everyNSeconds interval = go 0   where     go t = do@@ -93,7 +129,7 @@       case mmsg of         Nothing -> pure ()         Just msg -> do-          ct <- liftIO $ (round . T.utcTimeToPOSIXSeconds) <$> T.getCurrentTime+          ct <- liftIO $ round . T.utcTimeToPOSIXSeconds <$> T.getCurrentTime           if ct > t             then yield msg >> go (ct + interval)             else go t@@ -103,20 +139,20 @@ -- | Performs the effect but ignores its result. -- The original value is propagated downstream. {-# DEPRECATED effect "Use effectC instead" #-}-effect :: Monad m => (a -> m b) -> Conduit a m a+effect :: Monad m => (a -> m b) -> ConduitT a a m () effect = effectC  -- | Performs the effect but ignores its result. -- The original value is propagated downstream.-effect' :: Monad m => m b -> Conduit a m a+effect' :: Monad m => m b -> ConduitT a a m () effect' = effectC'  {-# DEPRECATED inJust "Use justC instead" #-}-inJust :: Monad m => Conduit a m c -> Conduit (Maybe a) m (Maybe c)+inJust :: Monad m => ConduitT a c m () -> ConduitT (Maybe a) (Maybe c) m () inJust = justC  -- | Sinks values into a given MVar.-mvarSink :: MonadIO m => MVar a -> Sink a m ()+mvarSink :: MonadIO m => MVar a -> ConduitT a () m () mvarSink mvar = awaitForever $ \v ->   liftIO $ tryTakeMVar mvar >> putMVar mvar v @@ -126,28 +162,27 @@ -- > tapWith projectLefts myErrorSink  {-# DEPRECATED tapWith "Unsafe.  Do not use" #-}-tapWith :: Monad m => Conduit a m b -> Sink b m () -> Conduit a m a+tapWith :: Monad m => ConduitT a b m () -> ConduitT b Void m () -> ConduitT a a m () tapWith f s = passthroughSink (f .| s) (const $ return ()) {-# INLINE tapWith #-}  -- | Taps into a given sink. The original value is then propagated downstream. {-# DEPRECATED tap "Unsafe.  Do not use" #-}-tap :: Monad m => Sink a m () -> Conduit a m a+tap :: Monad m => ConduitT a Void m () -> ConduitT a a m () tap s = passthroughSink s (const $ return ()) {-# INLINE tap #-}  -- | Taps a conduit, and sends the results into two different sinks, switching -- on a predicate. {-# DEPRECATED tapPred "Unsafe.  Do not use" #-}-tapPred :: Monad m => (a -> Bool) -> Sink a m () -> Sink a m () -> Conduit a m a-tapPred p tr fl =-  tap (L.filter p .| tr) .| tap (L.filter (not . p) .| fl)+tapPred :: Monad m => (a -> Bool) -> ConduitT a Void m () -> ConduitT a Void m () -> ConduitT a a m ()+tapPred p tr fl = tap (L.filter p .| tr) .| tap (L.filter (not . p) .| fl) {-# INLINE tapPred #-}  -- | For every `Nothing` value in a stream sends `()` to a given `Sink`. -- Downstream receives an untouched original `Maybe` value. {-# DEPRECATED tapNothing "Unsafe.  Do not use" #-}-tapNothing :: Monad m => Sink () m () -> Conduit (Maybe a) m (Maybe a)+tapNothing :: Monad m => ConduitT () Void m () -> ConduitT (Maybe a) (Maybe a) m () tapNothing = tapWith projectNothings {-# INLINE tapNothing #-} @@ -155,34 +190,34 @@ -- `Nothing` is then not propagated downstream. -- Downstream only receives values from `Just` {-# DEPRECATED divertNothing "Unsafe.  Do not use" #-}-divertNothing :: Monad m => Sink () m () -> Conduit (Maybe a) m a+divertNothing :: Monad m => ConduitT () Void m () -> ConduitT (Maybe a) a m () divertNothing sink = tapNothing sink .| L.catMaybes {-# INLINE divertNothing #-}  -- | Sends every left-side value in a stream into a given `Sink`. -- Downstream receives the original `Either` value untouched. {-# DEPRECATED tapLeft "Unsafe.  Do not use" #-}-tapLeft :: Monad m => Sink l m () -> Conduit (Either l r) m (Either l r)+tapLeft :: Monad m => ConduitT l Void m () -> ConduitT (Either l r) (Either l r) m () tapLeft = tapWith projectLefts {-# INLINE tapLeft #-}  -- | Sends every left-side value in a stream into a given `Sink`. -- Downstream receives only right-side values. {-# DEPRECATED divertLeft "Unsafe.  Do not use" #-}-divertLeft :: Monad m => Sink l m () -> Conduit (Either l r) m r+divertLeft :: Monad m => ConduitT l Void m () -> ConduitT (Either l r) r m () divertLeft sink = tapLeft sink .| projectRights {-# INLINE divertLeft #-}  -- | Sends every right-side value in a stream into a given `Sink`. -- Downstream receives the original `Either` value untouched. {-# DEPRECATED tapRight "Unsafe.  Do not use" #-}-tapRight :: Monad m => Sink r m () -> Conduit (Either l r) m (Either l r)+tapRight :: Monad m => ConduitT r Void m () -> ConduitT (Either l r) (Either l r) m () tapRight = tapWith projectRights {-# INLINE tapRight #-}  -- | Sends every right-side value in a stream into a given `Sink`. -- Downstream receives only left-side values. {-# DEPRECATED divertRight "Unsafe.  Do not use" #-}-divertRight :: Monad m => Sink r m () -> Conduit (Either l r) m l+divertRight :: Monad m => ConduitT r Void m () -> ConduitT (Either l r) l m () divertRight sink = tapRight sink .| projectLefts {-# INLINE divertRight #-}

@@ -3,9 +3,11 @@   ( runListConduit   ) where -import           Data.Conduit-import           Data.Conduit.List as CL-import           Prelude           as P+import Data.Conduit+import Prelude -runListConduit :: Conduit i [] o -> [i] -> [o]-runListConduit c is = P.concat $ sourceList is =$ c $$ consume+import qualified Data.Conduit.List as CL+import qualified Prelude           as P++runListConduit :: ConduitT i o [] () -> [i] -> [o]+runListConduit c is = P.concat $ runConduit $ CL.sourceList is .| c .| CL.consume