Extras.hs

-- | Convenience methods, plus 'bracketPipe'.
--

module Piped.Extras where

import Data.Function

import Piped.Internal


-- | Yield all values from a foldable data structure such as a list.
--
sourceList :: (Monad m, Foldable t) => t o -> Pipe () o m ()
sourceList = foldMap yield
{-# INLINE sourceList #-}

-- | Return all input values as a list.
--
sinkList :: Pipe i Void m [i]
sinkList = Pipe $
  \rest l r ->
    fix2 l id $
      \go l fxs ->
        let term = rest termLeft r $ fxs []
         in runAwait l term $ \i l -> go l $ fxs . (i:)
{-# INLINE sinkList #-}

-- | Consume all values using given function
--
awaitForever :: Monad m => (i -> Pipe i o m a) -> Pipe i o m ()
awaitForever f = Pipe $
  \rest ->
    fix $
      \next await yield -> 
        runAwait await (rest termLeft yield ()) $
          \i await ->
            unPipe (f i) (\l r _ -> next l r) await yield
{-# INLINE awaitForever #-}

-- | Discard all input values
--
sinkNull :: Monad m => Pipe i Void m ()
sinkNull = Pipe $
  \rest l r -> do
    let term = rest termLeft r ()
        f l = runAwait l term $ \_ -> f
     in f l
{-# INLINE sinkNull #-}

-- | Basically `await >>= maybe ...`, but avoids the conversion to a maybe type.
--
awaitMaybe :: Pipe i o m a -> (i -> Pipe i o m a) -> Pipe i o m a
awaitMaybe def act = Pipe $
  \rest l r ->
    runAwait l (unPipe def rest termLeft r)
               (\i l -> unPipe (act i) rest l r)
{-# INLINE awaitMaybe #-}


-- | Act on a value, if there is no value then return ().
--
awaitJust :: Monad m => (i -> Pipe i o m ()) -> Pipe i o m ()
awaitJust act = Pipe $
  \rest l r ->
    runAwait l (rest termLeft r ()) $
      \i l -> unPipe (act i) rest l r
{-# INLINE awaitJust #-}


-- | Yield the result of a monadic action.
--
yieldM :: Monad m => Pipe i o m o -> Pipe i o m ()
yieldM = (>>= yield)
{-# INLINE yieldM #-}


-- | This is the same as [bracketP](http://hackage.haskell.org/package/conduit-1.3.1.1/docs/Data-Conduit.html#v:bracketP) from Conduit, however it's not specialised to MonadResource.
--
bracketPipe :: Monad m => m b -> (b -> m ()) -> (b -> Pipe i o m a) -> Pipe i o m a
bracketPipe alloc free inside = Pipe $
  \rest l r -> do
    b <- alloc
    let rest' l r a = free b >> rest l r a
    unPipe (inside b) rest' l r