-- |
-- Module : Benchmarks.Conduit
-- Copyright : (c) 2018 Harendra Kumar
--
-- License : MIT
-- Maintainer : harendra.kumar@gmail.com
module Benchmarks.Conduit where
import Benchmarks.Common (value, maxValue, appendValue)
import Prelude
(Monad, Int, (+), ($), return, even, (>), (<=),
subtract, undefined, replicate, (<$>), (<*>), Maybe(..), foldMap, (.),
maxBound)
import qualified Prelude as P
import Data.Semigroup ((<>))
import qualified Data.Conduit as S
import qualified Data.Conduit.Combinators as S
import qualified Data.Conduit.List as SL
-- import Data.Conduit.List (sourceList)
-------------------------------------------------------------------------------
-- Stream generation and elimination
-------------------------------------------------------------------------------
type Source m i a = S.ConduitT i a m ()
type Sink m a r = S.ConduitT a S.Void m r
type Pipe m a b = S.ConduitT a b m ()
{-# INLINE source #-}
source :: Monad m => Int -> Source m () Int
-- source n = sourceList [n..n+value]
source n = SL.unfoldM step n
where
step cnt =
if cnt > n + value
then return Nothing
else return (Just (cnt, cnt + 1))
-------------------------------------------------------------------------------
-- Append
-------------------------------------------------------------------------------
{-# INLINE appendSourceR #-}
appendSourceR :: Monad m => Int -> Source m () Int
appendSourceR n = foldMap (S.yieldM . return) [n..n+appendValue]
{-# INLINE appendSourceL #-}
appendSourceL :: Monad m => Int -> Source m () Int
appendSourceL n =
P.foldl (<>) P.mempty (P.map (S.yieldM . return) [n..n+appendValue])
-------------------------------------------------------------------------------
-- Elimination
-------------------------------------------------------------------------------
-- eval :: Monad m => Sink m a ()
-- eval = S.foldl (\_ x -> P.seq x ()) ()
{-# INLINE runStream #-}
-- runStream :: Monad m => Sink m Int () -> Source m () Int -> m ()
-- runStream t src = S.runConduit $ src S..| t S..| S.foldl (\_ x -> P.seq x ()) ()
runStream :: Monad m => Sink m Int a -> Source m () Int -> m a
runStream t src = S.runConduit $ src S..| t
{-# INLINE toNull #-}
toNull :: Monad m => Source m () Int -> m ()
toNull = runStream $ S.sinkNull
-- toNull src = S.runConduit $ src S..| eval
{-# INLINE toList #-}
toList :: Monad m => Source m () Int -> m [Int]
toList = runStream $ S.sinkList
{-# INLINE foldl #-}
foldl :: Monad m => Source m () Int -> m Int
foldl = runStream $ S.foldl (+) 0
{-# INLINE last #-}
last :: Monad m => Source m () Int -> m (Maybe Int)
last = runStream $ S.last
-------------------------------------------------------------------------------
-- Transformation
-------------------------------------------------------------------------------
{-# INLINE transform #-}
transform :: Monad m => Pipe m Int Int -> Source m () Int -> m ()
-- mapM_ is much more costly compared to sinkNull
-- transform t = runStream (t S..| S.mapM_ (\_ -> return ()))
-- transform t s = runStream (t S..| eval) s P.>>= \x -> P.seq x (return ())
transform t = runStream (t S..| S.sinkNull)
{-# INLINE composeN #-}
composeN :: Monad m => Int -> Pipe m Int Int -> Source m () Int -> m ()
composeN n f =
case n of
1 -> transform $ f
2 -> transform $ f S..| f
3 -> transform $ f S..| f S..| f
4 -> transform $ f S..| f S..| f S..| f
_ -> undefined
{-# INLINE scan #-}
{-# INLINE map #-}
{-# INLINE mapM #-}
{-# INLINE filterEven #-}
{-# INLINE filterAllOut #-}
{-# INLINE filterAllIn #-}
{-# INLINE takeOne #-}
{-# INLINE takeAll #-}
{-# INLINE takeWhileTrue #-}
{-# INLINE dropOne #-}
{-# INLINE dropAll #-}
{-# INLINE dropWhileTrue #-}
{-# INLINE dropWhileFalse #-}
scan, map, mapM,
filterEven, filterAllOut, filterAllIn,
takeOne, takeAll, takeWhileTrue,
dropOne, dropAll, dropWhileTrue, dropWhileFalse
:: Monad m => Int -> Source m () Int -> m ()
scan n = composeN n $ S.scanl (+) 0
map n = composeN n $ S.map (+1)
mapM n = composeN n $ S.mapM return
filterEven n = composeN n $ S.filter even
filterAllOut n = composeN n $ S.filter (> maxValue)
filterAllIn n = composeN n $ S.filter (<= maxValue)
takeOne n = composeN n $ S.take 1
takeAll n = composeN n $ S.take maxValue
takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)
dropOne n = composeN n $ (S.drop 1 P.>> S.awaitForever S.yield)
dropAll n = composeN n $ (S.drop maxValue P.>> S.awaitForever S.yield)
dropWhileFalse n = composeN n $ (S.dropWhile (> maxValue) P.>>
S.awaitForever S.yield)
dropWhileTrue n = composeN n $ (S.dropWhile (<= maxValue) P.>>
S.awaitForever S.yield)
-------------------------------------------------------------------------------
-- Mixed Composition
-------------------------------------------------------------------------------
{-# INLINE scanMap #-}
{-# INLINE dropMap #-}
{-# INLINE dropScan #-}
{-# INLINE takeDrop #-}
{-# INLINE takeScan #-}
{-# INLINE takeMap #-}
{-# INLINE filterDrop #-}
{-# INLINE filterTake #-}
{-# INLINE filterScan #-}
{-# INLINE filterMap #-}
scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
filterTake, filterScan, filterMap
:: Monad m => Int -> Source m () Int -> m ()
scanMap n = composeN n $ S.map (subtract 1) S..| S.scanl (+) 0
dropMap n = composeN n $ S.map (subtract 1) S..|
(S.drop 1 P.>> S.awaitForever S.yield)
dropScan n = composeN n $ S.scanl (+) 0 S..|
(S.drop 1 P.>> S.awaitForever S.yield)
takeDrop n = composeN n $ (S.drop 1 P.>> S.awaitForever S.yield) S..|
S.take maxValue
takeScan n = composeN n $ S.scanl (+) 0 S..| S.take maxValue
takeMap n = composeN n $ S.map (subtract 1) S..| S.take maxValue
filterDrop n = composeN n $ (S.drop 1 P.>> S.awaitForever S.yield) S..|
S.filter (<= maxValue)
filterTake n = composeN n $ S.take maxValue S..| S.filter (<= maxValue)
filterScan n = composeN n $ S.scanl (+) 0 S..| S.filter (<= maxBound)
filterMap n = composeN n $ S.map (subtract 1) S..| S.filter (<= maxValue)
-------------------------------------------------------------------------------
-- Zipping and concat
-------------------------------------------------------------------------------
{-# INLINE zip #-}
zip :: Monad m => Source m () Int -> m ()
zip src = S.runConduit $
( S.getZipSource $ (,)
<$> S.ZipSource src
<*> S.ZipSource src) S..| S.sinkNull -- eval
{-# INLINE concatMapFoldable #-}
concatMapFoldable :: Monad m => Source m () Int -> m ()
concatMapFoldable = transform (S.map (replicate 3) S..| S.concat)