drinkery 0.2.2 → 0.3

raw patch · 11 files changed

+365/−365 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +12/−12
• drinkery.cabal +4/−4
• src/Data/Drinkery.hs +6/−2
• src/Data/Drinkery/Awaiter.hs +90/−0
• src/Data/Drinkery/Class.hs +52/−52
• src/Data/Drinkery/Distiller.hs +16/−16
• src/Data/Drinkery/Finite.hs +91/−0
• src/Data/Drinkery/IO.hs +3/−3
• src/Data/Drinkery/Patron.hs +0/−90
• src/Data/Drinkery/Still.hs +0/−95
• src/Data/Drinkery/Tap.hs +91/−91

@@ -5,32 +5,32 @@  ## Producers -drinkery supports three types of producers: `Barman`, `Sommelier`, and `Tap`.+drinkery supports three types of producers: `Producer`, `ListT`, and `Tap`. -`Barman r s` is a monad transformer to produce a stream of type `s`. It is good+`Producer r s` is a monad transformer to produce a stream of type `s`. It is good at interactively serving values.-`yield :: s -> Barman r s m a` is the primary action.+`yield :: s -> Producer r s m a` is the primary action. A barman can also accept requests from the downstream using `accept`. -`Sommelier r` is a list-like backtracking monad (also known as ListT done right).+`ListT r` is a list-like backtracking monad (also known as ListT done right). It is useful for sampling elements of containers with effects.-`taste :: Foldable f => f s -> Sommelier r m s` samples elements in any `Foldable`+`sample :: Foldable f => f s -> ListT r m s` samples elements in any `Foldable` container. `inquire` to interact with the downstream.  `Tap` is an endless producer. This can be connected to a 'Patron' or a 'Distiller'. -`Barman` and `Sommelier` are converted to `Tap`-by `runBarman` and `runSommelier` respectively.+`Producer` and `ListT` are converted to `Tap`+by `runProducer` and `runListT` respectively.  ## Consumer -`Drinker tap` is a monad transformer which consumes `tap`.+`Sink tap` is a monad transformer which consumes `tap`.  * `drink :: m s` Get one element. * `leftover :: s -> m ()` Leave one element. * `request :: r -> m ()` Send a request. -`(+&) :: (Monoid r, CloseRequest r, Monad m) => Tap r s m -> Drinker (Tap r s) m a -> m a`+`(+&) :: (Monoid r, CloseRequest r, Monad m) => Tap r s m -> Sink (Tap r s) m a -> m a` connects a tap with a drinker.  ## Transducer@@ -41,7 +41,7 @@ * Receives `r` * Produces `s` -It is actually a `Tap` where the underlying monad is `Drinker`.+It is actually a `Tap` where the underlying monad is `Sink`.  There are two composition operators: @@ -63,9 +63,9 @@  * `Distiller` does not terminate. * Unlike pipes' `>->`, `++$` propagates inner requests:-    * `(++$) :: Monad m => Distiller tap m p q -> Distiller (Tap p q) (Drinker tap m) r s -> Distiller tap m r s`+    * `(++$) :: Monad m => Distiller tap m p q -> Distiller (Tap p q) (Sink tap m) r s -> Distiller tap m r s`     * `(>->) :: Proxy a' a () b m r	-> Proxy () b c' c m r -> Proxy a' a c' c m r`-* `Drinker`, the consumer monad, may leave unconsumed inputs.+* `Sink`, the consumer monad, may leave unconsumed inputs. * `drinkery` has much fewer operators.  ### conduit

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: a02d5f24aaf654476fe20d6324eebcaa59bf282ddc4946c5b15c83fbdb019481+-- hash: f259ca772e145ebb7fecfea301b423b911d8d26903d9476e3e669d13bf3966a2  name:           drinkery-version:        0.2.2+version:        0.3 synopsis:       Boozy streaming library description:    Please see the README on Github at <https://github.com/fumieval/drinkery#readme> category:       Control@@ -41,8 +41,8 @@       Data.Drinkery.Combinators       Data.Drinkery.Distiller       Data.Drinkery.IO-      Data.Drinkery.Patron-      Data.Drinkery.Still+      Data.Drinkery.Awaiter+      Data.Drinkery.Finite       Data.Drinkery.Tap   other-modules:       Paths_drinkery

@@ -1,11 +1,15 @@ module Data.Drinkery-    ( module Data.Drinkery.Class+    ( module Data.Drinkery.Awaiter+    , module Data.Drinkery.Class     , module Data.Drinkery.Combinators     , module Data.Drinkery.Distiller+    , module Data.Drinkery.IO     , module Data.Drinkery.Tap-    )where+    ) where +import Data.Drinkery.Awaiter import Data.Drinkery.Class import Data.Drinkery.Combinators import Data.Drinkery.Distiller+import Data.Drinkery.IO import Data.Drinkery.Tap

