drinkery 0.2.1 → 0.2.2

raw patch · 5 files changed

+78/−60 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• benchmarks/benchmark.hs +36/−7
• drinkery.cabal +2/−2
• src/Data/Drinkery/Class.hs +25/−31
• src/Data/Drinkery/Distiller.hs +9/−10
• src/Data/Drinkery/Still.hs +6/−10

@@ -1,4 +1,3 @@-{-# OPTIONS -ddump-simpl -dsuppress-all #-}
 import Control.Arrow
 import Control.Monad
 import Data.Functor.Identity
@@ -46,14 +45,44 @@ {-# INLINE sourceM #-}
 
 main = defaultMain
-  [ bgroup "map-filter"
-      [ bench "drinkery/$&" $ whnfIO $ apply (\h -> sourceD D.++$ h D.+& drainD)
-          (mapFilter D.++$ mapFilter D.++$ mapFilter D.++$ mapFilter)
+  [ bgroup "drain"
+      [ bench "drinkery/Barman" $ whnfIO
+          $ apply (D.+& drainD)
+          $ D.runBarman (sourceSeq D.yield)
+      , bench "drinkery/Sommelier" $ whnfIO
+          $ apply (D.+& drainD) sourceD
+      , bench "pipes/Producer" $ whnfIO
+          $ apply (\s -> P.runEffect $ s P.>-> P.drain) sourceP
+      , bench "pipes/ListT" $ whnfIO
+          $ apply (\s -> P.runEffect $ s P.>-> P.drain)
+          $ P.enumerate (sourceAlt (P.Select . P.each))
+      , bench "list-t" $ whnfIO
+          $ apply (L.traverse_ $ const $ pure ())
+          $ sourceAlt L.fromFoldable
       ]
+  , bgroup "scan"
+      [ bench "drinkery" $ whnfIO $ apply (\h -> sourceD D.+& h D.$& drainD)
+          $ D.scan (+) 0
+      , bench "pipes" $ whnfIO $ apply (\p -> P.runEffect $ P.for (sourceP P.>-> p) P.discard)
+          $ P.scan (+) 0 id
+      , bench "conduit" $ whnfIO $ C.runConduit $ apply (\(h, s) -> sourceC C..| h C..| s)
+          (CC.scanl (+) 0, CC.sinkNull)
+      , bench "machines" $ whnfIO $ apply (M.runT_ . (sourceM M.~>))
+          $ M.scan (+) 0
+      ]
+   , bgroup "scan-chain"
+      [ bench "drinkery/++$" $ whnfIO $ apply (\h -> D.runBarman (sourceSeq D.yield) D.+& h D.$& drainD)
+          $ D.scan (+) 0 D.++$ D.scan (+) 0
+      , bench "drinkery/$&" $ whnfIO $ apply (\(h, h') -> D.runBarman (sourceSeq D.yield) D.+& h D.$& h' D.$& drainD)
+          (D.scan (+) 0, D.scan (+) 0)
+      , bench "pipes" $ whnfIO $ apply (\p -> P.runEffect $ P.for (sourceP P.>-> p) P.discard)
+          $ P.scan (+) 0 id P.>-> P.scan (+) 0 id
+      , bench "conduit" $ whnfIO $ apply (\(h, s) -> C.runConduit $ sourceC C..| h C..| s)
+          (CC.scanl (+) 0 C..| CC.scanl (+) 0, CC.sinkNull)
+      , bench "machines" $ whnfIO $ apply (M.runT_ . (sourceM M.~>))
+          $ M.scan (+) 0 M.~> M.scan (+) 0
+      ]
   ]
-
-mapFilter :: Monad m => D.Pipe Int Int m
-mapFilter = D.map' (+1) D.++$ D.filter (>0)
 
 apply :: (a -> b) -> a -> b
 apply f x = f x

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 8721a9c033d203203693686a359a7d6d4f5026ebbaaedd5de20c604fcbee478b+-- hash: a02d5f24aaf654476fe20d6324eebcaa59bf282ddc4946c5b15c83fbdb019481  name:           drinkery-version:        0.2.1+version:        0.2.2 synopsis:       Boozy streaming library description:    Please see the README on Github at <https://github.com/fumieval/drinkery#readme> category:       Control

@@ -13,12 +13,14 @@ module Data.Drinkery.Class   ( Drinker(..)   , mapDrinker+  , runDrinker   , MonadDrunk(..)   , CloseRequest(..)   , Closable(..)) where +import Control.Monad import Control.Monad.Trans.Class-import Control.Monad.Trans.Cont+import Control.Monad.Trans.Cont hiding (cont) import Control.Monad.Trans.Maybe import qualified Control.Monad.Trans.Reader as Reader import qualified Control.Monad.Trans.State.Lazy as Lazy@@ -33,40 +35,31 @@ import Control.Monad.State.Class  -- | A 'Drinker' is a stream consumer monad.-newtype Drinker t m a = Drinker { runDrinker :: t m -> m (a, t m) }+newtype Drinker t m a = Drinker+  { unDrinker :: forall r. t m -> (a -> t m -> m r) -> m r }  mapDrinker :: (forall x. m x -> m x) -> Drinker t m a -> Drinker t m a-mapDrinker t = Drinker . fmap t . runDrinker-{-# INLINE mapDrinker #-}+mapDrinker t (Drinker d) = Drinker $ \tap k -> t (d tap k) -instance (Functor m) => Functor (Drinker s m) where-  fmap f m = Drinker $ \s -> fmap (\(a, s') -> (f a, s')) $ runDrinker m s-  {-# INLINE fmap #-}+runDrinker :: Applicative m => Drinker t m a -> t m -> m (a, t m)+runDrinker (Drinker d) t = d t (\a t' -> pure (a, t')) -instance (Functor m, Monad m) => Applicative (Drinker s m) where-  pure a = Drinker $ \s -> return (a, s)-  {-# INLINE pure #-}-  Drinker mf <*> Drinker mx = Drinker $ \ s -> do-    (f, s') <- mf s-    (x, s'') <- mx s'-    return (f x, s'')-  {-# INLINE (<*>) #-}+instance Functor (Drinker s m) where+  fmap f m = Drinker $ \s k -> unDrinker m s (k . f)++instance Applicative (Drinker s m) where+  pure a = Drinker $ \s k -> k a s+  Drinker mf <*> Drinker mx = Drinker+    $ \s k -> mf s $ \f s' -> mx s' $ k . f   m *> k = m >>= \_ -> k-  {-# INLINE (*>) #-} -instance (Monad m) => Monad (Drinker s m) where-  return a = Drinker $ \s -> return (a, s)+instance Monad (Drinker s m) where+  return = pure   {-# INLINE return #-}-  m >>= k  = Drinker $ \s -> do-    (a, s') <- runDrinker m s-    runDrinker (k a) s'-  {-# INLINE (>>=) #-}-  fail str = Drinker $ \_ -> fail str-  {-# INLINE fail #-}+  m >>= k = Drinker $ \s cont -> unDrinker m s $ \a s' -> unDrinker (k a) s' cont  instance MonadTrans (Drinker t) where-  lift m = Drinker $ \t -> m >>= \a -> return (a, t)-  {-# INLINE lift #-}+  lift m = Drinker $ \t k -> m >>= \a -> k a t  instance MonadIO m => MonadIO (Drinker t m) where   liftIO = lift . liftIO@@ -83,19 +76,20 @@ instance MonadWriter s m => MonadWriter s (Drinker t m) where   writer = lift . writer   tell   = lift . tell-  listen m = Drinker $ \s -> do+  listen m = Drinker $ \s k -> do     ((a, s'), w) <- listen (runDrinker m s)-    return ((a, w), s')-  pass m = Drinker $ \s -> pass $ do+    k (a, w) s'+  pass m = Drinker $ \s k -> join $ pass $ do     ((a, f), s') <- runDrinker m s-    return ((a, s'), f)+    return (k a s', f)  -- | Monads that drink class Monad m => MonadDrunk t m | m -> t where   drinking :: (forall n. Monad n => t n -> n (a, t n)) -> m a  instance Monad m => MonadDrunk t (Drinker t m) where-  drinking = Drinker+  drinking f = Drinker $ \t k -> f t >>= uncurry k+  {-# INLINE drinking #-}  instance MonadDrunk t m => MonadDrunk t (Reader.ReaderT x m) where   drinking f = lift (drinking f)

@@ -32,7 +32,6 @@ import Data.Drinkery.Tap import Data.Drinkery.Class import Data.Semigroup-import Data.Tuple  -- | @Distiller tap m r s@ is a stream transducer which has four parameters: --@@ -57,8 +56,8 @@ -- * @+@ Left operand is a tap. -- * @+@ Returns a tap (along with the result). -- * @&@ Right operand is a Drinker.-(++&) :: (Functor m) => tap m -> Drinker tap m a -> m (tap m, a)-d ++& b = swap <$> runDrinker b d+(++&) :: (Applicative m) => tap m -> Drinker tap m a -> m (tap m, a)+d ++& b = unDrinker b d $ \a t -> pure (t, a) {-# INLINE (++&) #-}  -- | Attach a distiller to a tap.@@ -69,10 +68,10 @@ -- * @+@ Returns a tap. -- * @$@ Right operand is a distiller. ---(++$) :: (Functor m) => tap m -> Distiller tap r s m -> Tap r s m+(++$) :: (Applicative m) => tap m -> Distiller tap r s m -> Tap r s m (++$) = go where -- looks strange, but seems to perform better (GHC 8.2.2)-  go t d = Tap $ \r -> (\((s, d'), t') -> (s, go t' d'))-    <$> runDrinker (unTap d r) t+  go t d = Tap $ \r -> unDrinker (unTap d r) t+    $ \(s, d') t' -> pure (s, go t' d') {-# INLINE (++$) #-}  -- | Feed a tap to a drinker and close the used tap.@@ -101,10 +100,10 @@ {-# INLINE mapping #-}  -- | Get one element preserving a request-reservingTap :: MonadDrunk (Tap r a) m => (a -> m (s, Tap r s m)) -> Tap r s m-reservingTap k = Tap $ \r -> do-  a <- drinking $ \t -> unTap t r-  k a+reservingTap :: Monad m => (a -> Drinker (Tap r a) m (b, Distiller (Tap r a) r b m)) -> Distiller (Tap r a) r b m+reservingTap k = Tap $ \r -> Drinker $ \t cont -> do+  (a, t') <- unTap t r+  unDrinker (k a) t' cont {-# INLINE reservingTap #-}  traversing :: (Monad m) => (a -> m b) -> Distiller (Tap r a) r b m

@@ -17,11 +17,9 @@  scan :: Monad m => (b -> a -> b) -> b -> Pipe a b m scan f b0 = consTap (Just b0) $ go b0 where-  go b = Tap $ \r -> Drinker $ \tap -> do-    (m, t') <- unTap tap r-    case m of-      Just a -> let !b' = f b a in return ((Just b', go b'), t')-      Nothing -> return ((Nothing, go b), t')+  go b = reservingTap $ \case+    Just a -> let !b' = f b a in return (Just b', go b')+    Nothing -> return (Nothing, go b) {-# INLINE scan #-}  reserve :: (Monoid r, MonadDrunk (Cask r s) m)@@ -51,11 +49,9 @@  mapAccum :: Monad m => (s -> a -> (s, b)) -> s -> Pipe a b m mapAccum f = go where-  go s = Tap $ \r -> Drinker $ \tap -> do-    (m, t') <- unTap tap r-    case m of-      Just a -> let (s', b) = f s a in return ((Just b, go s'), t')-      Nothing -> return ((Nothing, go s), t')+  go s = reservingTap $ \case+    Just a -> let (s', b) = f s a in return (Just b, go s')+    Nothing -> return (Nothing, go s) {-# INLINE mapAccum #-}  traverse :: (Monad m) => (a -> m b) -> Pipe a b m