drinkery 0.2 → 0.2.1

raw patch · 6 files changed

+85/−44 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• benchmarks/benchmark.hs +7/−36
• drinkery.cabal +2/−2
• src/Data/Drinkery/Combinators.hs +9/−0
• src/Data/Drinkery/Distiller.hs +2/−1
• src/Data/Drinkery/Still.hs +44/−4
• src/Data/Drinkery/Tap.hs +21/−1

@@ -1,3 +1,4 @@+{-# OPTIONS -ddump-simpl -dsuppress-all #-}
 import Control.Arrow
 import Control.Monad
 import Data.Functor.Identity
@@ -45,44 +46,14 @@ {-# INLINE sourceM #-}
 
 main = defaultMain
-  [ 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
+  [ bgroup "map-filter"
+      [ bench "drinkery/$&" $ whnfIO $ apply (\h -> sourceD D.++$ h D.+& drainD)
+          (mapFilter D.++$ mapFilter D.++$ mapFilter D.++$ mapFilter)
       ]
   ]
+
+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: c680196ca0c264db17dcb6cca154fa3a64e957e2d4859e8dd024c4b302e0f731+-- hash: 8721a9c033d203203693686a359a7d6d4f5026ebbaaedd5de20c604fcbee478b  name:           drinkery-version:        0.2+version:        0.2.1 synopsis:       Boozy streaming library description:    Please see the README on Github at <https://github.com/fumieval/drinkery#readme> category:       Control

@@ -13,9 +13,11 @@   , foldMFrom   , traverseFrom_   , drainFrom+  , lastFrom   ) where +import Control.Applicative import Control.Monad hiding (foldM) import qualified Data.Foldable as F @@ -48,3 +50,10 @@ drainFrom m = go where   go = m >>= \t -> unless (null t) go {-# INLINE drainFrom #-}++lastFrom :: (Alternative t, Foldable t, Monad m) => m (t a) -> m (Maybe a)+lastFrom m = go empty where+  go l = m >>= \t -> if null t+    then return $! foldr (\x r _ -> r (Just x)) id l Nothing+    else go t+{-# INLINE lastFrom #-}

@@ -93,10 +93,11 @@  echo :: Monad m => Distiller (Tap r s) r s m echo = mapping id+{-# INLINE echo #-}  mapping :: (Monad m) => (a -> b) -> Distiller (Tap r a) r b m mapping f = go where-  go = Tap $ \r -> drinking $ \t -> fmap (\(s, t') -> ((f s, go), t')) $ unTap t r+  go = reservingTap $ \a -> pure (f a, go) {-# INLINE mapping #-}  -- | Get one element preserving a request

@@ -2,6 +2,7 @@ module Data.Drinkery.Still where  import Control.Applicative+import Control.Monad (replicateM_) import Data.Drinkery.Class import Data.Drinkery.Distiller import Data.Drinkery.Tap@@ -33,10 +34,17 @@ map = mapping . fmap {-# INLINE map #-} -mapMaybe :: (Monad m) => (a -> Maybe b) -> Pipe a b m-mapMaybe f = inexhaustible $ reserve $ mapM_ yield . f-{-# INLINE mapMaybe #-}+map' :: (Functor t, Monad m) => (a -> b) -> Distiller (Tap r (t a)) r (t b) m+map' f = traversing $ (pure$!) . fmap f+{-# INLINE map' #-} +concatMap :: (Foldable f, Monad m) => (a -> f b) -> Pipe a b m+concatMap f = go where+  go = reservingTap $ \case+    Just a -> unTap (foldr (consTap . Just) go (f a)) mempty+    Nothing -> return (Nothing, go)+{-# INLINE concatMap #-}+ filter :: Monad m => (a -> Bool) -> Pipe a a m filter = filtering . maybe True {-# INLINE filter #-}@@ -50,9 +58,41 @@       Nothing -> return ((Nothing, go s), t') {-# INLINE mapAccum #-} +traverse :: (Monad m) => (a -> m b) -> Pipe a b m+traverse = traversing . Prelude.traverse+{-# INLINE traverse #-}++take :: Monad m => Int -> Pipe a a m+take = go where+  go 0 = repeatTap Nothing+  go n = reservingTap $ \a -> return (a, go (n - 1))+{-# INLINE take #-}++drop :: Monad m => Int -> Pipe a a m+drop n = makeTap $ do+  replicateM_ n drink+  return echo+{-# INLINE drop #-}++takeWhile :: Monad m => (a -> Bool) -> Pipe a a m+takeWhile p = go where+  go = reservingTap $ \case+    Just s | p s -> return (Just s, go)+    _ -> return (Nothing, go)+{-# INLINE takeWhile #-}++dropWhile :: Monad m => (a -> Bool) -> Pipe a a m+dropWhile p = go where+  go = reservingTap $ \case+    Just s | p s -> unTap go mempty+    x -> return (x, go)+{-# INLINE dropWhile #-}+ -- | Consume all the content of a 'Tap' and return the elements as a list. drinkUp :: (Monoid r, Semigroup r, MonadDrunk (Tap r (Maybe s)) m) => m [s]-drinkUp = drink >>= maybe (pure []) (\x -> (x:) <$> drinkUp)+drinkUp = go id where+  go f = drink >>= maybe (pure $ f []) (\x -> go $ f . (x:))+{-# INLINE drinkUp #-}  sip :: (Monoid r, Alternative m, MonadDrunk (Tap r (Maybe s)) m) => m s sip = drink >>= maybe empty pure

@@ -18,6 +18,7 @@   , repeatTap   , repeatTapM   , repeatTapM'+  , Joint(..)   -- * Barman   , Barman(..)   , yield@@ -105,6 +106,23 @@   return s {-# INLINE smell #-} +-- | ('<*>') zips two taps.+newtype Joint r m s = Joint { unJoint :: Tap r s m }++instance Functor m => Functor (Joint r m) where+  fmap f (Joint tap0) = Joint (go tap0) where+    go tap = Tap $ \r -> fmap (\(s, t) -> (f s, go t)) $ unTap tap r+  {-# INLINE fmap #-}++instance Applicative m => Applicative (Joint r m) where+  pure = Joint . repeatTap+  {-# INLINE pure #-}+  Joint tapF <*> Joint tapA = Joint (go tapF tapA) where+    go s t = Tap $ \r -> (\(f, s') (x, t') -> (f x, go s' t'))+      <$> unTap s r+      <*> unTap t r+  {-# INLINE (<*>) #-}+ -- | Monadic producer newtype Barman r s m a = Barman { unBarman :: (a -> Tap r s m) -> Tap r s m } @@ -141,7 +159,9 @@ -- @inexhaustible :: 'Barman' r s ('Drinker' tap m) x -> 'Distiller' tap m r s@ -- inexhaustible :: Barman r s m x -> Tap r s m-inexhaustible t = unBarman t $ const $ inexhaustible t+inexhaustible t = go where+  go = unBarman t $ const go+{-# INLINE inexhaustible #-}  -- | Backtracking producer a.k.a. "ListT done right". newtype Sommelier r m s = Sommelier