@@ -0,0 +1,90 @@+{-# LANGUAGE LambdaCase, DeriveFunctor, FlexibleContexts #-}+module Data.Drinkery.Awaiter where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans+import Data.Drinkery.Class+import Data.Drinkery.Tap+import Data.Semigroup++-- | @Awaiter s@ is a simple consumer of @s@. Unlike 'Sink', it can be+-- partially run.+--+-- 'serving' distributes each input to a list of 'Awaiter's until all the patrons+-- terminate.+-- ('<|>') returns the first result.+--+newtype Awaiter s m a = Awaiter { runAwaiter :: m (Either (s -> Awaiter s m a) a) }++instance Functor m => Functor (Awaiter s m) where+  fmap f (Awaiter m) = Awaiter $ either (Left . (fmap f .)) (Right . f) <$> m++instance Monad m => Applicative (Awaiter s m) where+  pure a = Awaiter $ pure $ Right a+  {-# INLINE pure #-}+  m <*> k = Awaiter $ runAwaiter m >>= \case+    Right f -> runAwaiter $ f <$> k+    Left f -> pure $ Left $ (<*> k) . f++instance Monad m => Monad (Awaiter s m) where+  return = pure+  Awaiter m >>= k = Awaiter $ m >>= \case+    Right a -> runAwaiter (k a)+    Left f -> pure $ Left $ (>>=k) . f++instance MonadTrans (Awaiter s) where+  lift = Awaiter . fmap Right++instance Monad m => Alternative (Awaiter s m) where+  empty = Awaiter $ pure $ Left $ const empty+  Awaiter l <|> Awaiter r = Awaiter $ l >>= \case+    Left f -> r >>= \case+      Left g -> return $ Left $ \x -> f x <|> g x+      Right a -> return $ Right a+    Right a -> return $ Right a++instance Monad m => MonadPlus (Awaiter s m) where+  mzero = empty+  mplus = (<|>)++instance MonadIO m => MonadIO (Awaiter s m) where+  liftIO = Awaiter . fmap Right . liftIO++await :: Monad m => Awaiter s m s+await = Awaiter $ pure $ Left pure+{-# INLINE await #-}++serving_ :: Monad m => [Awaiter s m a] -> Awaiter s m ()+serving_ t0 = lift (gather runAwaiter t0) >>= go+  where+    gather k = loop where+      loop (m : ms) = k m >>= \case+        Left f -> (f :) <$> loop ms+        Right _ -> loop ms+      loop [] = pure []+    go [] = return ()+    go t = do+      s <- await+      lift (gather (\f -> runAwaiter (f s)) t) >>= go++iterAwaiter :: Monad m => m s -> Awaiter s m a -> m a+iterAwaiter k = go where+  go m = runAwaiter m >>= \case+    Left f -> k >>= go . f+    Right a -> return a+{-# INLINE iterAwaiter #-}++-- | @iterAwaiterT consume :: Awaiter s m a -> Sink s m a@+iterAwaiterT :: (Monad m, MonadTrans t, Monad (t m)) => t m s -> Awaiter s m a -> t m a+iterAwaiterT k = go where+  go m = lift (runAwaiter m) >>= \case+    Left f -> k >>= go . f+    Right a -> return a+{-# INLINE iterAwaiterT #-}++lookAheadT :: (Monad m, MonadTrans t, Monoid r, Semigroup r, MonadSink (Tap r s) (t m)) => Awaiter s m a -> t m a+lookAheadT = go [] where+  go xs m = lift (runAwaiter m) >>= \case+    Right a -> a <$ mapM_ leftover (reverse xs)+    Left f -> consume >>= \s -> go (s : xs) (f s)

@@ -11,10 +11,10 @@ -- Basic classes ----------------------------------------------------------------------- module Data.Drinkery.Class-  ( Drinker(..)-  , mapDrinker-  , runDrinker-  , MonadDrunk(..)+  ( Sink(..)+  , mapSink+  , runSink+  , MonadSink(..)   , CloseRequest(..)   , Closable(..)) where @@ -34,89 +34,89 @@ import Control.Monad.Writer.Class import Control.Monad.State.Class --- | A 'Drinker' is a stream consumer monad.-newtype Drinker t m a = Drinker-  { unDrinker :: forall r. t m -> (a -> t m -> m r) -> m r }+-- | A 'Sink' is a stream consumer monad.+newtype Sink t m a = Sink+  { unSink :: 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 d) = Drinker $ \tap k -> t (d tap k)+mapSink :: (forall x. m x -> m x) -> Sink t m a -> Sink t m a+mapSink t (Sink d) = Sink $ \tap k -> t (d tap k) -runDrinker :: Applicative m => Drinker t m a -> t m -> m (a, t m)-runDrinker (Drinker d) t = d t (\a t' -> pure (a, t'))+runSink :: Applicative m => Sink t m a -> t m -> m (a, t m)+runSink (Sink d) t = d t (\a t' -> pure (a, t')) -instance Functor (Drinker s m) where-  fmap f m = Drinker $ \s k -> unDrinker m s (k . f)+instance Functor (Sink s m) where+  fmap f m = Sink $ \s k -> unSink m s (k . f) -instance Applicative (Drinker s m) where-  pure a = Drinker $ \s k -> k a s-  Drinker mf <*> Drinker mx = Drinker+instance Applicative (Sink s m) where+  pure a = Sink $ \s k -> k a s+  Sink mf <*> Sink mx = Sink     $ \s k -> mf s $ \f s' -> mx s' $ k . f   m *> k = m >>= \_ -> k -instance Monad (Drinker s m) where+instance Monad (Sink s m) where   return = pure   {-# INLINE return #-}-  m >>= k = Drinker $ \s cont -> unDrinker m s $ \a s' -> unDrinker (k a) s' cont+  m >>= k = Sink $ \s cont -> unSink m s $ \a s' -> unSink (k a) s' cont -instance MonadTrans (Drinker t) where-  lift m = Drinker $ \t k -> m >>= \a -> k a t+instance MonadTrans (Sink t) where+  lift m = Sink $ \t k -> m >>= \a -> k a t -instance MonadIO m => MonadIO (Drinker t m) where+instance MonadIO m => MonadIO (Sink t m) where   liftIO = lift . liftIO -instance MonadReader r m => MonadReader r (Drinker t m) where+instance MonadReader r m => MonadReader r (Sink t m) where   ask = lift ask-  local f = mapDrinker (local f)+  local f = mapSink (local f) -instance MonadState s m => MonadState s (Drinker t m) where+instance MonadState s m => MonadState s (Sink t m) where   get = lift get   put = lift . put   state = lift . state -instance MonadWriter s m => MonadWriter s (Drinker t m) where+instance MonadWriter s m => MonadWriter s (Sink t m) where   writer = lift . writer   tell   = lift . tell-  listen m = Drinker $ \s k -> do-    ((a, s'), w) <- listen (runDrinker m s)+  listen m = Sink $ \s k -> do+    ((a, s'), w) <- listen (runSink m s)     k (a, w) s'-  pass m = Drinker $ \s k -> join $ pass $ do-    ((a, f), s') <- runDrinker m s+  pass m = Sink $ \s k -> join $ pass $ do+    ((a, f), s') <- runSink m s     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+class Monad m => MonadSink t m | m -> t where+  receiving :: (forall n. Monad n => t n -> n (a, t n)) -> m a -instance Monad m => MonadDrunk t (Drinker t m) where-  drinking f = Drinker $ \t k -> f t >>= uncurry k-  {-# INLINE drinking #-}+instance Monad m => MonadSink t (Sink t m) where+  receiving f = Sink $ \t k -> f t >>= uncurry k+  {-# INLINE receiving #-} -instance MonadDrunk t m => MonadDrunk t (Reader.ReaderT x m) where-  drinking f = lift (drinking f)+instance MonadSink t m => MonadSink t (Reader.ReaderT x m) where+  receiving f = lift (receiving f) -instance MonadDrunk t m => MonadDrunk t (Lazy.StateT x m) where-  drinking f = lift (drinking f)+instance MonadSink t m => MonadSink t (Lazy.StateT x m) where+  receiving f = lift (receiving f) -instance MonadDrunk t m => MonadDrunk t (Strict.StateT x m) where-  drinking f = lift (drinking f)+instance MonadSink t m => MonadSink t (Strict.StateT x m) where+  receiving f = lift (receiving f) -instance (Monoid x, MonadDrunk t m) => MonadDrunk t (Lazy.WriterT x m) where-  drinking f = lift (drinking f)+instance (Monoid x, MonadSink t m) => MonadSink t (Lazy.WriterT x m) where+  receiving f = lift (receiving f) -instance (Monoid x, MonadDrunk t m) => MonadDrunk t (Strict.WriterT x m) where-  drinking f = lift (drinking f)+instance (Monoid x, MonadSink t m) => MonadSink t (Strict.WriterT x m) where+  receiving f = lift (receiving f) -instance (Monoid y, MonadDrunk t m) => MonadDrunk t (Lazy.RWST x y z m) where-  drinking f = lift (drinking f)+instance (Monoid y, MonadSink t m) => MonadSink t (Lazy.RWST x y z m) where+  receiving f = lift (receiving f) -instance (Monoid y, MonadDrunk t m) => MonadDrunk t (Strict.RWST x y z m) where-  drinking f = lift (drinking f)+instance (Monoid y, MonadSink t m) => MonadSink t (Strict.RWST x y z m) where+  receiving f = lift (receiving f) -instance MonadDrunk t m => MonadDrunk t (MaybeT m) where-  drinking f = lift (drinking f)+instance MonadSink t m => MonadSink t (MaybeT m) where+  receiving f = lift (receiving f) -instance MonadDrunk t m => MonadDrunk t (ContT x m) where-  drinking f = lift (drinking f)+instance MonadSink t m => MonadSink t (ContT x m) where+  receiving f = lift (receiving f)  class CloseRequest a where   -- | A value representing a close request

@@ -1,7 +1,7 @@ {-# LANGUAGE Rank2Types, BangPatterns, LambdaCase, FlexibleContexts #-} ----------------------------------------------------------------------- ----- Module      :  Data.Drinkery.Distiller+-- Module      :  Data.Sinky.Distiller -- Copyright   :  (c) Fumiaki Kinoshita 2017 -- License     :  BSD3 --@@ -42,22 +42,22 @@ -- -- This is also a 'Tap'. ---type Distiller tap r s m = Tap r s (Drinker tap m)+type Distiller tap r s m = Tap r s (Sink tap m)  infix 6 +& infixr 7 $& infixr 7 ++& infixl 8 ++$ --- | Connect a tap with a Drinker. Flipped 'runDrinker'.+-- | Connect a tap with a Sink. Flipped 'runSink'. -- -- Mnemonic: -- -- * @+@ Left operand is a tap. -- * @+@ Returns a tap (along with the result).--- * @&@ Right operand is a Drinker.-(++&) :: (Applicative m) => tap m -> Drinker tap m a -> m (tap m, a)-d ++& b = unDrinker b d $ \a t -> pure (t, a)+-- * @&@ Right operand is a Sink.+(++&) :: (Applicative m) => tap m -> Sink tap m a -> m (tap m, a)+d ++& b = unSink b d $ \a t -> pure (t, a) {-# INLINE (++&) #-}  -- | Attach a distiller to a tap.@@ -70,24 +70,24 @@ -- (++$) :: (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 -> unDrinker (unTap d r) t+  go t d = Tap $ \r -> unSink (unTap d r) t     $ \(s, d') t' -> pure (s, go t' d') {-# INLINE (++$) #-}  -- | Feed a tap to a drinker and close the used tap.-(+&) :: (Closable tap, MonadCatch m) => tap m -> Drinker tap m a -> m a+(+&) :: (Closable tap, MonadCatch m) => tap m -> Sink tap m a -> m a t +& b = do-  (a, t') <- runDrinker b t `onException` close t+  (a, t') <- runSink b t `onException` close t   close t'   return a {-# INLINE (+&) #-}  -- | Like ('+&') but discards the used tap. ----- @($&) :: Distiller tap m r s -> Drinker (Tap r s) (Drinker tap m) a -> Drinker tap m a@+-- @($&) :: Distiller tap m r s -> Sink (Tap r s) (Sink tap m) a -> Sink tap m a@ ---($&) :: (Monad m) => tap m -> Drinker tap m a -> m a-t $& b = fmap fst $ runDrinker b t+($&) :: (Monad m) => tap m -> Sink tap m a -> m a+t $& b = fmap fst $ runSink b t {-# INLINE ($&) #-}  echo :: Monad m => Distiller (Tap r s) r s m@@ -100,10 +100,10 @@ {-# INLINE mapping #-}  -- | Get one element preserving a request-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+reservingTap :: Monad m => (a -> Sink (Tap r a) m (b, Distiller (Tap r a) r b m)) -> Distiller (Tap r a) r b m+reservingTap k = Tap $ \r -> Sink $ \t cont -> do   (a, t') <- unTap t r-  unDrinker (k a) t' cont+  unSink (k a) t' cont {-# INLINE reservingTap #-}  traversing :: (Monad m) => (a -> m b) -> Distiller (Tap r a) r b m@@ -128,7 +128,7 @@ {-# INLINE scanning #-}  -- | Create a request-preserving distiller from a drinker action.-repeating :: (MonadDrunk (Tap r a) m, Semigroup r) => m b -> Tap r b m+repeating :: (MonadSink (Tap r a) m, Semigroup r) => m b -> Tap r b m repeating m = go where   go = Tap $ \r -> do     request r

@@ -0,0 +1,91 @@+{-# LANGUAGE BangPatterns, Rank2Types, FlexibleContexts, LambdaCase #-}+module Data.Drinkery.Finite where++import Control.Monad (replicateM_)+import Data.Drinkery.Class+import Data.Drinkery.Distiller+import Data.Drinkery.Tap+import Data.Semigroup++-- | Finite source+type Source r s = Tap r (Maybe s)++-- | Mono in/out+type Converter p q r s m = Source r s (Sink (Source p q) m)++type Pipe a b m = forall r. (Monoid r, Semigroup r) => Converter r a r b m++scan :: Monad m => (b -> a -> b) -> b -> Pipe a b m+scan f b0 = consTap (Just b0) $ go b0 where+  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, MonadSink (Source r s) m)+    => (s -> Producer r (Maybe t) m ()) -> Producer r (Maybe t) m ()+reserve k = Producer $ \cont -> Tap $ \r -> receiving (\t -> unTap t r) >>= \case+  Nothing -> return (Nothing, cont ())+  Just s -> unTap (unProducer (k s) cont) mempty++map :: (Functor t, Monad m) => (a -> b) -> Distiller (Tap r (t a)) r (t b) m+map = mapping . fmap+{-# INLINE map #-}++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 #-}++mapAccum :: Monad m => (s -> a -> (s, b)) -> s -> Pipe a b m+mapAccum f = go where+  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+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 consume+  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, MonadSink (Tap r (Maybe s)) m) => m [s]+drinkUp = go id where+  go f = consume >>= maybe (pure $ f []) (\x -> go $ f . (x:))+{-# INLINE drinkUp #-}

@@ -7,10 +7,10 @@  -- | Create a popper from a 'Tap'. ----- @tapPopper :: CloseRequest r => Tap r s IO -> GivesPopper@+-- @popperTap :: CloseRequest r => Tap r s IO -> GivesPopper@ ---tapPopper :: (Monoid r, CloseRequest r) => Tap r s IO -> (IO s -> IO ()) -> IO ()-tapPopper tap0 needsPopper = do+popperTap :: (Monoid r, CloseRequest r) => Tap r s IO -> (IO s -> IO ()) -> IO ()+popperTap tap0 needsPopper = do   vTap <- newIORef tap0   let popper = do         t <- readIORef vTap

@@ -1,90 +0,0 @@-{-# LANGUAGE LambdaCase, DeriveFunctor, FlexibleContexts #-}-module Data.Drinkery.Patron where--import Control.Applicative-import Control.Monad-import Control.Monad.Trans-import Data.Drinkery.Class-import Data.Drinkery.Tap-import Data.Semigroup---- | @Patron s@ is a simple consumer of @s@. Unlike 'Drinker', it can be--- partially run.------ 'serving' distributes each input to a list of 'Patron's until all the patrons--- terminate.--- ('<|>') returns the first result.----newtype Patron s m a = Patron { runPatron :: m (Either (s -> Patron s m a) a) }--instance Functor m => Functor (Patron s m) where-  fmap f (Patron m) = Patron $ either (Left . (fmap f .)) (Right . f) <$> m--instance Monad m => Applicative (Patron s m) where-  pure a = Patron $ pure $ Right a-  {-# INLINE pure #-}-  m <*> k = Patron $ runPatron m >>= \case-    Right f -> runPatron $ f <$> k-    Left f -> pure $ Left $ (<*> k) . f--instance Monad m => Monad (Patron s m) where-  return = pure-  Patron m >>= k = Patron $ m >>= \case-    Right a -> runPatron (k a)-    Left f -> pure $ Left $ (>>=k) . f--instance MonadTrans (Patron s) where-  lift = Patron . fmap Right--instance Monad m => Alternative (Patron s m) where-  empty = Patron $ pure $ Left $ const empty-  Patron l <|> Patron r = Patron $ l >>= \case-    Left f -> r >>= \case-      Left g -> return $ Left $ \x -> f x <|> g x-      Right a -> return $ Right a-    Right a -> return $ Right a--instance Monad m => MonadPlus (Patron s m) where-  mzero = empty-  mplus = (<|>)--instance MonadIO m => MonadIO (Patron s m) where-  liftIO = Patron . fmap Right . liftIO--await :: Monad m => Patron s m s-await = Patron $ pure $ Left pure-{-# INLINE await #-}--serving_ :: Monad m => [Patron s m a] -> Patron s m ()-serving_ t0 = lift (gather runPatron t0) >>= go-  where-    gather k = loop where-      loop (m : ms) = k m >>= \case-        Left f -> (f :) <$> loop ms-        Right _ -> loop ms-      loop [] = pure []-    go [] = return ()-    go t = do-      s <- await-      lift (gather (\f -> runPatron (f s)) t) >>= go--iterPatron :: Monad m => m s -> Patron s m a -> m a-iterPatron k = go where-  go m = runPatron m >>= \case-    Left f -> k >>= go . f-    Right a -> return a-{-# INLINE iterPatron #-}---- | @iterPatronT drink :: Patron s m a -> Drinker s m a@-iterPatronT :: (Monad m, MonadTrans t, Monad (t m)) => t m s -> Patron s m a -> t m a-iterPatronT k = go where-  go m = lift (runPatron m) >>= \case-    Left f -> k >>= go . f-    Right a -> return a-{-# INLINE iterPatronT #-}--lookAheadT :: (Monad m, MonadTrans t, Monoid r, Semigroup r, MonadDrunk (Tap r s) (t m)) => Patron s m a -> t m a-lookAheadT = go [] where-  go xs m = lift (runPatron m) >>= \case-    Right a -> a <$ mapM_ leftover (reverse xs)-    Left f -> drink >>= \s -> go (s : xs) (f s)

@@ -1,95 +0,0 @@-{-# LANGUAGE BangPatterns, Rank2Types, FlexibleContexts, LambdaCase #-}-module Data.Drinkery.Still where--import Control.Applicative-import Control.Monad (replicateM_)-import Data.Drinkery.Class-import Data.Drinkery.Distiller-import Data.Drinkery.Tap-import Data.Semigroup--type Cask r s = Tap r (Maybe s)---- | Mono in/out-type Still p q r s m = Cask r s (Drinker (Cask p q) m)--type Pipe a b m = forall r. (Monoid r, Semigroup r) => Still r a r b m--scan :: Monad m => (b -> a -> b) -> b -> Pipe a b m-scan f b0 = consTap (Just b0) $ go b0 where-  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)-    => (s -> Barman r (Maybe t) m ()) -> Barman r (Maybe t) m ()-reserve k = Barman $ \cont -> Tap $ \r -> drinking (\t -> unTap t r) >>= \case-  Nothing -> return (Nothing, cont ())-  Just s -> unTap (unBarman (k s) cont) mempty--map :: (Functor t, Monad m) => (a -> b) -> Distiller (Tap r (t a)) r (t b) m-map = mapping . fmap-{-# INLINE map #-}--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 #-}--mapAccum :: Monad m => (s -> a -> (s, b)) -> s -> Pipe a b m-mapAccum f = go where-  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-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 = 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-{-# INLINE sip #-}

@@ -19,26 +19,26 @@   , repeatTapM   , repeatTapM'   , Joint(..)-  -- * Barman-  , Barman(..)+  -- * Producer+  , Producer(..)   , yield   , accept   , inexhaustible-  , runBarman-  , runBarman'-  , pour-  -- * Sommelier-  , Sommelier(..)-  , taste+  , tapProducer+  , tapProducer'+  , produce+  -- * ListT+  , ListT(..)+  , sample   , inquire-  , runSommelier-  , runSommelier'-  , retractSommelier-  -- * Drinker-  , drink+  , tapListT+  , tapListT'+  , retractListT+  -- * Sink+  , consume   , leftover   , request-  , smell+  , prefetch   -- * End of stream   , eof ) where@@ -86,25 +86,25 @@ instance CloseRequest r => Closable (Tap r s) where   close t = void $ unTap t closeRequest -drink :: (Monoid r, MonadDrunk (Tap r s) m) => m s-drink = drinking $ \t -> unTap t mempty-{-# INLINE drink #-}+consume :: (Monoid r, MonadSink (Tap r s) m) => m s+consume = receiving $ \t -> unTap t mempty+{-# INLINE consume #-} -leftover :: (Semigroup r, MonadDrunk (Tap r s) m) => s -> m ()-leftover s = drinking $ \t -> return ((), consTap s t)+leftover :: (Semigroup r, MonadSink (Tap r s) m) => s -> m ()+leftover s = receiving $ \t -> return ((), consTap s t) {-# INLINE leftover #-} -request :: (Semigroup r, MonadDrunk (Tap r s) m) => r -> m ()-request r = drinking $ \t -> return ((), orderTap r t)+request :: (Semigroup r, MonadSink (Tap r s) m) => r -> m ()+request r = receiving $ \t -> return ((), orderTap r t) {-# INLINE request #-}  -- | Get one element without consuming.-smell :: (Monoid r, Semigroup r, MonadDrunk (Tap r s) m) => m s-smell = do-  s <- drink+prefetch :: (Monoid r, Semigroup r, MonadSink (Tap r s) m) => m s+prefetch = do+  s <- consume   leftover s   return s-{-# INLINE smell #-}+{-# INLINE prefetch #-}  -- | ('<*>') zips two taps. newtype Joint r m s = Joint { unJoint :: Tap r s m }@@ -124,114 +124,114 @@   {-# INLINE (<*>) #-}  -- | Monadic producer-newtype Barman r s m a = Barman { unBarman :: (a -> Tap r s m) -> Tap r s m }+newtype Producer r s m a = Producer { unProducer :: (a -> Tap r s m) -> Tap r s m } -instance Functor (Barman r s m) where-  fmap f (Barman m) = Barman $ \cont -> m (cont . f)+instance Functor (Producer r s m) where+  fmap f (Producer m) = Producer $ \cont -> m (cont . f) -instance Applicative (Barman r s m) where+instance Applicative (Producer r s m) where   pure = return-  Barman m <*> Barman k = Barman $ \cont -> m $ \f -> k $ cont . f+  Producer m <*> Producer k = Producer $ \cont -> m $ \f -> k $ cont . f -instance Monad (Barman r s m) where-  return a = Barman ($ a)-  Barman m >>= k = Barman $ \cont -> m $ \a -> unBarman (k a) cont+instance Monad (Producer r s m) where+  return a = Producer ($ a)+  Producer m >>= k = Producer $ \cont -> m $ \a -> unProducer (k a) cont -instance MonadTrans (Barman r s) where-  lift m = Barman $ \k -> Tap $ \rs -> m >>= \a -> unTap (k a) rs+instance MonadTrans (Producer r s) where+  lift m = Producer $ \k -> Tap $ \rs -> m >>= \a -> unTap (k a) rs -instance MonadIO m => MonadIO (Barman r s m) where-  liftIO m = Barman $ \k -> Tap $ \rs -> liftIO m >>= \a -> unTap (k a) rs+instance MonadIO m => MonadIO (Producer r s m) where+  liftIO m = Producer $ \k -> Tap $ \rs -> liftIO m >>= \a -> unTap (k a) rs -instance MonadDrunk t m => MonadDrunk t (Barman p q m) where-  drinking f = lift (drinking f)+instance MonadSink t m => MonadSink t (Producer p q m) where+  receiving f = lift (receiving f)  -- | Produce one element. Orders are put off.-pour :: (Semigroup r, Applicative m) => s -> Barman r s m ()-pour s = Barman $ \cont -> consTap s (cont ())+produce :: (Semigroup r, Applicative m) => s -> Producer r s m ()+produce s = Producer $ \cont -> consTap s (cont ())  -- | Accept orders and clear the queue.-accept :: Monoid r => Barman r s m r-accept = Barman $ \cont -> Tap $ \rs -> unTap (cont rs) mempty+accept :: Monoid r => Producer r s m r+accept = Producer $ \cont -> Tap $ \rs -> unTap (cont rs) mempty --- | Create a infinite 'Tap' from a 'Barman'.+-- | Create a infinite 'Tap' from a 'Producer'. ----- @inexhaustible :: 'Barman' r s ('Drinker' tap m) x -> 'Distiller' tap m r s@+-- @inexhaustible :: 'Producer' r s ('Sink' tap m) x -> 'Distiller' tap m r s@ ---inexhaustible :: Barman r s m x -> Tap r s m+inexhaustible :: Producer r s m x -> Tap r s m inexhaustible t = go where-  go = unBarman t $ const go+  go = unProducer t $ const go {-# INLINE inexhaustible #-}  -- | Backtracking producer a.k.a. "ListT done right".-newtype Sommelier r m s = Sommelier-  { unSommelier :: forall x. (s -> Tap r x m -> Tap r x m) -> Tap r x m -> Tap r x m }+newtype ListT r m s = ListT+  { unListT :: forall x. (s -> Tap r x m -> Tap r x m) -> Tap r x m -> Tap r x m } -instance Functor (Sommelier r m) where-  fmap f m = Sommelier $ \c e -> unSommelier m (c . f) e+instance Functor (ListT r m) where+  fmap f m = ListT $ \c e -> unListT m (c . f) e -instance Applicative (Sommelier r m) where+instance Applicative (ListT r m) where   pure = return   (<*>) = ap -instance Monad (Sommelier r m) where-  return s = Sommelier $ \c e -> c s e-  m >>= k = Sommelier $ \c e -> unSommelier m (\s -> unSommelier (k s) c) e+instance Monad (ListT r m) where+  return s = ListT $ \c e -> c s e+  m >>= k = ListT $ \c e -> unListT m (\s -> unListT (k s) c) e -instance Alternative (Sommelier r m) where-  empty = Sommelier $ \_ e -> e-  a <|> b = Sommelier $ \c e -> unSommelier a c (unSommelier b c e)+instance Alternative (ListT r m) where+  empty = ListT $ \_ e -> e+  a <|> b = ListT $ \c e -> unListT a c (unListT b c e) -instance MonadPlus (Sommelier r m) where+instance MonadPlus (ListT r m) where   mzero = empty   mplus = (<|>) -instance MonadTrans (Sommelier r) where-  lift m = Sommelier $ \c e -> Tap $ \rs -> m >>= \a -> unTap (c a e) rs+instance MonadTrans (ListT r) where+  lift m = ListT $ \c e -> Tap $ \rs -> m >>= \a -> unTap (c a e) rs -instance MonadIO m => MonadIO (Sommelier r m) where-  liftIO m = Sommelier $ \c e -> Tap $ \rs -> liftIO m >>= \a -> unTap (c a e) rs+instance MonadIO m => MonadIO (ListT r m) where+  liftIO m = ListT $ \c e -> Tap $ \rs -> liftIO m >>= \a -> unTap (c a e) rs -instance MonadDrunk t m => MonadDrunk t (Sommelier p m) where-  drinking f = lift (drinking f)+instance MonadSink t m => MonadSink t (ListT p m) where+  receiving f = lift (receiving f)  -- | Take all the elements in a 'Foldable' container.-taste :: Foldable f => f s -> Sommelier r m s-taste xs = Sommelier $ \c e -> foldr c e xs+sample :: Foldable f => f s -> ListT r m s+sample xs = ListT $ \c e -> foldr c e xs  -- | Get a request.-inquire :: Monoid r => Sommelier r m r-inquire = Sommelier $ \c e -> Tap $ \rs -> unTap (c rs e) mempty+inquire :: Monoid r => ListT r m r+inquire = ListT $ \c e -> Tap $ \rs -> unTap (c rs e) mempty  -- | End of stream eof :: (Applicative m, Alternative f) => Tap r (f a) m eof = repeatTap empty --- | Run a 'Barman' action and terminate the stream with 'eof'.-runBarman :: (Monoid r, Applicative m, Alternative f) => Barman r (f s) m a -> Tap r (f s) m-runBarman m = unBarman m (const eof)-{-# INLINE runBarman #-}+-- | 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 m = unProducer m (const eof)+{-# INLINE tapProducer #-} --- | Specialised 'runBarman'-runBarman' :: (Applicative m, Alternative f) => Barman () (f s) m a -> Tap () (f s) m-runBarman' = runBarman-{-# INLINE runBarman' #-}+-- | Specialised 'runProducer'+tapProducer' :: (Applicative m, Alternative f) => Producer () (f s) m a -> Tap () (f s) m+tapProducer' = tapProducer+{-# INLINE tapProducer' #-} --- | Run 'Sommelier' and terminate the stream with 'eof'.-runSommelier :: (Semigroup r, Applicative m, Alternative f) => Sommelier r m s -> Tap r (f s) m-runSommelier m = unSommelier m (consTap . pure) eof-{-# INLINE runSommelier #-}+-- | 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 m = unListT m (consTap . pure) eof+{-# INLINE tapListT #-} --- | Specialised 'runSommelier'-runSommelier' :: (Applicative m, Alternative f) => Sommelier () m s -> Tap () (f s) m-runSommelier' = runSommelier-{-# INLINE runSommelier' #-}+-- | Specialised 'runListT'+tapListT' :: (Applicative m, Alternative f) => ListT () m s -> Tap () (f s) m+tapListT' = tapListT+{-# INLINE tapListT' #-} -retractSommelier :: Monad m => Sommelier () m s -> m ()-retractSommelier (Sommelier f) = go $ f (const $ consTap True) (repeatTap False) where+retractListT :: Monad m => ListT () m s -> m ()+retractListT (ListT f) = go $ f (const $ consTap True) (repeatTap False) where   go m = unTap m () >>= \(a, k) -> when a (go k)-{-# INLINE retractSommelier #-}+{-# INLINE retractListT #-} -yield :: (Semigroup r, Applicative f, Applicative m) => s -> Barman r (f s) m ()-yield = pour . pure-{-# INLINE pour #-}+yield :: (Semigroup r, Applicative f, Applicative m) => s -> Producer r (f s) m ()+yield = produce . pure+{-# INLINE yield #-}