git.iko.soy/streamly
on master help sign in
Refactor serialWith
f307192Harendra Kumar
src/Streamly/Internal/Data/Fold/Type.hs+24−26
compare with master
unifiedsplit
@@ -346,6 +346,13 @@ mapMStep f res =
346 Partial s -> pure $ Partial s
346 Partial s -> pure $ Partial s
347 Done b -> Done <$> f b
347 Done b -> Done <$> f b
348
348
349+-- | If 'Partial' then map the state, if 'Done' then call the next step.
350+{-# INLINE chainStepM #-}
351+chainStepM :: Applicative m =>
352+ (s1 -> m s2) -> (a -> m (Step s2 b)) -> Step s1 a -> m (Step s2 b)
353+chainStepM f _ (Partial s) = Partial <$> f s
354+chainStepM _ g (Done b) = g b
355+
349------------------------------------------------------------------------------
356------------------------------------------------------------------------------
350-- The Fold type
357-- The Fold type
351------------------------------------------------------------------------------
358------------------------------------------------------------------------------
@@ -668,43 +675,34 @@ data SeqFoldState sl f sr = SeqFoldL !sl | SeqFoldR !f !sr
668-- @since 0.8.0
675-- @since 0.8.0
669--
676--
670{-# INLINE serialWith #-}
677{-# INLINE serialWith #-}
678+serialWith :: Monad m =>
671−serialWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
679+ (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
672serialWith func (Fold stepL initialL extractL) (Fold stepR initialR extractR) =
680serialWith func (Fold stepL initialL extractL) (Fold stepR initialR extractR) =
673 Fold step initial extract
681 Fold step initial extract
674
682
675 where
683 where
676
684
677− initial = do
685+ {-# INLINE runR #-}
678− resL <- initialL
686+ runR action f = bimap (SeqFoldR f) f <$> action
679− case resL of
680− Partial sl -> return $ Partial $ SeqFoldL sl
681− Done bl -> do
682− resR <- initialR
683− return $ bimap (SeqFoldR (func bl)) (func bl) resR
684
687
685− step (SeqFoldL st) a = do
688+ {-# INLINE runL #-}
686− r <- stepL st a
689+ runL action = do
687− case r of
690+ resL <- action
688− Partial s -> return $ Partial (SeqFoldL s)
691+ chainStepM (return . SeqFoldL) (runR initialR . func) resL
689− Done b -> do
692+
690− res <- initialR
693+ initial = runL initialL
691− return $ bimap (SeqFoldR (func b)) (func b) res
694+
695+ step (SeqFoldL st) a = runL (stepL st a)
692− step (SeqFoldR f st) a = do
696+ step (SeqFoldR f st) a = runR (stepR st a) f
693− r <- stepR st a
694− return
695− $ case r of
696− Partial s -> Partial (SeqFoldR f s)
697− Done b -> Done (f b)
698
697
699 extract (SeqFoldR f sR) = fmap f (extractR sR)
698 extract (SeqFoldR f sR) = fmap f (extractR sR)
700 extract (SeqFoldL sL) = do
699 extract (SeqFoldL sL) = do
701 rL <- extractL sL
700 rL <- extractL sL
702 res <- initialR
701 res <- initialR
702+ fmap (func rL)
703− case res of
703+ $ case res of
704− Partial sR -> do
705− rR <- extractR sR
704+ Partial sR -> extractR sR
706− return $ func rL rR
707− Done rR -> return $ func rL rR
705+ Done rR -> return rR
708
706
709{-# ANN type Step Fuse #-}
707{-# ANN type Step Fuse #-}
710data SeqFoldState_ sl sr = SeqFoldL_ !sl | SeqFoldR_ !sr
708data SeqFoldState_ sl sr = SeqFoldL_ !sl | SeqFoldR_ !sr