drinkery 0.3 → 0.4

raw patch · 3 files changed

+37/−118 lines, 3 filesdep −ListTdep −conduitdep −conduit-combinatorsdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies removed: ListT, conduit, conduit-combinators, drinkery, gauge, list-t, machines, pipes

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• benchmarks/benchmark.hs +0/−89
• drinkery.cabal +2/−25
• src/Data/Drinkery/Tap.hs +35/−4

@@ -1,89 +0,0 @@-import Control.Arrow
-import Control.Monad
-import Data.Functor.Identity
-import Data.List
-import Data.Void
-import Gauge.Main
-import qualified Data.Drinkery as D
-import qualified Data.Drinkery.Still as D
-import qualified ListT as L
-import qualified Pipes as P
-import qualified Pipes.Prelude as P
-import qualified Data.Conduit as C
-import qualified Data.Conduit.Combinators as CC
-import qualified Data.Machine as M
-
-drainD :: Monad m => D.Drinker (D.Tap () (Maybe a)) m ()
-drainD = D.drainFrom D.drink
-
-sourceAlt :: Monad m => ([Int] -> m Int) -> m Int
-sourceAlt k = do
-  a <- k [1..50]
-  b <- k [1..a]
-  c <- k [1..b]
-  return $! a + b + c
-{-# INLINE sourceAlt #-}
-
-sourceSeq :: Monad m => (Int -> m ()) -> m ()
-sourceSeq k = forM_ [1..50] $ \a -> forM_ [1..a] $ \b -> forM_ [1..b] $ \c -> k $! a + b + c
-{-# INLINE sourceSeq #-}
-
-sourceD :: Monad m => D.Cask () Int m
-sourceD = D.runSommelier (sourceAlt D.taste)
-{-# INLINE sourceD #-}
-
-sourceP :: Monad m => P.Producer Int m ()
-sourceP = sourceSeq P.yield
-{-# INLINE sourceP #-}
-
-sourceC :: Monad m => C.ConduitT i Int m ()
-sourceC = sourceSeq C.yield
-{-# INLINE sourceC #-}
-
-sourceM :: M.Source Int
-sourceM = M.construct $ sourceSeq M.yield
-{-# 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
-      ]
-  ]
-
-apply :: (a -> b) -> a -> b
-apply f x = f x
-{-# NOINLINE apply #-}

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: f259ca772e145ebb7fecfea301b423b911d8d26903d9476e3e669d13bf3966a2+-- hash: 8c6f05381b2f5eba2a29b87397f15a1e5a2ad86c86725e5b8360e6d81417581b  name:           drinkery-version:        0.3+version:        0.4 synopsis:       Boozy streaming library description:    Please see the README on Github at <https://github.com/fumieval/drinkery#readme> category:       Control@@ -44,29 +44,6 @@       Data.Drinkery.Awaiter       Data.Drinkery.Finite       Data.Drinkery.Tap-  other-modules:-      Paths_drinkery-  default-language: Haskell2010--benchmark benchmark-  type: exitcode-stdio-1.0-  main-is: benchmark.hs-  hs-source-dirs:-      benchmarks-  ghc-options: -O2-  build-depends:-      ListT-    , base-    , conduit-    , conduit-combinators-    , drinkery-    , exceptions-    , gauge-    , list-t-    , machines-    , mtl-    , pipes-    , transformers   other-modules:       Paths_drinkery   default-language: Haskell2010

@@ -15,9 +15,11 @@   , consTap   , orderTap   , makeTap+  , transTap   , repeatTap   , repeatTapM   , repeatTapM'+  , unfoldrTapM   , Joint(..)   -- * Producer   , Producer(..)@@ -47,6 +49,8 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Class+import Control.Monad.Reader.Class+import Control.Monad.State.Class import Data.Semigroup import Data.Drinkery.Class @@ -64,6 +68,11 @@ orderTap r t = Tap $ \r' -> unTap t $! r <> r' {-# INLINE orderTap #-} +transTap :: Functor n => (forall x. m x -> n x) -> Tap r s m -> Tap r s n+transTap t = go where+  go (Tap f) = Tap $ \r -> fmap go <$> t (f r)+{-# INLINE transTap #-}+ -- | Involve an action. makeTap :: (Monad m) => m (Tap r s m) -> Tap r s m makeTap m = Tap $ \r -> m >>= \t -> unTap t r@@ -83,6 +92,10 @@ repeatTapM' = repeatTapM {-# INLINE repeatTapM' #-} +unfoldrTapM :: Applicative m => (r -> s -> m (a, s)) -> s -> Tap r a m+unfoldrTapM f = go where+  go s = Tap $ \r -> fmap go <$> f r s+ instance CloseRequest r => Closable (Tap r s) where   close t = void $ unTap t closeRequest @@ -146,6 +159,15 @@ instance MonadSink t m => MonadSink t (Producer p q m) where   receiving f = lift (receiving f) +instance MonadReader r m => MonadReader r (Producer p q m) where+  ask = lift ask+  local f (Producer m) = Producer $ \k -> transTap (local f) (m k)++instance MonadState s m => MonadState s (Producer p q m) where+  get = lift get+  put = lift . put+  state = lift . state+ -- | Produce one element. Orders are put off. produce :: (Semigroup r, Applicative m) => s -> Producer r s m () produce s = Producer $ \cont -> consTap s (cont ())@@ -195,6 +217,15 @@ instance MonadSink t m => MonadSink t (ListT p m) where   receiving f = lift (receiving f) +instance MonadReader r m => MonadReader r (ListT p m) where+  ask = lift ask+  local f (ListT m) = ListT $ \c e -> transTap (local f) (m c e)++instance MonadState s m => MonadState s (ListT p m) where+  get = lift get+  put = lift . put+  state = lift . state+ -- | Take all the elements in a 'Foldable' container. sample :: Foldable f => f s -> ListT r m s sample xs = ListT $ \c e -> foldr c e xs@@ -208,22 +239,22 @@ eof = repeatTap empty  -- | Run a 'Producer' action and terminate the stream with 'eof'.-tapProducer :: (Monoid r, Applicative m, Alternative f) => Producer r (f s) m a -> Tap r (f s) m+tapProducer :: (Monoid r, Applicative m) => Producer r (Maybe s) m a -> Tap r (Maybe s) m tapProducer m = unProducer m (const eof) {-# INLINE tapProducer #-}  -- | Specialised 'runProducer'-tapProducer' :: (Applicative m, Alternative f) => Producer () (f s) m a -> Tap () (f s) m+tapProducer' :: (Applicative m) => Producer () (Maybe s) m a -> Tap () (Maybe s) m tapProducer' = tapProducer {-# INLINE tapProducer' #-}  -- | Run 'ListT' and terminate the stream with 'eof'.-tapListT :: (Semigroup r, Applicative m, Alternative f) => ListT r m s -> Tap r (f s) m+tapListT :: (Semigroup r, Applicative m) => ListT r m s -> Tap r (Maybe s) m tapListT m = unListT m (consTap . pure) eof {-# INLINE tapListT #-}  -- | Specialised 'runListT'-tapListT' :: (Applicative m, Alternative f) => ListT () m s -> Tap () (f s) m+tapListT' :: (Applicative m) => ListT () m s -> Tap () (Maybe s) m tapListT' = tapListT {-# INLINE tapListT' #-}