{-# LANGUAGE ExistentialQuantification, RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE CPP #-}

{-| This module builds on module "Control.Foldl", adding stateful transducers
    and grouping operations.

>>> L.fold (transduce (surround "[" "]") L.list) "middle"
"[middle]"

>>> L.fold (folds (chunksOf 2) L.length L.list) "aabbccdd"
[2,2,2,2]

>>> L.fold (groups (chunksOf 2) (surround "[" "]") L.list) "aabbccdd"
"[aa][bb][cc][dd]"

-}

module Control.Foldl.Transduce (
        -- * Transducer types

        Transduction 
    ,   Transduction' 
    ,   Transducer(..)
    ,   ToTransducer(..)
        -- ** Monadic transducer types

    ,   TransductionM
    ,   TransductionM'
    ,   TransducerM(..)
    ,   ToTransducerM(..)
        -- * Applying transducers

    ,   transduce
    ,   transduce'
    ,   transduceM
    ,   transduceM'
    ,   transduceK
        -- * Folding over groups

    ,   folds
    ,   folds'
    ,   foldsM
    ,   foldsM'
        -- * Group operations

    ,   ReifiedTransduction' (..)
    ,   reify
    ,   reify'
    ,   Moore(..)
    ,   ToTransductions' (..)
    ,   moveHead
    ,   groups
    ,   bisect
    ,   groups'
        -- ** Monadic group operations

    ,   ReifiedTransductionM' (..)
    ,   reifyM
    ,   reifyM'
    ,   MooreM(..)
    ,   ToTransductionsM' (..)
    ,   moveHeadM
    ,   groupsM
    ,   bisectM
    ,   groupsM'
        -- * Transducers

    ,   ignore
    ,   surround
    ,   surroundIO
        -- * Splitters

    ,   chunksOf
    ,   split
    ,   splitAt
    ,   chunkedSplitAt
    ,   splitLast
    ,   break
    ,   chunkedStripPrefix
        -- * Transducer utilities

    ,   foldify
    ,   foldifyM
    ,   condense
    ,   condenseM
    ,   hoistTransducer
        -- * Fold utilities

    ,   hoistFold
    ,   unit
    ,   trip
    ,   quiesce
    ,   Fallible(..)
    ,   ToFold(..)
    ,   ToFoldM(..)
        -- * Deprecated

        -- * Re-exports

        -- $reexports

    ,   module Data.Functor.Extend
    ,   module Control.Foldl
    ,   module Control.Comonad.Cofree
    ) where

import Prelude hiding (split,splitAt,break)

import Data.Functor
import Data.Bifunctor
import Data.Profunctor
import Data.Monoid
import Data.Void
import qualified Data.Monoid.Cancellative as CM
import qualified Data.Monoid.Null as NM
import qualified Data.Monoid.Factorial as SFM
import Data.Functor.Identity
import Data.Functor.Extend
import Data.Foldable (Foldable,foldlM,foldl',toList)
import Data.Traversable
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Control.Comonad
import Control.Comonad.Cofree 
import Control.Foldl (Fold(..),FoldM(..),hoists)
import qualified Control.Foldl as L

{- $setup

>>> import qualified Control.Foldl as L
>>> import Control.Foldl.Transduce
>>> import Control.Applicative
>>> import qualified Control.Comonad.Cofree as C
>>> import Prelude hiding (split,splitAt,break)

-}

------------------------------------------------------------------------------


#if !(MIN_VERSION_foldl(1,4,12))
instance Extend (Fold a) where
    duplicated :: Fold a a -> Fold a (Fold a a)
duplicated Fold a a
f = Fold a a -> Fold a (Fold a a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate Fold a a
f
    {-# INLINABLE duplicated #-}

instance Monad m => Extend (FoldM m a) where
    duplicated :: FoldM m a a -> FoldM m a (FoldM m a a)
duplicated (FoldM x -> a -> m x
step m x
begin x -> m a
done) = 
        (x -> a -> m x)
-> m x -> (x -> m (FoldM m a a)) -> FoldM m a (FoldM m a a)
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step m x
begin (\x
x -> FoldM m a a -> m (FoldM m a a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FoldM m a a -> m (FoldM m a a)) -> FoldM m a a -> m (FoldM m a a)
forall a b. (a -> b) -> a -> b
$! (x -> a -> m x) -> m x -> (x -> m a) -> FoldM m a a
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step (x -> m x
forall (m :: * -> *) a. Monad m => a -> m a
return x
x) x -> m a
done)
    {-# INLINABLE duplicated #-}
#endif

------------------------------------------------------------------------------


data Pair a b = Pair !a !b

data Quartet a b c d = Quartet !a !b !c !d

fst3 :: (a,b,c) -> a
fst3 :: (a, b, c) -> a
fst3 (a
x,b
_,c
_) = a
x

------------------------------------------------------------------------------


{-| A (possibly stateful) transformation on the inputs of a 'Fold'.

    Functions constructed with combinators like 'L.premap' or 'L.handles' from
    "Control.Foldl" also typecheck as a 'Transduction'.
-}
type Transduction a b = forall x. Fold b x -> Fold a x

{-| A more general from of 'Transduction' that adds new information to the
    return value of the 'Fold'.

-}
type Transduction' a b r = forall x. Fold b x -> Fold a (r,x)

{-| Helper for storing a 'Transduction'' safely on a container.		

-}
newtype ReifiedTransduction' a b r = ReifiedTransduction' { ReifiedTransduction' a b r -> forall x. Fold b x -> Fold a (r, x)
getTransduction' :: Transduction' a b r }

{-| Convenience constructor, often useful with pure functions like 'id'.		

-}
reify :: Transduction a b -> ReifiedTransduction' a b ()
reify :: Transduction a b -> ReifiedTransduction' a b ()
reify Transduction a b
t = Transduction' a b () -> ReifiedTransduction' a b ()
forall a b r. Transduction' a b r -> ReifiedTransduction' a b r
reify' ((Fold a x -> Fold a ((), x))
-> (Fold b x -> Fold a x) -> Fold b x -> Fold a ((), x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((x -> ((), x)) -> Fold a x -> Fold a ((), x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) ())) Fold b x -> Fold a x
Transduction a b
t)  

reify' :: Transduction' a b r -> ReifiedTransduction' a b r
reify' :: Transduction' a b r -> ReifiedTransduction' a b r
reify' = Transduction' a b r -> ReifiedTransduction' a b r
forall a b r. Transduction' a b r -> ReifiedTransduction' a b r
ReifiedTransduction' 

{-| A stateful process that transforms a stream of inputs into a stream of
    outputs, and may optionally demarcate groups in the stream of outputs.

    Composed of a step function, an initial state, and a extraction function. 

    The step function returns a triplet of:

    * The new internal state.
    * List of outputs belonging to the last segment detected in the previous step.
    * A list of lists of outputs belonging to segments detected in the current
      step. If the list is empty, that means no splitting has taken place in the
      current step. 'Transducer's that do not perform grouping never return anything
      other than @[]@ here. In effect, they treat the whole stream as a single group.

    The extraction function returns the 'Transducer's own result value, along with any
    pending output.
-}
data Transducer i o r
     = forall x. Transducer (x -> i -> (x,[o],[[o]])) x (x -> (r,[o],[[o]]))

instance Comonad (Transducer i o) where
    extract :: Transducer i o a -> a
extract (Transducer x -> i -> (x, [o], [[o]])
_ x
begin x -> (a, [o], [[o]])
done) = (a, [o], [[o]]) -> a
forall a b c. (a, b, c) -> a
fst3 (x -> (a, [o], [[o]])
done x
begin)
    {-# INLINABLE extract #-}

    duplicate :: Transducer i o a -> Transducer i o (Transducer i o a)
duplicate (Transducer x -> i -> (x, [o], [[o]])
step x
begin x -> (a, [o], [[o]])
done) = (x -> i -> (x, [o], [[o]]))
-> x
-> (x -> (Transducer i o a, [o], [[o]]))
-> Transducer i o (Transducer i o a)
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
Transducer x -> i -> (x, [o], [[o]])
step x
begin (\x
x -> ((x -> i -> (x, [o], [[o]]))
-> x -> (x -> (a, [o], [[o]])) -> Transducer i o a
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
Transducer x -> i -> (x, [o], [[o]])
step x
x x -> (a, [o], [[o]])
done,[],[]))
    {-# INLINABLE duplicate #-}

instance Extend (Transducer i o) where
    duplicated :: Transducer i o a -> Transducer i o (Transducer i o a)
duplicated Transducer i o a
f = Transducer i o a -> Transducer i o (Transducer i o a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate Transducer i o a
f
    {-# INLINABLE duplicated #-}

instance Functor (Transducer i o) where
    fmap :: (a -> b) -> Transducer i o a -> Transducer i o b
fmap a -> b
f (Transducer x -> i -> (x, [o], [[o]])
step x
begin x -> (a, [o], [[o]])
done) = 
        (x -> i -> (x, [o], [[o]]))
-> x -> (x -> (b, [o], [[o]])) -> Transducer i o b
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
Transducer 
            x -> i -> (x, [o], [[o]])
step 
            x
begin 
            ((\(a
x,[o]
xs,[[o]]
xss) -> (a -> b
f a
x,[o]
xs,[[o]]
xss)) ((a, [o], [[o]]) -> (b, [o], [[o]]))
-> (x -> (a, [o], [[o]])) -> x -> (b, [o], [[o]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> (a, [o], [[o]])
done)

instance Bifunctor (Transducer i) where
    first :: (a -> b) -> Transducer i a c -> Transducer i b c
first a -> b
f (Transducer x -> i -> (x, [a], [[a]])
step x
begin x -> (c, [a], [[a]])
done) =
        (x -> i -> (x, [b], [[b]]))
-> x -> (x -> (c, [b], [[b]])) -> Transducer i b c
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
Transducer 
            (((x, [a], [[a]]) -> (x, [b], [[b]]))
-> (i -> (x, [a], [[a]])) -> i -> (x, [b], [[b]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(x
x,[a]
xs,[[a]]
xss) -> (x
x,(a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs, ([a] -> [b]) -> [[a]] -> [[b]]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f) [[a]]
xss)) ((i -> (x, [a], [[a]])) -> i -> (x, [b], [[b]]))
-> (x -> i -> (x, [a], [[a]])) -> x -> i -> (x, [b], [[b]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> i -> (x, [a], [[a]])
step) 
            x
begin 
            ((\(c
x,[a]
xs,[[a]]
xss) -> (c
x,(a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs, ([a] -> [b]) -> [[a]] -> [[b]]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f) [[a]]
xss)) ((c, [a], [[a]]) -> (c, [b], [[b]]))
-> (x -> (c, [a], [[a]])) -> x -> (c, [b], [[b]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> (c, [a], [[a]])
done) 
    second :: (b -> c) -> Transducer i a b -> Transducer i a c
second b -> c
f Transducer i a b
w = (b -> c) -> Transducer i a b -> Transducer i a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
f Transducer i a b
w

{-| Helps converting monadic transducers (over 'Identity') into pure ones.		

-}
class ToTransducer t where
    toTransducer :: t i o r -> Transducer i o r

instance ToTransducer Transducer where
    toTransducer :: Transducer i o r -> Transducer i o r
toTransducer = Transducer i o r -> Transducer i o r
forall a. a -> a
id

instance ToTransducer (TransducerM Identity) where
    toTransducer :: TransducerM Identity i o r -> Transducer i o r
toTransducer = TransducerM Identity i o r -> Transducer i o r
forall i o r. TransducerM Identity i o r -> Transducer i o r
_simplify

class ToFold t where
    toFold :: t i r -> Fold i r

instance ToFold Fold where
    toFold :: Fold i r -> Fold i r
toFold = Fold i r -> Fold i r
forall a. a -> a
id

instance ToFold (FoldM Identity) where
    toFold :: FoldM Identity i r -> Fold i r
toFold = FoldM Identity i r -> Fold i r
forall i r. FoldM Identity i r -> Fold i r
L.simplify

{-| Like 'Transduction', but works on monadic 'Fold's.		

-}
type TransductionM m a b = forall x. Monad m => FoldM m b x -> FoldM m a x

{-| Like 'Transduction'', but works on monadic 'Fold's.		

-}
type TransductionM' m a b r = forall x. FoldM m b x -> FoldM m a (r,x)

{-| Helper for storing a 'TransductionM'' safely on a container.		

-}
newtype ReifiedTransductionM' m a b r = ReifiedTransductionM' { ReifiedTransductionM' m a b r
-> forall x. FoldM m b x -> FoldM m a (r, x)
getTransductionM' :: TransductionM' m a b r }

{-| Monadic version of 'reify'.		

-}
reifyM :: Monad m => TransductionM m a b -> ReifiedTransductionM' m a b ()
reifyM :: TransductionM m a b -> ReifiedTransductionM' m a b ()
reifyM TransductionM m a b
t = TransductionM' m a b () -> ReifiedTransductionM' m a b ()
forall (m :: * -> *) a b r.
TransductionM' m a b r -> ReifiedTransductionM' m a b r
reifyM' ((FoldM m a x -> FoldM m a ((), x))
-> (FoldM m b x -> FoldM m a x) -> FoldM m b x -> FoldM m a ((), x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((x -> ((), x)) -> FoldM m a x -> FoldM m a ((), x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) ())) FoldM m b x -> FoldM m a x
TransductionM m a b
t)  

{-| Monadic version of 'reifyM'.		

-}
reifyM' :: TransductionM' m a b r -> ReifiedTransductionM' m a b r
reifyM' :: TransductionM' m a b r -> ReifiedTransductionM' m a b r
reifyM' = TransductionM' m a b r -> ReifiedTransductionM' m a b r
forall (m :: * -> *) a b r.
TransductionM' m a b r -> ReifiedTransductionM' m a b r
ReifiedTransductionM' 

{-| Like 'Transducer', but monadic.

-}
data TransducerM m i o r
     = forall x. TransducerM (x -> i -> m (x,[o],[[o]])) (m x) (x -> m (r,[o],[[o]]))


instance Monad m => Functor (TransducerM m i o) where
    fmap :: (a -> b) -> TransducerM m i o a -> TransducerM m i o b
fmap a -> b
f (TransducerM x -> i -> m (x, [o], [[o]])
step m x
begin x -> m (a, [o], [[o]])
done) = (x -> i -> m (x, [o], [[o]]))
-> m x -> (x -> m (b, [o], [[o]])) -> TransducerM m i o b
forall (m :: * -> *) i o r x.
(x -> i -> m (x, [o], [[o]]))
-> m x -> (x -> m (r, [o], [[o]])) -> TransducerM m i o r
TransducerM x -> i -> m (x, [o], [[o]])
step m x
begin x -> m (b, [o], [[o]])
done'
      where
        done' :: x -> m (b, [o], [[o]])
done' x
x = do
            (a
r,[o]
os,[[o]]
oss) <- x -> m (a, [o], [[o]])
done x
x
            let r' :: b
r' = a -> b
f a
r
            (b, [o], [[o]]) -> m (b, [o], [[o]])
forall (m :: * -> *) a. Monad m => a -> m a
return ((b, [o], [[o]]) -> m (b, [o], [[o]]))
-> (b, [o], [[o]]) -> m (b, [o], [[o]])
forall a b. (a -> b) -> a -> b
$! (b
r' b -> (b, [o], [[o]]) -> (b, [o], [[o]])
`seq` (b
r',[o]
os,[[o]]
oss))

instance (Functor m, Monad m) => Bifunctor (TransducerM m i) where
    first :: (a -> b) -> TransducerM m i a c -> TransducerM m i b c
first a -> b
f (TransducerM x -> i -> m (x, [a], [[a]])
step m x
begin x -> m (c, [a], [[a]])
done) =
        (x -> i -> m (x, [b], [[b]]))
-> m x -> (x -> m (c, [b], [[b]])) -> TransducerM m i b c
forall (m :: * -> *) i o r x.
(x -> i -> m (x, [o], [[o]]))
-> m x -> (x -> m (r, [o], [[o]])) -> TransducerM m i o r
TransducerM 
        ((m (x, [a], [[a]]) -> m (x, [b], [[b]]))
-> (i -> m (x, [a], [[a]])) -> i -> m (x, [b], [[b]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((x, [a], [[a]]) -> (x, [b], [[b]]))
-> m (x, [a], [[a]]) -> m (x, [b], [[b]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(x
x,[a]
xs,[[a]]
xss) -> (x
x,(a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs, ([a] -> [b]) -> [[a]] -> [[b]]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f) [[a]]
xss))) ((i -> m (x, [a], [[a]])) -> i -> m (x, [b], [[b]]))
-> (x -> i -> m (x, [a], [[a]])) -> x -> i -> m (x, [b], [[b]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> i -> m (x, [a], [[a]])
step) 
        m x
begin 
        (((c, [a], [[a]]) -> (c, [b], [[b]]))
-> m (c, [a], [[a]]) -> m (c, [b], [[b]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(c
x,[a]
xs,[[a]]
xss) -> (c
x,(a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs, ([a] -> [b]) -> [[a]] -> [[b]]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f) [[a]]
xss)) (m (c, [a], [[a]]) -> m (c, [b], [[b]]))
-> (x -> m (c, [a], [[a]])) -> x -> m (c, [b], [[b]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m (c, [a], [[a]])
done) 
    second :: (b -> c) -> TransducerM m i a b -> TransducerM m i a c
second b -> c
f TransducerM m i a b
w = (b -> c) -> TransducerM m i a b -> TransducerM m i a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
f TransducerM m i a b
w

instance Monad m => Extend (TransducerM m i o) where
    duplicated :: TransducerM m i o a -> TransducerM m i o (TransducerM m i o a)
duplicated (TransducerM x -> i -> m (x, [o], [[o]])
step m x
begin x -> m (a, [o], [[o]])
done) = 
        (x -> i -> m (x, [o], [[o]]))
-> m x
-> (x -> m (TransducerM m i o a, [o], [[o]]))
-> TransducerM m i o (TransducerM m i o a)
forall (m :: * -> *) i o r x.
(x -> i -> m (x, [o], [[o]]))
-> m x -> (x -> m (r, [o], [[o]])) -> TransducerM m i o r
TransducerM x -> i -> m (x, [o], [[o]])
step m x
begin (\x
x -> (TransducerM m i o a, [o], [[o]])
-> m (TransducerM m i o a, [o], [[o]])
forall (m :: * -> *) a. Monad m => a -> m a
return ((TransducerM m i o a, [o], [[o]])
 -> m (TransducerM m i o a, [o], [[o]]))
-> (TransducerM m i o a, [o], [[o]])
-> m (TransducerM m i o a, [o], [[o]])
forall a b. (a -> b) -> a -> b
$! ((x -> i -> m (x, [o], [[o]]))
-> m x -> (x -> m (a, [o], [[o]])) -> TransducerM m i o a
forall (m :: * -> *) i o r x.
(x -> i -> m (x, [o], [[o]]))
-> m x -> (x -> m (r, [o], [[o]])) -> TransducerM m i o r
TransducerM x -> i -> m (x, [o], [[o]])
step (x -> m x
forall (m :: * -> *) a. Monad m => a -> m a
return x
x) x -> m (a, [o], [[o]])
done,[],[]))
    {-# INLINABLE duplicated #-}


{-| Helps converting pure transducers into monadic ones.		

-}
class ToTransducerM m t where
    toTransducerM :: t i o r -> TransducerM m i o r

-- http://chrisdone.com/posts/haskell-constraint-trick

instance (m ~ m') => ToTransducerM m (TransducerM m') where
    toTransducerM :: TransducerM m' i o r -> TransducerM m i o r
toTransducerM = TransducerM m' i o r -> TransducerM m i o r
forall a. a -> a
id

instance Monad m => ToTransducerM m Transducer where
    toTransducerM :: Transducer i o r -> TransducerM m i o r
toTransducerM = Transducer i o r -> TransducerM m i o r
forall (m :: * -> *) i o s.
Monad m =>
Transducer i o s -> TransducerM m i o s
_generalize

class ToFoldM m t where
    toFoldM :: t i r -> FoldM m i r

instance (m ~ m') => ToFoldM m (FoldM m') where
    toFoldM :: FoldM m' i r -> FoldM m i r
toFoldM = FoldM m' i r -> FoldM m i r
forall a. a -> a
id

instance Monad m => ToFoldM m Fold where
    toFoldM :: Fold i r -> FoldM m i r
toFoldM = Fold i r -> FoldM m i r
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize


{-| Apply a 'Transducer' to a 'Fold', discarding the return value of the
    'Transducer'.		

>>> L.fold (transduce (Transducer (\_ i -> ((),[i],[])) () (\_ -> ((),[],[]))) L.list) [1..7]
[1,2,3,4,5,6,7]
-}
transduce :: ToTransducer t => t i o () -> Transduction i o 
transduce :: t i o () -> Transduction i o
transduce t i o ()
t = (((), x) -> x) -> Fold i ((), x) -> Fold i x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((), x) -> x
forall a b. (a, b) -> b
snd (Fold i ((), x) -> Fold i x)
-> (Fold o x -> Fold i ((), x)) -> Fold o x -> Fold i x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t i o () -> Transduction' i o ()
forall (t :: * -> * -> * -> *) i o s.
ToTransducer t =>
t i o s -> Transduction' i o s
transduce' t i o ()
t)

{-| Generalized version of 'transduce' that preserves the return value of
    the 'Transducer'.

>>> L.fold (transduce' (Transducer (\_ i -> ((),[i],[])) () (\_ -> ('r',[],[]))) L.list) [1..7]
('r',[1,2,3,4,5,6,7])
-}
transduce' :: ToTransducer t => t i o s -> Transduction' i o s
transduce' :: t i o s -> Transduction' i o s
transduce' (t i o s -> Transducer i o s
forall (t :: * -> * -> * -> *) i o r.
ToTransducer t =>
t i o r -> Transducer i o r
toTransducer -> Transducer x -> i -> (x, [o], [[o]])
wstep x
wstate x -> (s, [o], [[o]])
wdone) (Fold x -> o -> x
fstep x
fstate x -> x
fdone) =
    (Pair x x -> i -> Pair x x)
-> Pair x x -> (Pair x x -> (s, x)) -> Fold i (s, x)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Pair x x -> i -> Pair x x
step (x -> x -> Pair x x
forall a b. a -> b -> Pair a b
Pair x
wstate x
fstate) Pair x x -> (s, x)
done 
        where
            step :: Pair x x -> i -> Pair x x
step (Pair x
ws x
fs) i
i = 
                let (x
ws',[o]
os,[[o]]
oss) = x -> i -> (x, [o], [[o]])
wstep x
ws i
i 
                in
                x -> x -> Pair x x
forall a b. a -> b -> Pair a b
Pair x
ws' ((x -> o -> x) -> x -> [o] -> x
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' x -> o -> x
fstep x
fs ([o]
os [o] -> [o] -> [o]
forall a. [a] -> [a] -> [a]
++ [[o]] -> [o]
forall a. Monoid a => [a] -> a
mconcat [[o]]
oss))  
            done :: Pair x x -> (s, x)
done (Pair x
ws x
fs) = 
                let (s
wr,[o]
os,[[o]]
oss) = x -> (s, [o], [[o]])
wdone x
ws
                in 
                (,) s
wr (x -> x
fdone ((x -> o -> x) -> x -> [o] -> x
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' x -> o -> x
fstep x
fs ([o]
os [o] -> [o] -> [o]
forall a. [a] -> [a] -> [a]
++ [[o]] -> [o]
forall a. Monoid a => [a] -> a
mconcat [[o]]
oss)))


{-| Like 'transduce', but works on monadic 'Fold's.		

-}
transduceM :: (Monad m, ToTransducerM m t)  => t i o () -> TransductionM m i o 
transduceM :: t i o () -> TransductionM m i o
transduceM t i o ()
t = (((), x) -> x) -> FoldM m i ((), x) -> FoldM m i x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((), x) -> x
forall a b. (a, b) -> b
snd (FoldM m i ((), x) -> FoldM m i x)
-> (FoldM m o x -> FoldM m i ((), x)) -> FoldM m o x -> FoldM m i x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t i o () -> TransductionM' m i o ()
forall (m :: * -> *) (t :: * -> * -> * -> *) i o s.
(Monad m, ToTransducerM m t) =>
t i o s -> TransductionM' m i o s
transduceM' t i o ()
t)

{-| Like 'transduce'', but works on monadic 'Fold's.		

-}
transduceM' :: (Monad m, ToTransducerM m t)  => t i o s -> TransductionM' m i o s
transduceM' :: t i o s -> TransductionM' m i o s
transduceM' (t i o s -> TransducerM m i o s
forall (m :: * -> *) (t :: * -> * -> * -> *) i o r.
ToTransducerM m t =>
t i o r -> TransducerM m i o r
toTransducerM -> TransducerM x -> i -> m (x, [o], [[o]])
wstep m x
wstate x -> m (s, [o], [[o]])
wdone) (FoldM x -> o -> m x
fstep m x
fstate x -> m x
fdone) =
    (Pair x x -> i -> m (Pair x x))
-> m (Pair x x) -> (Pair x x -> m (s, x)) -> FoldM m i (s, x)
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM Pair x x -> i -> m (Pair x x)
step ((x -> x -> Pair x x) -> m x -> m x -> m (Pair x x)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 x -> x -> Pair x x
forall a b. a -> b -> Pair a b
Pair m x
wstate m x
fstate) Pair x x -> m (s, x)
done 
        where
            step :: Pair x x -> i -> m (Pair x x)
step (Pair x
ws x
fs) i
i = do
                (x
ws',[o]
os,[[o]]
oss) <- x -> i -> m (x, [o], [[o]])
wstep x
ws i
i
                x
fs' <- (x -> o -> m x) -> x -> [o] -> m x
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM x -> o -> m x
fstep x
fs ([o]
os [o] -> [o] -> [o]
forall a. [a] -> [a] -> [a]
++ [[o]] -> [o]
forall a. Monoid a => [a] -> a
mconcat [[o]]
oss)
                Pair x x -> m (Pair x x)
forall (m :: * -> *) a. Monad m => a -> m a
return (Pair x x -> m (Pair x x)) -> Pair x x -> m (Pair x x)
forall a b. (a -> b) -> a -> b
$! x -> x -> Pair x x
forall a b. a -> b -> Pair a b
Pair x
ws' x
fs'
            done :: Pair x x -> m (s, x)
done (Pair x
ws x
fs) = do
                (s
wr,[o]
os,[[o]]
oss) <- x -> m (s, [o], [[o]])
wdone x
ws
                x
fr <- x -> m x
fdone (x -> m x) -> m x -> m x
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (x -> o -> m x) -> x -> [o] -> m x
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM x -> o -> m x
fstep x
fs ([o]
os [o] -> [o] -> [o]
forall a. [a] -> [a] -> [a]
++ [[o]] -> [o]
forall a. Monoid a => [a] -> a
mconcat [[o]]
oss)
                (s, x) -> m (s, x)
forall (m :: * -> *) a. Monad m => a -> m a
return ((s, x) -> m (s, x)) -> (s, x) -> m (s, x)
forall a b. (a -> b) -> a -> b
$! (,) s
wr x
fr

{-| Transduce with a Kleisli arrow that returns a list.		

-}
transduceK :: (Monad m) => (i -> m [o]) -> TransductionM m i o 
transduceK :: (i -> m [o]) -> TransductionM m i o
transduceK i -> m [o]
k = TransducerM m i o () -> TransductionM m i o
forall (m :: * -> *) (t :: * -> * -> * -> *) i o.
(Monad m, ToTransducerM m t) =>
t i o () -> TransductionM m i o
transduceM ((() -> i -> m ((), [o], [[o]]))
-> m () -> (() -> m ((), [o], [[o]])) -> TransducerM m i o ()
forall (m :: * -> *) i o r x.
(x -> i -> m (x, [o], [[o]]))
-> m x -> (x -> m (r, [o], [[o]])) -> TransducerM m i o r
TransducerM () -> i -> m ((), [o], [[o]])
step (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\()
_ -> ((), [o], [[o]]) -> m ((), [o], [[o]])
forall (m :: * -> *) a. Monad m => a -> m a
return ((),[],[])))
    where
    step :: () -> i -> m ((), [o], [[o]])
step ()
_ i
i = ([o] -> ((), [o], [[o]])) -> m [o] -> m ((), [o], [[o]])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\[o]
os -> ((),[o]
os,[])) (i -> m [o]
k i
i)


------------------------------------------------------------------------------


{-| Ignore all the inputs coming into the fold.

    Polymorphic in both inputs and outputs.		

-}
ignore :: Transducer a b ()
ignore :: Transducer a b ()
ignore = 
    (() -> a -> ((), [b], [[b]]))
-> () -> (() -> ((), [b], [[b]])) -> Transducer a b ()
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
Transducer () -> a -> ((), [b], [[b]])
forall p p a a. p -> p -> ((), [a], [a])
step () () -> ((), [b], [[b]])
forall b a a. b -> ((), [a], [a])
done 
    where
        step :: p -> p -> ((), [a], [a])
step p
_ p
_ = 
            ((),[],[])
        done :: b -> ((), [a], [a])
done = 
            ((), [a], [a]) -> b -> ((), [a], [a])
forall a b. a -> b -> a
const ((),[],[])

data SurroundState = PrefixAdded | PrefixPending

{-| Adds a prefix and a suffix to the stream arriving into a 'Fold'.		

>>> L.fold (transduce (surround "prefix" "suffix") L.list) "middle"
"prefixmiddlesuffix"

    Used as a splitter, it puts the prefix, the original stream and
    the suffix in separate groups:

>>> L.fold (groups (surround "prefix" "suffix") (surround "[" "]") L.list) "middle"
"[prefix][middle][suffix]"

-}
surround :: (Traversable p, Traversable s) => p a -> s a -> Transducer a a ()
surround :: p a -> s a -> Transducer a a ()
surround (p a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList -> [a]
ps) (s a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList -> [a]
ss) = 
    (SurroundState -> a -> (SurroundState, [a], [[a]]))
-> SurroundState
-> (SurroundState -> ((), [a], [[a]]))
-> Transducer a a ()
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
Transducer SurroundState -> a -> (SurroundState, [a], [[a]])
step SurroundState
PrefixPending SurroundState -> ((), [a], [[a]])
done 
    where
        step :: SurroundState -> a -> (SurroundState, [a], [[a]])
step SurroundState
PrefixPending a
a = 
            (SurroundState
PrefixAdded, [a]
ps,[[a
a]])
        step SurroundState
PrefixAdded a
a = 
            (SurroundState
PrefixAdded, [a
a],[])
        done :: SurroundState -> ((), [a], [[a]])
done SurroundState
PrefixPending = 
            ((), [a]
ps, [[],[a]
ss])
        done SurroundState
PrefixAdded = 
            ((), [], [[a]
ss])

{-| Like 'surround', but the prefix and suffix are obtained using a 'IO'
    action.

>>> L.foldM (transduceM (surroundIO (return "prefix") (return "suffix")) (L.generalize L.list)) "middle"
"prefixmiddlesuffix"
-}
surroundIO :: (Traversable p, Traversable s, Functor m, MonadIO m) 
           => m (p a) 
           -> m (s a) 
           -> TransducerM m a a ()
surroundIO :: m (p a) -> m (s a) -> TransducerM m a a ()
surroundIO m (p a)
prefixa m (s a)
suffixa = 
    (SurroundState -> a -> m (SurroundState, [a], [[a]]))
-> m SurroundState
-> (SurroundState -> m ((), [a], [[a]]))
-> TransducerM m a a ()
forall (m :: * -> *) i o r x.
(x -> i -> m (x, [o], [[o]]))
-> m x -> (x -> m (r, [o], [[o]])) -> TransducerM m i o r
TransducerM SurroundState -> a -> m (SurroundState, [a], [[a]])
step (SurroundState -> m SurroundState
forall (m :: * -> *) a. Monad m => a -> m a
return SurroundState
PrefixPending) SurroundState -> m ((), [a], [[a]])
done 
    where
        step :: SurroundState -> a -> m (SurroundState, [a], [[a]])
step SurroundState
PrefixPending a
a = do
            [a]
ps <- (p a -> [a]) -> m (p a) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList m (p a)
prefixa
            (SurroundState, [a], [[a]]) -> m (SurroundState, [a], [[a]])
forall (m :: * -> *) a. Monad m => a -> m a
return (SurroundState
PrefixAdded, [a]
ps, [[a
a]])
        step SurroundState
PrefixAdded a
a = 
            (SurroundState, [a], [[a]]) -> m (SurroundState, [a], [[a]])
forall (m :: * -> *) a. Monad m => a -> m a
return (SurroundState
PrefixAdded, [a
a], [])
        done :: SurroundState -> m ((), [a], [[a]])
done SurroundState
PrefixPending = do
            [a]
ps <- (p a -> [a]) -> m (p a) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList m (p a)
prefixa
            [a]
ss <- (s a -> [a]) -> m (s a) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList m (s a)
suffixa
            ((), [a], [[a]]) -> m ((), [a], [[a]])
forall (m :: * -> *) a. Monad m => a -> m a
return ((), [a]
ps, [[],[a]
ss])
        done SurroundState
PrefixAdded = do
            [a]
ss <- (s a -> [a]) -> m (s a) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList m (s a)
suffixa
            ((), [a], [[a]]) -> m ((), [a], [[a]])
forall (m :: * -> *) a. Monad m => a -> m a
return ((), [], [[a]
ss])

------------------------------------------------------------------------------


{-| Generalize a 'Transducer' to a 'TransducerM'.		

-}
_generalize :: Monad m => Transducer i o s -> TransducerM m i o s
_generalize :: Transducer i o s -> TransducerM m i o s
_generalize (Transducer x -> i -> (x, [o], [[o]])
step x
begin x -> (s, [o], [[o]])
done) = (x -> i -> m (x, [o], [[o]]))
-> m x -> (x -> m (s, [o], [[o]])) -> TransducerM m i o s
forall (m :: * -> *) i o r x.
(x -> i -> m (x, [o], [[o]]))
-> m x -> (x -> m (r, [o], [[o]])) -> TransducerM m i o r
TransducerM x -> i -> m (x, [o], [[o]])
step' m x
begin' x -> m (s, [o], [[o]])
done'
    where
    step' :: x -> i -> m (x, [o], [[o]])
step' x
x i
a = (x, [o], [[o]]) -> m (x, [o], [[o]])
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> i -> (x, [o], [[o]])
step x
x i
a)
    begin' :: m x
begin'    = x -> m x
forall (m :: * -> *) a. Monad m => a -> m a
return  x
begin
    done' :: x -> m (s, [o], [[o]])
done' x
x   = (s, [o], [[o]]) -> m (s, [o], [[o]])
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> (s, [o], [[o]])
done x
x)

{-| Simplify a pure 'TransducerM' to a 'Transducer'.		

-}
_simplify :: TransducerM Identity i o s -> Transducer i o s
_simplify :: TransducerM Identity i o s -> Transducer i o s
_simplify (TransducerM x -> i -> Identity (x, [o], [[o]])
step Identity x
begin x -> Identity (s, [o], [[o]])
done) = (x -> i -> (x, [o], [[o]]))
-> x -> (x -> (s, [o], [[o]])) -> Transducer i o s
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
Transducer x -> i -> (x, [o], [[o]])
step' x
begin' x -> (s, [o], [[o]])
done' 
    where
    step' :: x -> i -> (x, [o], [[o]])
step' x
x i
a = Identity (x, [o], [[o]]) -> (x, [o], [[o]])
forall a. Identity a -> a
runIdentity (x -> i -> Identity (x, [o], [[o]])
step x
x i
a)
    begin' :: x
begin'    = Identity x -> x
forall a. Identity a -> a
runIdentity  Identity x
begin
    done' :: x -> (s, [o], [[o]])
done' x
x   = Identity (s, [o], [[o]]) -> (s, [o], [[o]])
forall a. Identity a -> a
runIdentity (x -> Identity (s, [o], [[o]])
done x
x)


{-| Transforms a 'Transducer' into a 'Fold' by forgetting about the data sent
    downstream.		

-}
foldify :: Transducer i o s -> Fold i s
foldify :: Transducer i o s -> Fold i s
foldify (Transducer x -> i -> (x, [o], [[o]])
step x
begin x -> (s, [o], [[o]])
done) =
    (x -> i -> x) -> x -> (x -> s) -> Fold i s
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\x
x i
i -> (x, [o], [[o]]) -> x
forall a b c. (a, b, c) -> a
fst3 (x -> i -> (x, [o], [[o]])
step x
x i
i)) x
begin (\x
x -> (s, [o], [[o]]) -> s
forall a b c. (a, b, c) -> a
fst3 (x -> (s, [o], [[o]])
done x
x))

{-| Monadic version of 'foldify'.		

-}
foldifyM :: Functor m => TransducerM m i o s -> FoldM m i s
foldifyM :: TransducerM m i o s -> FoldM m i s
foldifyM (TransducerM x -> i -> m (x, [o], [[o]])
step m x
begin x -> m (s, [o], [[o]])
done) =
    (x -> i -> m x) -> m x -> (x -> m s) -> FoldM m i s
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM (\x
x i
i -> ((x, [o], [[o]]) -> x) -> m (x, [o], [[o]]) -> m x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x, [o], [[o]]) -> x
forall a b c. (a, b, c) -> a
fst3 (x -> i -> m (x, [o], [[o]])
step x
x i
i)) m x
begin (\x
x -> ((s, [o], [[o]]) -> s) -> m (s, [o], [[o]]) -> m s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s, [o], [[o]]) -> s
forall a b c. (a, b, c) -> a
fst3 (x -> m (s, [o], [[o]])
done x
x))

{-| Transforms a 'Fold' into a 'Transducer' that sends the return value of the
    'Fold' downstream when upstream closes.		

-}
condense :: Fold a r -> Transducer a r r
condense :: Fold a r -> Transducer a r r
condense (Fold x -> a -> x
fstep x
fstate x -> r
fdone) =
    ((x -> a -> (x, [r], [[r]]))
-> x -> (x -> (r, [r], [[r]])) -> Transducer a r r
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
Transducer x -> a -> (x, [r], [[r]])
wstep x
fstate x -> (r, [r], [[r]])
wdone)
    where
        wstep :: x -> a -> (x, [r], [[r]])
wstep = \x
fstate' a
i -> (x -> a -> x
fstep x
fstate' a
i,[],[])
        wdone :: x -> (r, [r], [[r]])
wdone = \x
fstate' -> (\r
r -> (r
r,[r
r],[])) (x -> r
fdone x
fstate')

{-| Monadic version of 'condense'.		

-}
condenseM :: Applicative m => FoldM m a r -> TransducerM m a r r
condenseM :: FoldM m a r -> TransducerM m a r r
condenseM (FoldM x -> a -> m x
fstep m x
fstate x -> m r
fdone) = 
    ((x -> a -> m (x, [r], [[r]]))
-> m x -> (x -> m (r, [r], [[r]])) -> TransducerM m a r r
forall (m :: * -> *) i o r x.
(x -> i -> m (x, [o], [[o]]))
-> m x -> (x -> m (r, [o], [[o]])) -> TransducerM m i o r
TransducerM x -> a -> m (x, [r], [[r]])
wstep m x
fstate x -> m (r, [r], [[r]])
wdone)
    where
        wstep :: x -> a -> m (x, [r], [[r]])
wstep = \x
fstate' a
i -> (x -> (x, [r], [[r]])) -> m x -> m (x, [r], [[r]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\x
s -> (x
s,[],[])) (x -> a -> m x
fstep x
fstate' a
i)
        wdone :: x -> m (r, [r], [[r]])
wdone = \x
fstate' -> (r -> (r, [r], [[r]])) -> m r -> m (r, [r], [[r]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\r
r -> (r
r,[r
r],[])) (x -> m r
fdone x
fstate')


{-| Changes the base monad used by a 'TransducerM'.		

-}
hoistTransducer :: Monad m => (forall a. m a -> n a) -> TransducerM m i o s -> TransducerM n i o s 
hoistTransducer :: (forall a. m a -> n a)
-> TransducerM m i o s -> TransducerM n i o s
hoistTransducer forall a. m a -> n a
g (TransducerM x -> i -> m (x, [o], [[o]])
step m x
begin x -> m (s, [o], [[o]])
done) = (x -> i -> n (x, [o], [[o]]))
-> n x -> (x -> n (s, [o], [[o]])) -> TransducerM n i o s
forall (m :: * -> *) i o r x.
(x -> i -> m (x, [o], [[o]]))
-> m x -> (x -> m (r, [o], [[o]])) -> TransducerM m i o r
TransducerM (\x
s i
i -> m (x, [o], [[o]]) -> n (x, [o], [[o]])
forall a. m a -> n a
g (x -> i -> m (x, [o], [[o]])
step x
s i
i)) (m x -> n x
forall a. m a -> n a
g m x
begin) (m (s, [o], [[o]]) -> n (s, [o], [[o]])
forall a. m a -> n a
g (m (s, [o], [[o]]) -> n (s, [o], [[o]]))
-> (x -> m (s, [o], [[o]])) -> x -> n (s, [o], [[o]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m (s, [o], [[o]])
done)

{-| Changes the base monad used by a 'FoldM'.		

    Another name for 'Control.Foldl.hoists'.
-}
hoistFold :: Monad m => (forall a. m a -> n a) -> FoldM m i r -> FoldM n i r 
hoistFold :: (forall a. m a -> n a) -> FoldM m i r -> FoldM n i r
hoistFold = (forall a. m a -> n a) -> FoldM m i r -> FoldM n i r
forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x) -> FoldM m a b -> FoldM n a b
Control.Foldl.hoists

{-| Turn a 'FoldM' that fails abruptly into one that encodes the error into
    its return value.

    Can be useful when combining fallible 'FoldM's with non-fallible ones.

>>> L.foldM (quiesce (FoldM (\_ _-> throwE ()) (return ()) (\_ -> throwE ()))) [1..7]
Left ()
-}
quiesce :: Monad m => FoldM (ExceptT e m) a r -> FoldM m a (Either e r)
quiesce :: FoldM (ExceptT e m) a r -> FoldM m a (Either e r)
quiesce (FoldM x -> a -> ExceptT e m x
step ExceptT e m x
initial x -> ExceptT e m r
done) = 
    (Either e x -> a -> m (Either e x))
-> m (Either e x)
-> (Either e x -> m (Either e r))
-> FoldM m a (Either e r)
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM Either e x -> a -> m (Either e x)
step' (ExceptT e m x -> m (Either e x)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m x
initial) Either e x -> m (Either e r)
done'
    where
    step' :: Either e x -> a -> m (Either e x)
step' Either e x
x a
i = do  
        case Either e x
x of
            Left e
_ -> Either e x -> m (Either e x)
forall (m :: * -> *) a. Monad m => a -> m a
return Either e x
x
            Right x
notyetfail -> ExceptT e m x -> m (Either e x)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (x -> a -> ExceptT e m x
step x
notyetfail a
i)
    done' :: Either e x -> m (Either e r)
done' Either e x
x = do
        case Either e x
x of 
            Left e
e -> Either e r -> m (Either e r)
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> Either e r
forall a b. a -> Either a b
Left e
e)
            Right x
notyetfail -> do
                Either e r
result <- ExceptT e m r -> m (Either e r)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (x -> ExceptT e m r
done x
notyetfail)
                case Either e r
result of 
                    Left e
e -> Either e r -> m (Either e r)
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> Either e r
forall a b. a -> Either a b
Left e
e)
                    Right r
r -> Either e r -> m (Either e r)
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> Either e r
forall a b. b -> Either a b
Right r
r)

newtype Fallible m r i e = Fallible { Fallible m r i e -> FoldM (ExceptT e m) i r
getFallible :: FoldM (ExceptT e m) i r }

bindFallible :: (Functor m,Monad m) => Fallible m r i e -> (e -> Fallible m r i e') -> Fallible m r i e'
bindFallible :: Fallible m r i e -> (e -> Fallible m r i e') -> Fallible m r i e'
bindFallible (Fallible (FoldM x -> i -> ExceptT e m x
step ExceptT e m x
initial x -> ExceptT e m r
done)) e -> Fallible m r i e'
k =
    FoldM (ExceptT e' m) i r -> Fallible m r i e'
forall (m :: * -> *) r i e.
FoldM (ExceptT e m) i r -> Fallible m r i e
Fallible ((Either (FoldM (ExceptT e' m) i r) x
 -> i -> ExceptT e' m (Either (FoldM (ExceptT e' m) i r) x))
-> ExceptT e' m (Either (FoldM (ExceptT e' m) i r) x)
-> (Either (FoldM (ExceptT e' m) i r) x -> ExceptT e' m r)
-> FoldM (ExceptT e' m) i r
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM Either (FoldM (ExceptT e' m) i r) x
-> i -> ExceptT e' m (Either (FoldM (ExceptT e' m) i r) x)
step' (m (Either (FoldM (ExceptT e' m) i r) x)
-> ExceptT e' m (Either (FoldM (ExceptT e' m) i r) x)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT (FoldM (ExceptT e' m) i r) m x
-> m (Either (FoldM (ExceptT e' m) i r) x)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ((e -> FoldM (ExceptT e' m) i r)
-> ExceptT e m x -> ExceptT (FoldM (ExceptT e' m) i r) m x
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT (Fallible m r i e' -> FoldM (ExceptT e' m) i r
forall (m :: * -> *) r i e.
Fallible m r i e -> FoldM (ExceptT e m) i r
getFallible (Fallible m r i e' -> FoldM (ExceptT e' m) i r)
-> (e -> Fallible m r i e') -> e -> FoldM (ExceptT e' m) i r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Fallible m r i e'
k) ExceptT e m x
initial))) Either (FoldM (ExceptT e' m) i r) x -> ExceptT e' m r
done')
    where 
        step' :: Either (FoldM (ExceptT e' m) i r) x
-> i -> ExceptT e' m (Either (FoldM (ExceptT e' m) i r) x)
step' Either (FoldM (ExceptT e' m) i r) x
x i
i = m (Either e' (Either (FoldM (ExceptT e' m) i r) x))
-> ExceptT e' m (Either (FoldM (ExceptT e' m) i r) x)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (case Either (FoldM (ExceptT e' m) i r) x
x of
            Left FoldM (ExceptT e' m) i r
ffold -> do
                Either e' (FoldM (ExceptT e' m) i r)
rx <- ExceptT e' m (FoldM (ExceptT e' m) i r)
-> m (Either e' (FoldM (ExceptT e' m) i r))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (FoldM (ExceptT e' m) i (FoldM (ExceptT e' m) i r)
-> [i] -> ExceptT e' m (FoldM (ExceptT e' m) i r)
forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, Monad m) =>
FoldM m a b -> f a -> m b
L.foldM (FoldM (ExceptT e' m) i r
-> FoldM (ExceptT e' m) i (FoldM (ExceptT e' m) i r)
forall (w :: * -> *) a. Extend w => w a -> w (w a)
duplicated FoldM (ExceptT e' m) i r
ffold) [i
i])
                case Either e' (FoldM (ExceptT e' m) i r)
rx of
                    Left e'
e' -> Either e' (Either (FoldM (ExceptT e' m) i r) x)
-> m (Either e' (Either (FoldM (ExceptT e' m) i r) x))
forall (m :: * -> *) a. Monad m => a -> m a
return (e' -> Either e' (Either (FoldM (ExceptT e' m) i r) x)
forall a b. a -> Either a b
Left e'
e') -- true failure

                    Right FoldM (ExceptT e' m) i r
ffold' -> Either e' (Either (FoldM (ExceptT e' m) i r) x)
-> m (Either e' (Either (FoldM (ExceptT e' m) i r) x))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FoldM (ExceptT e' m) i r) x
-> Either e' (Either (FoldM (ExceptT e' m) i r) x)
forall a b. b -> Either a b
Right (FoldM (ExceptT e' m) i r -> Either (FoldM (ExceptT e' m) i r) x
forall a b. a -> Either a b
Left FoldM (ExceptT e' m) i r
ffold'))
            Right x
notyetfail -> do
                 Either e x
x' <- ExceptT e m x -> m (Either e x)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (x -> i -> ExceptT e m x
step x
notyetfail i
i)
                 case Either e x
x' of
                     Left e
e -> do
                         Either e' (Either (FoldM (ExceptT e' m) i r) x)
-> m (Either e' (Either (FoldM (ExceptT e' m) i r) x))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FoldM (ExceptT e' m) i r) x
-> Either e' (Either (FoldM (ExceptT e' m) i r) x)
forall a b. b -> Either a b
Right (FoldM (ExceptT e' m) i r -> Either (FoldM (ExceptT e' m) i r) x
forall a b. a -> Either a b
Left ((Fallible m r i e' -> FoldM (ExceptT e' m) i r
forall (m :: * -> *) r i e.
Fallible m r i e -> FoldM (ExceptT e m) i r
getFallible (Fallible m r i e' -> FoldM (ExceptT e' m) i r)
-> (e -> Fallible m r i e') -> e -> FoldM (ExceptT e' m) i r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Fallible m r i e'
k) e
e)))
                     Right x
x'' -> Either e' (Either (FoldM (ExceptT e' m) i r) x)
-> m (Either e' (Either (FoldM (ExceptT e' m) i r) x))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FoldM (ExceptT e' m) i r) x
-> Either e' (Either (FoldM (ExceptT e' m) i r) x)
forall a b. b -> Either a b
Right (x -> Either (FoldM (ExceptT e' m) i r) x
forall a b. b -> Either a b
Right x
x'')))
        done' :: Either (FoldM (ExceptT e' m) i r) x -> ExceptT e' m r
done' Either (FoldM (ExceptT e' m) i r) x
x = m (Either e' r) -> ExceptT e' m r
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (case Either (FoldM (ExceptT e' m) i r) x
x of
            Left FoldM (ExceptT e' m) i r
ffold -> do
                Either e' r
rx <- ExceptT e' m r -> m (Either e' r)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (FoldM (ExceptT e' m) i r -> [i] -> ExceptT e' m r
forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, Monad m) =>
FoldM m a b -> f a -> m b
L.foldM FoldM (ExceptT e' m) i r
ffold [])
                case Either e' r
rx of
                    Left e'
e' -> Either e' r -> m (Either e' r)
forall (m :: * -> *) a. Monad m => a -> m a
return (e' -> Either e' r
forall a b. a -> Either a b
Left e'
e') -- true failure

                    Right r
r -> Either e' r -> m (Either e' r)
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> Either e' r
forall a b. b -> Either a b
Right r
r)
            Right x
notyetfail -> do
                 Either e r
x' <- ExceptT e m r -> m (Either e r)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (x -> ExceptT e m r
done x
notyetfail)
                 case Either e r
x' of
                     Left e
e -> do
                         ExceptT e' m r -> m (Either e' r)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (Either (FoldM (ExceptT e' m) i r) x -> ExceptT e' m r
done' (FoldM (ExceptT e' m) i r -> Either (FoldM (ExceptT e' m) i r) x
forall a b. a -> Either a b
Left (Fallible m r i e' -> FoldM (ExceptT e' m) i r
forall (m :: * -> *) r i e.
Fallible m r i e -> FoldM (ExceptT e m) i r
getFallible (e -> Fallible m r i e'
k e
e))))
                     Right r
x'' -> Either e' r -> m (Either e' r)
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> Either e' r
forall a b. b -> Either a b
Right r
x''))

instance (Functor m, Monad m) => Functor (Fallible m r i) where
    fmap :: (a -> b) -> Fallible m r i a -> Fallible m r i b
fmap a -> b
g (Fallible FoldM (ExceptT a m) i r
fallible) = 
        FoldM (ExceptT b m) i r -> Fallible m r i b
forall (m :: * -> *) r i e.
FoldM (ExceptT e m) i r -> Fallible m r i e
Fallible ((forall a. ExceptT a m a -> ExceptT b m a)
-> FoldM (ExceptT a m) i r -> FoldM (ExceptT b m) i r
forall (m :: * -> *) (n :: * -> *) i r.
Monad m =>
(forall a. m a -> n a) -> FoldM m i r -> FoldM n i r
hoistFold ((a -> b) -> ExceptT a m a -> ExceptT b m a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT a -> b
g) FoldM (ExceptT a m) i r
fallible)


{-| 'pure' creates a 'Fallible' that starts in a failed state.		

-}
instance (Functor m,Monad m) => Applicative (Fallible m r i) where
    pure :: a -> Fallible m r i a
pure a
e = FoldM (ExceptT a m) i r -> Fallible m r i a
forall (m :: * -> *) r i e.
FoldM (ExceptT e m) i r -> Fallible m r i e
Fallible ((Any -> i -> ExceptT a m Any)
-> ExceptT a m Any
-> (Any -> ExceptT a m r)
-> FoldM (ExceptT a m) i r
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM (\Any
_ i
_ -> a -> ExceptT a m Any
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE a
e) (a -> ExceptT a m Any
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE a
e) (\Any
_ -> a -> ExceptT a m r
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE a
e))

    Fallible m r i (a -> b)
u <*> :: Fallible m r i (a -> b) -> Fallible m r i a -> Fallible m r i b
<*> Fallible m r i a
v = Fallible m r i (a -> b)
u Fallible m r i (a -> b)
-> ((a -> b) -> Fallible m r i b) -> Fallible m r i b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a -> b
f -> (a -> b) -> Fallible m r i a -> Fallible m r i b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Fallible m r i a
v

instance (Functor m, Monad m) => Profunctor (Fallible m r) where
    lmap :: (a -> b) -> Fallible m r b c -> Fallible m r a c
lmap a -> b
f (Fallible FoldM (ExceptT c m) b r
fallible) = 
        FoldM (ExceptT c m) a r -> Fallible m r a c
forall (m :: * -> *) r i e.
FoldM (ExceptT e m) i r -> Fallible m r i e
Fallible ((a -> ExceptT c m b)
-> FoldM (ExceptT c m) b r -> FoldM (ExceptT c m) a r
forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> FoldM m b r -> FoldM m a r
L.premapM (b -> ExceptT c m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ExceptT c m b) -> (a -> b) -> a -> ExceptT c m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) FoldM (ExceptT c m) b r
fallible)

    rmap :: (b -> c) -> Fallible m r a b -> Fallible m r a c
rmap b -> c
g (Fallible FoldM (ExceptT b m) a r
fallible) = 
        FoldM (ExceptT c m) a r -> Fallible m r a c
forall (m :: * -> *) r i e.
FoldM (ExceptT e m) i r -> Fallible m r i e
Fallible ((forall a. ExceptT b m a -> ExceptT c m a)
-> FoldM (ExceptT b m) a r -> FoldM (ExceptT c m) a r
forall (m :: * -> *) (n :: * -> *) i r.
Monad m =>
(forall a. m a -> n a) -> FoldM m i r -> FoldM n i r
hoistFold ((b -> c) -> ExceptT b m a -> ExceptT c m a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT b -> c
g) FoldM (ExceptT b m) a r
fallible)

{-| Fail immediately when an input comes in the wrong branch.		

-}
instance (Functor m,Monad m,Monoid r) => Choice (Fallible m r) where
    left' :: Fallible m r a b -> Fallible m r (Either a c) (Either b c)
left' (Fallible FoldM (ExceptT b m) a r
fallible) = 
        FoldM (ExceptT (Either b c) m) (Either a c) r
-> Fallible m r (Either a c) (Either b c)
forall (m :: * -> *) r i e.
FoldM (ExceptT e m) i r -> Fallible m r i e
Fallible ((r -> r -> r)
-> FoldM (ExceptT (Either b c) m) (Either a c) r
-> FoldM (ExceptT (Either b c) m) (Either a c) r
-> FoldM (ExceptT (Either b c) m) (Either a c) r
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 r -> r -> r
forall a. Monoid a => a -> a -> a
mappend ((forall a. ExceptT b m a -> ExceptT (Either b c) m a)
-> FoldM (ExceptT b m) (Either a c) r
-> FoldM (ExceptT (Either b c) m) (Either a c) r
forall (m :: * -> *) (n :: * -> *) i r.
Monad m =>
(forall a. m a -> n a) -> FoldM m i r -> FoldM n i r
hoistFold ((b -> Either b c) -> ExceptT b m a -> ExceptT (Either b c) m a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT b -> Either b c
forall a b. a -> Either a b
Left) (HandlerM (ExceptT b m) (Either a c) a
-> FoldM (ExceptT b m) a r -> FoldM (ExceptT b m) (Either a c) r
forall (m :: * -> *) a b r.
HandlerM m a b -> FoldM m b r -> FoldM m a r
L.handlesM HandlerM (ExceptT b m) (Either a c) a
forall (f :: * -> *) a b.
Applicative f =>
(a -> f a) -> Either a b -> f (Either a b)
_Left FoldM (ExceptT b m) a r
fallible)) ((forall a. ExceptT c m a -> ExceptT (Either b c) m a)
-> FoldM (ExceptT c m) (Either a c) r
-> FoldM (ExceptT (Either b c) m) (Either a c) r
forall (m :: * -> *) (n :: * -> *) i r.
Monad m =>
(forall a. m a -> n a) -> FoldM m i r -> FoldM n i r
hoistFold ((c -> Either b c) -> ExceptT c m a -> ExceptT (Either b c) m a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT c -> Either b c
forall a b. b -> Either a b
Right) (HandlerM (ExceptT c m) (Either a c) c
-> FoldM (ExceptT c m) c r -> FoldM (ExceptT c m) (Either a c) r
forall (m :: * -> *) a b r.
HandlerM m a b -> FoldM m b r -> FoldM m a r
L.handlesM HandlerM (ExceptT c m) (Either a c) c
forall (f :: * -> *) b a.
Applicative f =>
(b -> f b) -> Either a b -> f (Either a b)
_Right (FoldM (ExceptT c m) c ()
forall (m :: * -> *) a. Monad m => FoldM (ExceptT a m) a ()
trip FoldM (ExceptT c m) c () -> r -> FoldM (ExceptT c m) c r
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> r
forall a. Monoid a => a
mempty))))

_Left :: Applicative f => (a -> f a) -> Either a b -> f (Either a b)
_Left :: (a -> f a) -> Either a b -> f (Either a b)
_Left a -> f a
f Either a b
e = case Either a b
e of
    Right b
b -> Either a b -> f (Either a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Either a b
forall a b. b -> Either a b
Right b
b)
    Left a
a -> (a -> Either a b) -> f a -> f (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a b
forall a b. a -> Either a b
Left (a -> f a
f a
a)

_Right :: Applicative f => (b -> f b) -> Either a b -> f (Either a b)
_Right :: (b -> f b) -> Either a b -> f (Either a b)
_Right b -> f b
f Either a b
e = case Either a b
e of
    Left a
b -> Either a b -> f (Either a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either a b
forall a b. a -> Either a b
Left a
b)
    Right b
a -> (b -> Either a b) -> f b -> f (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either a b
forall a b. b -> Either a b
Right (b -> f b
f b
a)

{-| '>>=' continues folding after an error using a 'Fallible' constructed from the error.		

-}
instance (Functor m,Monad m) => Monad (Fallible m r i) where
    >>= :: Fallible m r i a -> (a -> Fallible m r i b) -> Fallible m r i b
(>>=) = Fallible m r i a -> (a -> Fallible m r i b) -> Fallible m r i b
forall (m :: * -> *) r i e e'.
(Functor m, Monad m) =>
Fallible m r i e -> (e -> Fallible m r i e') -> Fallible m r i e'
bindFallible
    return :: a -> Fallible m r i a
return = a -> Fallible m r i a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

{-| The "do-nothing" fold.		

-}
unit :: Fold a ()
unit :: Fold a ()
unit = () -> Fold a ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () 

{-| A fold that fails if it receives any input at all. The received input is
    used as the error.		

-}
trip :: Monad m => FoldM (ExceptT a m) a ()
trip :: FoldM (ExceptT a m) a ()
trip = (() -> a -> ExceptT a m ())
-> ExceptT a m ()
-> (() -> ExceptT a m ())
-> FoldM (ExceptT a m) a ()
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM (\()
_ a
x -> a -> ExceptT a m ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE a
x) (() -> ExceptT a m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (\()
_ -> () -> ExceptT a m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall a. Monoid a => a
mempty)

------------------------------------------------------------------------------


{-| An unending machine that eats @u@ values and returns 
    'ReifiedTransduction''s whose result type is also @u@.

-}
newtype Moore a b u = Moore { Moore a b u -> Cofree ((->) u) (ReifiedTransduction' a b u)
getMoore :: Cofree ((->) u) (ReifiedTransduction' a b u) }

{-| Monadic version of 'Moore'.		

-}
newtype MooreM m a b u = MooreM { MooreM m a b u -> Cofree ((->) u) (ReifiedTransductionM' m a b u)
getMooreM :: Cofree ((->) u) (ReifiedTransductionM' m a b u) }

{-| Prepend the head of the first argument to the second argument.		

-}
moveHead :: (ToTransductions' h,ToTransductions' t) => h a b u -> t a b u -> Moore a b u 
moveHead :: h a b u -> t a b u -> Moore a b u
moveHead (h a b u -> Moore a b u
forall (t :: * -> * -> * -> *) a b u.
ToTransductions' t =>
t a b u -> Moore a b u
toTransductions' -> Moore (ReifiedTransduction' a b u
theHead :< u -> Cofree ((->) u) (ReifiedTransduction' a b u)
_)) (t a b u -> Moore a b u
forall (t :: * -> * -> * -> *) a b u.
ToTransductions' t =>
t a b u -> Moore a b u
toTransductions' -> Moore Cofree ((->) u) (ReifiedTransduction' a b u)
theTail) = Cofree ((->) u) (ReifiedTransduction' a b u) -> Moore a b u
forall a b u.
Cofree ((->) u) (ReifiedTransduction' a b u) -> Moore a b u
Moore (ReifiedTransduction' a b u
theHead ReifiedTransduction' a b u
-> (u -> Cofree ((->) u) (ReifiedTransduction' a b u))
-> Cofree ((->) u) (ReifiedTransduction' a b u)
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< Cofree ((->) u) (ReifiedTransduction' a b u)
-> u -> Cofree ((->) u) (ReifiedTransduction' a b u)
forall a b. a -> b -> a
const Cofree ((->) u) (ReifiedTransduction' a b u)
theTail)

{-| Monadic version of 'moveHead'.		

-}
moveHeadM :: (Monad m, ToTransductionsM' m h, ToTransductionsM' m t) => h a b u -> t a b u -> MooreM m a b u 
moveHeadM :: h a b u -> t a b u -> MooreM m a b u
moveHeadM (h a b u -> MooreM m a b u
forall (m :: * -> *) (t :: * -> * -> * -> *) a b u.
ToTransductionsM' m t =>
t a b u -> MooreM m a b u
toTransductionsM' -> MooreM (ReifiedTransductionM' m a b u
theHead :< u -> Cofree ((->) u) (ReifiedTransductionM' m a b u)
_)) (t a b u -> MooreM m a b u
forall (m :: * -> *) (t :: * -> * -> * -> *) a b u.
ToTransductionsM' m t =>
t a b u -> MooreM m a b u
toTransductionsM' -> MooreM Cofree ((->) u) (ReifiedTransductionM' m a b u)
theTail) = Cofree ((->) u) (ReifiedTransductionM' m a b u) -> MooreM m a b u
forall (m :: * -> *) a b u.
Cofree ((->) u) (ReifiedTransductionM' m a b u) -> MooreM m a b u
MooreM (ReifiedTransductionM' m a b u
theHead ReifiedTransductionM' m a b u
-> (u -> Cofree ((->) u) (ReifiedTransductionM' m a b u))
-> Cofree ((->) u) (ReifiedTransductionM' m a b u)
forall (f :: * -> *) a. a -> f (Cofree f a) -> Cofree f a
:< Cofree ((->) u) (ReifiedTransductionM' m a b u)
-> u -> Cofree ((->) u) (ReifiedTransductionM' m a b u)
forall a b. a -> b -> a
const Cofree ((->) u) (ReifiedTransductionM' m a b u)
theTail)

{-| Helper for obtaining infinite sequences of 'Transduction''s from suitable
    types (in order to avoid explicit conversions).		

-}
class ToTransductions' t where
    toTransductions' :: t a b u -> Moore a b u

instance ToTransductions' Moore where
    toTransductions' :: Moore a b u -> Moore a b u
toTransductions' = Moore a b u -> Moore a b u
forall a. a -> a
id

instance ToTransductions' Transducer where
    toTransductions' :: Transducer a b u -> Moore a b u
toTransductions' Transducer a b u
t = ReifiedTransduction' a b u -> Moore a b u
forall (t :: * -> * -> * -> *) a b u.
ToTransductions' t =>
t a b u -> Moore a b u
toTransductions' (Transduction' a b u -> ReifiedTransduction' a b u
forall a b r. Transduction' a b r -> ReifiedTransduction' a b r
reify' (Transducer a b u -> Transduction' a b u
forall (t :: * -> * -> * -> *) i o s.
ToTransducer t =>
t i o s -> Transduction' i o s
transduce' Transducer a b u
t))

instance ToTransductions' ReifiedTransduction' where
    toTransductions' :: ReifiedTransduction' a b u -> Moore a b u
toTransductions' = Cofree ((->) u) (ReifiedTransduction' a b u) -> Moore a b u
forall a b u.
Cofree ((->) u) (ReifiedTransduction' a b u) -> Moore a b u
Moore (Cofree ((->) u) (ReifiedTransduction' a b u) -> Moore a b u)
-> (ReifiedTransduction' a b u
    -> Cofree ((->) u) (ReifiedTransduction' a b u))
-> ReifiedTransduction' a b u
-> Moore a b u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReifiedTransduction' a b u -> u -> ReifiedTransduction' a b u)
-> ReifiedTransduction' a b u
-> Cofree ((->) u) (ReifiedTransduction' a b u)
forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Cofree f a
coiter ReifiedTransduction' a b u -> u -> ReifiedTransduction' a b u
forall a b. a -> b -> a
const

{-| Monadic version of 'ToTransductions''.		

-}
class Monad m => ToTransductionsM' m t where
    toTransductionsM' :: t a b u -> MooreM m a b u

instance (m ~ m', Monad m') => ToTransductionsM' m (MooreM m') where
    toTransductionsM' :: MooreM m' a b u -> MooreM m a b u
toTransductionsM' = MooreM m' a b u -> MooreM m a b u
forall a. a -> a
id

instance (m ~ m', Monad m') => ToTransductionsM' m (TransducerM m') where
    toTransductionsM' :: TransducerM m' a b u -> MooreM m a b u
toTransductionsM' TransducerM m' a b u
t = ReifiedTransductionM' m' a b u -> MooreM m a b u
forall (m :: * -> *) (t :: * -> * -> * -> *) a b u.
ToTransductionsM' m t =>
t a b u -> MooreM m a b u
toTransductionsM' (TransductionM' m' a b u -> ReifiedTransductionM' m' a b u
forall (m :: * -> *) a b r.
TransductionM' m a b r -> ReifiedTransductionM' m a b r
reifyM' (TransducerM m' a b u -> TransductionM' m' a b u
forall (m :: * -> *) (t :: * -> * -> * -> *) i o s.
(Monad m, ToTransducerM m t) =>
t i o s -> TransductionM' m i o s
transduceM' TransducerM m' a b u
t))

instance Monad m => ToTransductionsM' m Transducer where
    toTransductionsM' :: Transducer a b u -> MooreM m a b u
toTransductionsM' (Transducer a b u -> TransducerM m a b u
forall (m :: * -> *) (t :: * -> * -> * -> *) i o r.
ToTransducerM m t =>
t i o r -> TransducerM m i o r
toTransducerM -> TransducerM m a b u
t) = ReifiedTransductionM' m a b u -> MooreM m a b u
forall (m :: * -> *) (t :: * -> * -> * -> *) a b u.
ToTransductionsM' m t =>
t a b u -> MooreM m a b u
toTransductionsM' (TransductionM' m a b u -> ReifiedTransductionM' m a b u
forall (m :: * -> *) a b r.
TransductionM' m a b r -> ReifiedTransductionM' m a b r
reifyM' (TransducerM m a b u -> TransductionM' m a b u
forall (m :: * -> *) (t :: * -> * -> * -> *) i o s.
(Monad m, ToTransducerM m t) =>
t i o s -> TransductionM' m i o s
transduceM' TransducerM m a b u
t))

instance (m ~ m', Monad m') => ToTransductionsM' m (ReifiedTransductionM' m') where
    toTransductionsM' :: ReifiedTransductionM' m' a b u -> MooreM m a b u
toTransductionsM' = Cofree ((->) u) (ReifiedTransductionM' m a b u) -> MooreM m a b u
forall (m :: * -> *) a b u.
Cofree ((->) u) (ReifiedTransductionM' m a b u) -> MooreM m a b u
MooreM (Cofree ((->) u) (ReifiedTransductionM' m a b u) -> MooreM m a b u)
-> (ReifiedTransductionM' m a b u
    -> Cofree ((->) u) (ReifiedTransductionM' m a b u))
-> ReifiedTransductionM' m a b u
-> MooreM m a b u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReifiedTransductionM' m a b u
 -> u -> ReifiedTransductionM' m a b u)
-> ReifiedTransductionM' m a b u
-> Cofree ((->) u) (ReifiedTransductionM' m a b u)
forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Cofree f a
coiter ReifiedTransductionM' m a b u -> u -> ReifiedTransductionM' m a b u
forall a b. a -> b -> a
const

{-| Processes each of the groups demarcated by a 'Transducer' using 
    a 'Transduction' taken from an unending supply, 
    returning a 'Transduction' what works over the undivided stream of inputs. 
    
    The return value of the 'Transducer' is discarded.

>>> L.fold (groups (chunksOf 2) (surround "<" ">") L.list) "aabbccdd"
"<aa><bb><cc><dd>"

>>> :{ 
    let transductions = Moore (C.unfold (\i ->
          (reify (transduce (surround (show i) [])), \_ -> succ i)) 0)
    in L.fold (groups (chunksOf 2) transductions L.list) "aabbccdd"
    :}
"0aa1bb2cc3dd"
-}
groups :: (ToTransducer s, ToTransductions' t) 
       => s a b () -- ^ 'Transducer' working as a splitter.

       -> t b c () -- ^ infinite list of transductions

       -> Transduction a c 
groups :: s a b () -> t b c () -> Transduction a c
groups s a b ()
splitter t b c ()
transductions Fold c x
oldfold = 
        ((((), ()), x) -> x) -> Fold a (((), ()), x) -> Fold a x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((), ()), x) -> x
forall a b. (a, b) -> b
snd (s a b ()
-> t b c () -> Fold () () -> Fold c x -> Fold a (((), ()), x)
forall (s :: * -> * -> * -> *) (t :: * -> * -> * -> *)
       (f :: * -> * -> *) a b r c u v.
(ToTransducer s, ToTransductions' t, ToFold f) =>
s a b r -> t b c u -> f u v -> Transduction' a c (r, v)
groups' s a b ()
splitter t b c ()
transductions Fold () ()
forall a. Fold a ()
unit Fold c x
oldfold)

{-| Use a different 'Transduction' for the first detected group.		

>>> :{ 
    let drop n = bisect (splitAt n) ignore (reify id)
    in L.fold (drop 2 L.list) "aabbccdd"
    :}
"bbccdd"
-}
bisect :: (ToTransducer s, ToTransductions' h, ToTransductions' t)
       => s a b () -- ^ 'Transducer' working as a splitter.

       -> h b c () -- ^ Machine to process the first group

       -> t b c () -- ^ Machine to process the second and subsequent groups

       -> Transduction a c
bisect :: s a b () -> h b c () -> t b c () -> Transduction a c
bisect s a b ()
sp h b c ()
t1 t b c ()
t2 = s a b () -> Moore b c () -> Transduction a c
forall (s :: * -> * -> * -> *) (t :: * -> * -> * -> *) a b c.
(ToTransducer s, ToTransductions' t) =>
s a b () -> t b c () -> Transduction a c
groups s a b ()
sp (h b c () -> t b c () -> Moore b c ()
forall (h :: * -> * -> * -> *) (t :: * -> * -> * -> *) a b u.
(ToTransductions' h, ToTransductions' t) =>
h a b u -> t a b u -> Moore a b u
moveHead h b c ()
t1 t b c ()
t2)

data StrictSum a b = Left' !a | Right' !b

{-| Generalized version of 'groups' that preserves the return value of the
    'Transducer'.

    A summary value for each group is also calculated. These values are 
    aggregated for the whole stream, with the help of an auxiliary 'Fold'.


>>> :{ 
    let transductions = 
          reify' (\f -> transduce (surround "<" ">") ((,) <$> L.list <*> f))
    in L.fold (groups' (chunksOf 2) transductions L.list L.list) "aabbccdd"
    :}
(((),["<aa>","<bb>","<cc>","<dd>"]),"<aa><bb><cc><dd>")
-}
groups' :: (ToTransducer s, ToTransductions' t, ToFold f)
        => s a b r -- ^ 'Transducer' working as a splitter. 

        -> t b c u -- ^ machine that eats @u@ values and spits transductions

        -> f     u v -- ^ auxiliary 'Fold' that aggregates the @u@ values produced for each group

        -> Transduction' a c (r,v) 
groups' :: s a b r -> t b c u -> f u v -> Transduction' a c (r, v)
groups' (s a b r -> Transducer a b r
forall (t :: * -> * -> * -> *) i o r.
ToTransducer t =>
t i o r -> Transducer i o r
toTransducer -> Transducer x -> a -> (x, [b], [[b]])
sstep x
sbegin x -> (r, [b], [[b]])
sdone) 
        (t b c u -> Moore b c u
forall (t :: * -> * -> * -> *) a b u.
ToTransductions' t =>
t a b u -> Moore a b u
toTransductions' -> Moore (ReifiedTransduction' b c u
rt0 :< u -> Cofree ((->) u) (ReifiedTransduction' b c u)
somemachine)) 
        (f u v -> Fold u v
forall (t :: * -> * -> *) i r. ToFold t => t i r -> Fold i r
toFold -> Fold x -> u -> x
astep x
abegin x -> v
adone) 
        Fold c x
somefold 
        =
    (Quartet
   x
   (u -> Cofree ((->) u) (ReifiedTransduction' b c u))
   x
   (StrictSum
      (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x)))
 -> a
 -> Quartet
      x
      (u -> Cofree ((->) u) (ReifiedTransduction' b c u))
      x
      (StrictSum
         (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x))))
-> Quartet
     x
     (u -> Cofree ((->) u) (ReifiedTransduction' b c u))
     x
     (StrictSum
        (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x)))
-> (Quartet
      x
      (u -> Cofree ((->) u) (ReifiedTransduction' b c u))
      x
      (StrictSum
         (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x)))
    -> ((r, v), x))
-> Fold a ((r, v), x)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold Quartet
  x
  (u -> Cofree ((->) u) (ReifiedTransduction' b c u))
  x
  (StrictSum
     (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x)))
-> a
-> Quartet
     x
     (u -> Cofree ((->) u) (ReifiedTransduction' b c u))
     x
     (StrictSum
        (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x)))
step (x
-> (u -> Cofree ((->) u) (ReifiedTransduction' b c u))
-> x
-> StrictSum
     (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x))
-> Quartet
     x
     (u -> Cofree ((->) u) (ReifiedTransduction' b c u))
     x
     (StrictSum
        (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x)))
forall a b c d. a -> b -> c -> d -> Quartet a b c d
Quartet x
sbegin u -> Cofree ((->) u) (ReifiedTransduction' b c u)
somemachine x
abegin ((ReifiedTransduction' b c u, Fold c x)
-> StrictSum
     (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x))
forall a b. a -> StrictSum a b
Left' (ReifiedTransduction' b c u
rt0,Fold c x
somefold))) Quartet
  x
  (u -> Cofree ((->) u) (ReifiedTransduction' b c u))
  x
  (StrictSum
     (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x)))
-> ((r, v), x)
done 
    where 
        step :: Quartet
  x
  (u -> Cofree ((->) u) (ReifiedTransduction' b c u))
  x
  (StrictSum
     (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x)))
-> a
-> Quartet
     x
     (u -> Cofree ((->) u) (ReifiedTransduction' b c u))
     x
     (StrictSum
        (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x)))
step (Quartet x
sstate u -> Cofree ((->) u) (ReifiedTransduction' b c u)
machine x
astate StrictSum
  (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x))
innerfold) a
i =
           let (x
sstate',[b]
oldSplit,[[b]]
newSplits) = x -> a -> (x, [b], [[b]])
sstep x
sstate a
i
           in
           case ([b]
oldSplit,[[b]]
newSplits) of
                ([],[]) -> 
                    x
-> (u -> Cofree ((->) u) (ReifiedTransduction' b c u))
-> x
-> StrictSum
     (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x))
-> Quartet
     x
     (u -> Cofree ((->) u) (ReifiedTransduction' b c u))
     x
     (StrictSum
        (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x)))
forall a b c d. a -> b -> c -> d -> Quartet a b c d
Quartet x
sstate' u -> Cofree ((->) u) (ReifiedTransduction' b c u)
machine x
astate StrictSum
  (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x))
innerfold -- pass innerfold untouched

                ([b], [[b]])
_ -> 
                    let actualinnerfold :: Fold b (u, Fold c x)
actualinnerfold = case StrictSum
  (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x))
innerfold of
                            Left' (ReifiedTransduction' Transduction' b c u
t0,Fold c x
pristine) -> Fold c (Fold c x) -> Fold b (u, Fold c x)
Transduction' b c u
t0 (Fold c x -> Fold c (Fold c x)
forall (w :: * -> *) a. Extend w => w a -> w (w a)
duplicated Fold c x
pristine)
                            Right' Fold b (u, Fold c x)
touched -> Fold b (u, Fold c x)
touched
                        (u -> Cofree ((->) u) (ReifiedTransduction' b c u)
machine',x
astate',Fold b (u, Fold c x)
innerfold') = 
                           ((u -> Cofree ((->) u) (ReifiedTransduction' b c u), x,
  Fold b (u, Fold c x))
 -> [b]
 -> (u -> Cofree ((->) u) (ReifiedTransduction' b c u), x,
     Fold b (u, Fold c x)))
-> (u -> Cofree ((->) u) (ReifiedTransduction' b c u), x,
    Fold b (u, Fold c x))
-> [[b]]
-> (u -> Cofree ((->) u) (ReifiedTransduction' b c u), x,
    Fold b (u, Fold c x))
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' 
                           (u -> Cofree ((->) u) (ReifiedTransduction' b c u), x,
 Fold b (u, Fold c x))
-> [b]
-> (u -> Cofree ((->) u) (ReifiedTransduction' b c u), x,
    Fold b (u, Fold c x))
step'
                           (u -> Cofree ((->) u) (ReifiedTransduction' b c u)
machine,x
astate,Fold b (u, Fold c x) -> [b] -> Fold b (u, Fold c x)
forall a a. Fold a a -> [a] -> Fold a a
feed Fold b (u, Fold c x)
actualinnerfold [b]
oldSplit) 
                           [[b]]
newSplits
                    in
                    x
-> (u -> Cofree ((->) u) (ReifiedTransduction' b c u))
-> x
-> StrictSum
     (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x))
-> Quartet
     x
     (u -> Cofree ((->) u) (ReifiedTransduction' b c u))
     x
     (StrictSum
        (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x)))
forall a b c d. a -> b -> c -> d -> Quartet a b c d
Quartet x
sstate' u -> Cofree ((->) u) (ReifiedTransduction' b c u)
machine' x
astate' (Fold b (u, Fold c x)
-> StrictSum
     (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x))
forall a b. b -> StrictSum a b
Right' Fold b (u, Fold c x)
innerfold')
        
        done :: Quartet
  x
  (u -> Cofree ((->) u) (ReifiedTransduction' b c u))
  x
  (StrictSum
     (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x)))
-> ((r, v), x)
done (Quartet x
sstate u -> Cofree ((->) u) (ReifiedTransduction' b c u)
machine x
astate StrictSum
  (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x))
innerfold) = 
            let (r
s,[b]
oldSplit,[[b]]
newSplits) = x -> (r, [b], [[b]])
sdone x
sstate
            in
            case ([b]
oldSplit,[[b]]
newSplits,StrictSum
  (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x))
innerfold) of
                ([],[],Left' (ReifiedTransduction' b c u
_,Fold c x
pristine)) -> 
                    ((r
s,x -> v
adone x
astate), Fold c x -> x
forall (w :: * -> *) a. Comonad w => w a -> a
extract Fold c x
pristine)
                ([b], [[b]],
 StrictSum
   (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x)))
_ ->     
                    let actualinnerfold :: Fold b (u, Fold c x)
actualinnerfold = case StrictSum
  (ReifiedTransduction' b c u, Fold c x) (Fold b (u, Fold c x))
innerfold of
                            Left' (ReifiedTransduction' Transduction' b c u
t0,Fold c x
pristine) -> Fold c (Fold c x) -> Fold b (u, Fold c x)
Transduction' b c u
t0 (Fold c x -> Fold c (Fold c x)
forall (w :: * -> *) a. Extend w => w a -> w (w a)
duplicated Fold c x
pristine)
                            Right' Fold b (u, Fold c x)
touched -> Fold b (u, Fold c x)
touched
                        (u -> Cofree ((->) u) (ReifiedTransduction' b c u)
_,x
astate',Fold b (u, Fold c x)
innerfold') = 
                           ((u -> Cofree ((->) u) (ReifiedTransduction' b c u), x,
  Fold b (u, Fold c x))
 -> [b]
 -> (u -> Cofree ((->) u) (ReifiedTransduction' b c u), x,
     Fold b (u, Fold c x)))
-> (u -> Cofree ((->) u) (ReifiedTransduction' b c u), x,
    Fold b (u, Fold c x))
-> [[b]]
-> (u -> Cofree ((->) u) (ReifiedTransduction' b c u), x,
    Fold b (u, Fold c x))
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' 
                           (u -> Cofree ((->) u) (ReifiedTransduction' b c u), x,
 Fold b (u, Fold c x))
-> [b]
-> (u -> Cofree ((->) u) (ReifiedTransduction' b c u), x,
    Fold b (u, Fold c x))
step'
                           (u -> Cofree ((->) u) (ReifiedTransduction' b c u)
machine,x
astate,Fold b (u, Fold c x) -> [b] -> Fold b (u, Fold c x)
forall a a. Fold a a -> [a] -> Fold a a
feed Fold b (u, Fold c x)
actualinnerfold [b]
oldSplit) 
                           [[b]]
newSplits
                        (u
u,Fold c x
finalfold) = Fold b (u, Fold c x) -> (u, Fold c x)
forall (w :: * -> *) a. Comonad w => w a -> a
extract Fold b (u, Fold c x)
innerfold'
                    in  
                    ((r
s,x -> v
adone (x -> u -> x
astep x
astate' u
u)),Fold c x -> x
forall (w :: * -> *) a. Comonad w => w a -> a
extract Fold c x
finalfold)

        step' :: (u -> Cofree ((->) u) (ReifiedTransduction' b c u), x,
 Fold b (u, Fold c x))
-> [b]
-> (u -> Cofree ((->) u) (ReifiedTransduction' b c u), x,
    Fold b (u, Fold c x))
step' (u -> Cofree ((->) u) (ReifiedTransduction' b c u)
machine_,x
astate,Fold b (u, Fold c x)
innerfold_) [b]
somesplit = 
           let (u
u,Fold b (u, Fold c x)
resetted,u -> Cofree ((->) u) (ReifiedTransduction' b c u)
nextmachine) = (u -> Cofree ((->) u) (ReifiedTransduction' b c u))
-> Fold b (u, Fold c x)
-> (u, Fold b (u, Fold c x),
    u -> Cofree ((->) u) (ReifiedTransduction' b c u))
forall a (f :: * -> *) a b r a a.
(a -> Cofree f (ReifiedTransduction' a b r))
-> Fold a (a, Fold b a)
-> (a, Fold a (r, Fold b a),
    f (Cofree f (ReifiedTransduction' a b r)))
reset u -> Cofree ((->) u) (ReifiedTransduction' b c u)
machine_ Fold b (u, Fold c x)
innerfold_
           in  (u -> Cofree ((->) u) (ReifiedTransduction' b c u)
nextmachine,x -> u -> x
astep x
astate u
u,Fold b (u, Fold c x) -> [b] -> Fold b (u, Fold c x)
forall a a. Fold a a -> [a] -> Fold a a
feed Fold b (u, Fold c x)
resetted [b]
somesplit)

        feed :: Fold a a -> [a] -> Fold a a
feed = Fold a (Fold a a) -> [a] -> Fold a a
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (Fold a (Fold a a) -> [a] -> Fold a a)
-> (Fold a a -> Fold a (Fold a a)) -> Fold a a -> [a] -> Fold a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fold a a -> Fold a (Fold a a)
forall (w :: * -> *) a. Extend w => w a -> w (w a)
duplicated

        reset :: (a -> Cofree f (ReifiedTransduction' a b r))
-> Fold a (a, Fold b a)
-> (a, Fold a (r, Fold b a),
    f (Cofree f (ReifiedTransduction' a b r)))
reset a -> Cofree f (ReifiedTransduction' a b r)
machine (Fold x -> a -> x
_ x
fstate x -> (a, Fold b a)
fdone) = 
            let (a
u,Fold b a
nextfold) = x -> (a, Fold b a)
fdone x
fstate
                ReifiedTransduction' Transduction' a b r
t1 :< f (Cofree f (ReifiedTransduction' a b r))
nextmachine = a -> Cofree f (ReifiedTransduction' a b r)
machine a
u
            in  (a
u,Fold b (Fold b a) -> Fold a (r, Fold b a)
Transduction' a b r
t1 (Fold b a -> Fold b (Fold b a)
forall (w :: * -> *) a. Extend w => w a -> w (w a)
duplicated Fold b a
nextfold),f (Cofree f (ReifiedTransduction' a b r))
nextmachine)

{-| Monadic version of 'groups'.		

-}
groupsM :: (Monad m, ToTransducerM m s, ToTransductionsM' m t)
               => s a b () -- ^

               -> t b c ()
               -> TransductionM m a c
groupsM :: s a b () -> t b c () -> TransductionM m a c
groupsM s a b ()
splitter t b c ()
transductions FoldM m c x
oldfold = 
        ((((), ()), x) -> x) -> FoldM m a (((), ()), x) -> FoldM m a x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((), ()), x) -> x
forall a b. (a, b) -> b
snd (s a b ()
-> t b c () -> Fold () () -> FoldM m c x -> FoldM m a (((), ()), x)
forall (m :: * -> *) (s :: * -> * -> * -> *)
       (t :: * -> * -> * -> *) (f :: * -> * -> *) a b r c u v.
(Monad m, ToTransducerM m s, ToTransductionsM' m t, ToFoldM m f) =>
s a b r -> t b c u -> f u v -> TransductionM' m a c (r, v)
groupsM' s a b ()
splitter t b c ()
transductions Fold () ()
forall a. Fold a ()
unit FoldM m c x
oldfold)


{-| Monadic version of 'bisect'.		

-}
bisectM :: (Monad m, ToTransducerM m s, ToTransductionsM' m h, ToTransductionsM' m t)
               => s a b () -- ^

               -> h b c ()
               -> t b c ()
               -> TransductionM m a c
bisectM :: s a b () -> h b c () -> t b c () -> TransductionM m a c
bisectM s a b ()
s h b c ()
t1 t b c ()
t2 = s a b () -> MooreM m b c () -> TransductionM m a c
forall (m :: * -> *) (s :: * -> * -> * -> *)
       (t :: * -> * -> * -> *) a b c.
(Monad m, ToTransducerM m s, ToTransductionsM' m t) =>
s a b () -> t b c () -> TransductionM m a c
groupsM s a b ()
s (h b c () -> t b c () -> MooreM m b c ()
forall (m :: * -> *) (h :: * -> * -> * -> *)
       (t :: * -> * -> * -> *) a b u.
(Monad m, ToTransductionsM' m h, ToTransductionsM' m t) =>
h a b u -> t a b u -> MooreM m a b u
moveHeadM h b c ()
t1 t b c ()
t2)

{-| Monadic version of 'groups''.		

-}
groupsM' :: (Monad m, ToTransducerM m s, ToTransductionsM' m t, ToFoldM m f) 
         => s a b r 
         -> t b c u -- ^ 

         -> f     u v 
         -> TransductionM' m a c (r,v) 
groupsM' :: s a b r -> t b c u -> f u v -> TransductionM' m a c (r, v)
groupsM' (s a b r -> TransducerM m a b r
forall (m :: * -> *) (t :: * -> * -> * -> *) i o r.
ToTransducerM m t =>
t i o r -> TransducerM m i o r
toTransducerM -> TransducerM x -> a -> m (x, [b], [[b]])
sstep m x
sbegin x -> m (r, [b], [[b]])
sdone) 
         (t b c u -> MooreM m b c u
forall (m :: * -> *) (t :: * -> * -> * -> *) a b u.
ToTransductionsM' m t =>
t a b u -> MooreM m a b u
toTransductionsM' -> MooreM (ReifiedTransductionM' m b c u
rt0 :< u -> Cofree ((->) u) (ReifiedTransductionM' m b c u)
somemachine)) 
         (f u v -> FoldM m u v
forall (m :: * -> *) (t :: * -> * -> *) i r.
ToFoldM m t =>
t i r -> FoldM m i r
toFoldM -> FoldM x -> u -> m x
astep m x
abegin x -> m v
adone) 
         FoldM m c x
somefold 
         =
    (Quartet
   x
   (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
   x
   (StrictSum
      (ReifiedTransductionM' m b c u, FoldM m c x)
      (FoldM m b (u, FoldM m c x)))
 -> a
 -> m (Quartet
         x
         (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
         x
         (StrictSum
            (ReifiedTransductionM' m b c u, FoldM m c x)
            (FoldM m b (u, FoldM m c x)))))
-> m (Quartet
        x
        (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
        x
        (StrictSum
           (ReifiedTransductionM' m b c u, FoldM m c x)
           (FoldM m b (u, FoldM m c x))))
-> (Quartet
      x
      (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
      x
      (StrictSum
         (ReifiedTransductionM' m b c u, FoldM m c x)
         (FoldM m b (u, FoldM m c x)))
    -> m ((r, v), x))
-> FoldM m a ((r, v), x)
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM Quartet
  x
  (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
  x
  (StrictSum
     (ReifiedTransductionM' m b c u, FoldM m c x)
     (FoldM m b (u, FoldM m c x)))
-> a
-> m (Quartet
        x
        (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
        x
        (StrictSum
           (ReifiedTransductionM' m b c u, FoldM m c x)
           (FoldM m b (u, FoldM m c x))))
step 
          (do x
sbegin' <- m x
sbegin
              x
abegin' <- m x
abegin
              Quartet
  x
  (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
  x
  (StrictSum
     (ReifiedTransductionM' m b c u, FoldM m c x)
     (FoldM m b (u, FoldM m c x)))
-> m (Quartet
        x
        (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
        x
        (StrictSum
           (ReifiedTransductionM' m b c u, FoldM m c x)
           (FoldM m b (u, FoldM m c x))))
forall (m :: * -> *) a. Monad m => a -> m a
return (x
-> (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
-> x
-> StrictSum
     (ReifiedTransductionM' m b c u, FoldM m c x)
     (FoldM m b (u, FoldM m c x))
-> Quartet
     x
     (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
     x
     (StrictSum
        (ReifiedTransductionM' m b c u, FoldM m c x)
        (FoldM m b (u, FoldM m c x)))
forall a b c d. a -> b -> c -> d -> Quartet a b c d
Quartet x
sbegin' u -> Cofree ((->) u) (ReifiedTransductionM' m b c u)
somemachine x
abegin' ((ReifiedTransductionM' m b c u, FoldM m c x)
-> StrictSum
     (ReifiedTransductionM' m b c u, FoldM m c x)
     (FoldM m b (u, FoldM m c x))
forall a b. a -> StrictSum a b
Left' (ReifiedTransductionM' m b c u
rt0,FoldM m c x
somefold))))
          Quartet
  x
  (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
  x
  (StrictSum
     (ReifiedTransductionM' m b c u, FoldM m c x)
     (FoldM m b (u, FoldM m c x)))
-> m ((r, v), x)
done        
    where
        step :: Quartet
  x
  (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
  x
  (StrictSum
     (ReifiedTransductionM' m b c u, FoldM m c x)
     (FoldM m b (u, FoldM m c x)))
-> a
-> m (Quartet
        x
        (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
        x
        (StrictSum
           (ReifiedTransductionM' m b c u, FoldM m c x)
           (FoldM m b (u, FoldM m c x))))
step (Quartet x
sstate u -> Cofree ((->) u) (ReifiedTransductionM' m b c u)
machine x
astate StrictSum
  (ReifiedTransductionM' m b c u, FoldM m c x)
  (FoldM m b (u, FoldM m c x))
innerfold) a
i = do
            (x
sstate',[b]
oldSplit, [[b]]
newSplits) <- x -> a -> m (x, [b], [[b]])
sstep x
sstate a
i 
            case ([b]
oldSplit,[[b]]
newSplits) of 
                ([],[]) -> 
                    Quartet
  x
  (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
  x
  (StrictSum
     (ReifiedTransductionM' m b c u, FoldM m c x)
     (FoldM m b (u, FoldM m c x)))
-> m (Quartet
        x
        (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
        x
        (StrictSum
           (ReifiedTransductionM' m b c u, FoldM m c x)
           (FoldM m b (u, FoldM m c x))))
forall (m :: * -> *) a. Monad m => a -> m a
return (Quartet
   x
   (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
   x
   (StrictSum
      (ReifiedTransductionM' m b c u, FoldM m c x)
      (FoldM m b (u, FoldM m c x)))
 -> m (Quartet
         x
         (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
         x
         (StrictSum
            (ReifiedTransductionM' m b c u, FoldM m c x)
            (FoldM m b (u, FoldM m c x)))))
-> Quartet
     x
     (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
     x
     (StrictSum
        (ReifiedTransductionM' m b c u, FoldM m c x)
        (FoldM m b (u, FoldM m c x)))
-> m (Quartet
        x
        (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
        x
        (StrictSum
           (ReifiedTransductionM' m b c u, FoldM m c x)
           (FoldM m b (u, FoldM m c x))))
forall a b. (a -> b) -> a -> b
$! x
-> (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
-> x
-> StrictSum
     (ReifiedTransductionM' m b c u, FoldM m c x)
     (FoldM m b (u, FoldM m c x))
-> Quartet
     x
     (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
     x
     (StrictSum
        (ReifiedTransductionM' m b c u, FoldM m c x)
        (FoldM m b (u, FoldM m c x)))
forall a b c d. a -> b -> c -> d -> Quartet a b c d
Quartet x
sstate' u -> Cofree ((->) u) (ReifiedTransductionM' m b c u)
machine x
astate StrictSum
  (ReifiedTransductionM' m b c u, FoldM m c x)
  (FoldM m b (u, FoldM m c x))
innerfold -- pass innerfold untouched

                ([b], [[b]])
_       -> do
                    let actualinnerfold :: FoldM m b (u, FoldM m c x)
actualinnerfold = case StrictSum
  (ReifiedTransductionM' m b c u, FoldM m c x)
  (FoldM m b (u, FoldM m c x))
innerfold of
                            Left' (ReifiedTransductionM' TransductionM' m b c u
t0,FoldM m c x
pristine) -> FoldM m c (FoldM m c x) -> FoldM m b (u, FoldM m c x)
TransductionM' m b c u
t0 (FoldM m c x -> FoldM m c (FoldM m c x)
forall (w :: * -> *) a. Extend w => w a -> w (w a)
duplicated FoldM m c x
pristine)
                            Right' FoldM m b (u, FoldM m c x)
touched -> FoldM m b (u, FoldM m c x)
touched
                    FoldM m b (u, FoldM m c x)
innerfold' <- FoldM m b (u, FoldM m c x) -> [b] -> m (FoldM m b (u, FoldM m c x))
forall a a. FoldM m a a -> [a] -> m (FoldM m a a)
feed FoldM m b (u, FoldM m c x)
actualinnerfold [b]
oldSplit
                    (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u)
machine',x
astate',FoldM m b (u, FoldM m c x)
innerfold'') <- ((u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
  FoldM m b (u, FoldM m c x))
 -> [b]
 -> m (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
       FoldM m b (u, FoldM m c x)))
-> (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
    FoldM m b (u, FoldM m c x))
-> [[b]]
-> m (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
      FoldM m b (u, FoldM m c x))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
 FoldM m b (u, FoldM m c x))
-> [b]
-> m (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
      FoldM m b (u, FoldM m c x))
step' (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u)
machine,x
astate,FoldM m b (u, FoldM m c x)
innerfold') [[b]]
newSplits
                    Quartet
  x
  (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
  x
  (StrictSum
     (ReifiedTransductionM' m b c u, FoldM m c x)
     (FoldM m b (u, FoldM m c x)))
-> m (Quartet
        x
        (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
        x
        (StrictSum
           (ReifiedTransductionM' m b c u, FoldM m c x)
           (FoldM m b (u, FoldM m c x))))
forall (m :: * -> *) a. Monad m => a -> m a
return (Quartet
   x
   (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
   x
   (StrictSum
      (ReifiedTransductionM' m b c u, FoldM m c x)
      (FoldM m b (u, FoldM m c x)))
 -> m (Quartet
         x
         (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
         x
         (StrictSum
            (ReifiedTransductionM' m b c u, FoldM m c x)
            (FoldM m b (u, FoldM m c x)))))
-> Quartet
     x
     (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
     x
     (StrictSum
        (ReifiedTransductionM' m b c u, FoldM m c x)
        (FoldM m b (u, FoldM m c x)))
-> m (Quartet
        x
        (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
        x
        (StrictSum
           (ReifiedTransductionM' m b c u, FoldM m c x)
           (FoldM m b (u, FoldM m c x))))
forall a b. (a -> b) -> a -> b
$! x
-> (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
-> x
-> StrictSum
     (ReifiedTransductionM' m b c u, FoldM m c x)
     (FoldM m b (u, FoldM m c x))
-> Quartet
     x
     (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
     x
     (StrictSum
        (ReifiedTransductionM' m b c u, FoldM m c x)
        (FoldM m b (u, FoldM m c x)))
forall a b c d. a -> b -> c -> d -> Quartet a b c d
Quartet x
sstate' u -> Cofree ((->) u) (ReifiedTransductionM' m b c u)
machine' x
astate' (FoldM m b (u, FoldM m c x)
-> StrictSum
     (ReifiedTransductionM' m b c u, FoldM m c x)
     (FoldM m b (u, FoldM m c x))
forall a b. b -> StrictSum a b
Right' FoldM m b (u, FoldM m c x)
innerfold'')

        done :: Quartet
  x
  (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
  x
  (StrictSum
     (ReifiedTransductionM' m b c u, FoldM m c x)
     (FoldM m b (u, FoldM m c x)))
-> m ((r, v), x)
done (Quartet x
sstate u -> Cofree ((->) u) (ReifiedTransductionM' m b c u)
machine x
astate StrictSum
  (ReifiedTransductionM' m b c u, FoldM m c x)
  (FoldM m b (u, FoldM m c x))
innerfold) = do
            (r
s,[b]
oldSplit,[[b]]
newSplits) <- x -> m (r, [b], [[b]])
sdone x
sstate
            case ([b]
oldSplit,[[b]]
newSplits,StrictSum
  (ReifiedTransductionM' m b c u, FoldM m c x)
  (FoldM m b (u, FoldM m c x))
innerfold) of 
              ([],[],Left' (ReifiedTransductionM' m b c u
_,FoldM m c x
pristine)) -> do
                  v
a <- x -> m v
adone x
astate
                  x
p <- FoldM m c x -> [c] -> m x
forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, Monad m) =>
FoldM m a b -> f a -> m b
L.foldM FoldM m c x
pristine []
                  ((r, v), x) -> m ((r, v), x)
forall (m :: * -> *) a. Monad m => a -> m a
return ((r
s,v
a),x
p)
              ([b], [[b]],
 StrictSum
   (ReifiedTransductionM' m b c u, FoldM m c x)
   (FoldM m b (u, FoldM m c x)))
_ -> do
                  let actualinnerfold :: FoldM m b (u, FoldM m c x)
actualinnerfold = case StrictSum
  (ReifiedTransductionM' m b c u, FoldM m c x)
  (FoldM m b (u, FoldM m c x))
innerfold of
                          Left' (ReifiedTransductionM' TransductionM' m b c u
t0,FoldM m c x
pristine) -> FoldM m c (FoldM m c x) -> FoldM m b (u, FoldM m c x)
TransductionM' m b c u
t0 (FoldM m c x -> FoldM m c (FoldM m c x)
forall (w :: * -> *) a. Extend w => w a -> w (w a)
duplicated FoldM m c x
pristine)
                          Right' FoldM m b (u, FoldM m c x)
touched -> FoldM m b (u, FoldM m c x)
touched
                  FoldM m b (u, FoldM m c x)
innerfold' <- FoldM m b (u, FoldM m c x) -> [b] -> m (FoldM m b (u, FoldM m c x))
forall a a. FoldM m a a -> [a] -> m (FoldM m a a)
feed FoldM m b (u, FoldM m c x)
actualinnerfold [b]
oldSplit
                  (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u)
_,x
astate',FoldM m b (u, FoldM m c x)
innerfold'') <- ((u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
  FoldM m b (u, FoldM m c x))
 -> [b]
 -> m (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
       FoldM m b (u, FoldM m c x)))
-> (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
    FoldM m b (u, FoldM m c x))
-> [[b]]
-> m (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
      FoldM m b (u, FoldM m c x))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
 FoldM m b (u, FoldM m c x))
-> [b]
-> m (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
      FoldM m b (u, FoldM m c x))
step' (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u)
machine,x
astate,FoldM m b (u, FoldM m c x)
innerfold') [[b]]
newSplits
                  (u
u,FoldM m c x
finalfold) <- FoldM m b (u, FoldM m c x) -> [b] -> m (u, FoldM m c x)
forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, Monad m) =>
FoldM m a b -> f a -> m b
L.foldM FoldM m b (u, FoldM m c x)
innerfold'' []
                  v
v <- x -> m v
adone (x -> m v) -> m x -> m v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< x -> u -> m x
astep x
astate' u
u
                  x
r <- FoldM m c x -> [c] -> m x
forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, Monad m) =>
FoldM m a b -> f a -> m b
L.foldM FoldM m c x
finalfold []
                  ((r, v), x) -> m ((r, v), x)
forall (m :: * -> *) a. Monad m => a -> m a
return ((r
s,v
v),x
r)

        step' :: (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
 FoldM m b (u, FoldM m c x))
-> [b]
-> m (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
      FoldM m b (u, FoldM m c x))
step' (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u)
machine,x
astate,FoldM m b (u, FoldM m c x)
innerfold) [b]
is = do
            (u
u,FoldM m b (u, FoldM m c x)
innerfold',u -> Cofree ((->) u) (ReifiedTransductionM' m b c u)
machine') <- (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
-> FoldM m b (u, FoldM m c x)
-> m (u, FoldM m b (u, FoldM m c x),
      u -> Cofree ((->) u) (ReifiedTransductionM' m b c u))
forall (m :: * -> *) (m :: * -> *) a (f :: * -> *) a b r a a.
(Monad m, Monad m) =>
(a -> Cofree f (ReifiedTransductionM' m a b r))
-> FoldM m a (a, FoldM m b a)
-> m (a, FoldM m a (r, FoldM m b a),
      f (Cofree f (ReifiedTransductionM' m a b r)))
reset u -> Cofree ((->) u) (ReifiedTransductionM' m b c u)
machine FoldM m b (u, FoldM m c x)
innerfold 
            x
astate' <- x -> u -> m x
astep x
astate u
u
            FoldM m b (u, FoldM m c x)
innerfold'' <- FoldM m b (u, FoldM m c x) -> [b] -> m (FoldM m b (u, FoldM m c x))
forall a a. FoldM m a a -> [a] -> m (FoldM m a a)
feed FoldM m b (u, FoldM m c x)
innerfold' [b]
is
            (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
 FoldM m b (u, FoldM m c x))
-> m (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
      FoldM m b (u, FoldM m c x))
forall (m :: * -> *) a. Monad m => a -> m a
return ((u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
  FoldM m b (u, FoldM m c x))
 -> m (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
       FoldM m b (u, FoldM m c x)))
-> (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
    FoldM m b (u, FoldM m c x))
-> m (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u), x,
      FoldM m b (u, FoldM m c x))
forall a b. (a -> b) -> a -> b
$! (u -> Cofree ((->) u) (ReifiedTransductionM' m b c u)
machine',x
astate',FoldM m b (u, FoldM m c x)
innerfold'') 

        feed :: FoldM m a a -> [a] -> m (FoldM m a a)
feed = FoldM m a (FoldM m a a) -> [a] -> m (FoldM m a a)
forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, Monad m) =>
FoldM m a b -> f a -> m b
L.foldM (FoldM m a (FoldM m a a) -> [a] -> m (FoldM m a a))
-> (FoldM m a a -> FoldM m a (FoldM m a a))
-> FoldM m a a
-> [a]
-> m (FoldM m a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoldM m a a -> FoldM m a (FoldM m a a)
forall (w :: * -> *) a. Extend w => w a -> w (w a)
duplicated

        reset :: (a -> Cofree f (ReifiedTransductionM' m a b r))
-> FoldM m a (a, FoldM m b a)
-> m (a, FoldM m a (r, FoldM m b a),
      f (Cofree f (ReifiedTransductionM' m a b r)))
reset a -> Cofree f (ReifiedTransductionM' m a b r)
machine (FoldM x -> a -> m x
_ m x
fstate x -> m (a, FoldM m b a)
fdone) = do
           (u,nextfold) <- x -> m (a, FoldM m b a)
fdone (x -> m (a, FoldM m b a)) -> m x -> m (a, FoldM m b a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m x
fstate 
           let 
               ReifiedTransductionM' TransductionM' m a b r
t1 :< f (Cofree f (ReifiedTransductionM' m a b r))
nextmachine = a -> Cofree f (ReifiedTransductionM' m a b r)
machine a
u
           (a, FoldM m a (r, FoldM m b a),
 f (Cofree f (ReifiedTransductionM' m a b r)))
-> m (a, FoldM m a (r, FoldM m b a),
      f (Cofree f (ReifiedTransductionM' m a b r)))
forall (m :: * -> *) a. Monad m => a -> m a
return (a
u,FoldM m b (FoldM m b a) -> FoldM m a (r, FoldM m b a)
TransductionM' m a b r
t1 (FoldM m b a -> FoldM m b (FoldM m b a)
forall (w :: * -> *) a. Extend w => w a -> w (w a)
duplicated FoldM m b a
nextfold),f (Cofree f (ReifiedTransductionM' m a b r))
nextmachine)

{-| Summarizes each of the groups demarcated by the 'Transducer' using a
    'Fold'. 
    
    The result value of the 'Transducer' is discarded.

>>> L.fold (folds (chunksOf 3) L.sum L.list) [1..7]
[6,15,7]
-}
folds :: (ToTransducer t, ToFold f) 
      => t a b () -- ^ 'Transducer' working as a splitter.

      -> f b c 
      -> Transduction a c
folds :: t a b () -> f b c -> Transduction a c
folds t a b ()
splitter (f b c -> Fold b c
forall (t :: * -> * -> *) i r. ToFold t => t i r -> Fold i r
toFold -> Fold b c
f) = t a b () -> Transducer b c () -> Transduction a c
forall (s :: * -> * -> * -> *) (t :: * -> * -> * -> *) a b c.
(ToTransducer s, ToTransductions' t) =>
s a b () -> t b c () -> Transduction a c
groups t a b ()
splitter ((c -> ()) -> Transducer b c c -> Transducer b c ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> c -> ()
forall a b. a -> b -> a
const ()) (Fold b c -> Transducer b c c
forall a r. Fold a r -> Transducer a r r
condense Fold b c
f))

{-| Like 'folds', but preserves the return value of the 'Transducer'.

>>> L.fold (folds' (chunksOf 3) L.sum L.list) [1..7]
((),[6,15,7])
-}
folds' :: (ToTransducer t, ToFold f) 
       => t a b s -- ^ 'Transducer' working as a splitter.

       -> f b c 
       -> Transduction' a c s
folds' :: t a b s -> f b c -> Transduction' a c s
folds' t a b s
splitter (f b c -> Fold b c
forall (t :: * -> * -> *) i r. ToFold t => t i r -> Fold i r
toFold -> Fold b c
innerfold) Fold c x
somefold = 
    (((s, ()), x) -> (s, x)) -> Fold a ((s, ()), x) -> Fold a (s, x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((s, ()) -> s) -> (x -> x) -> ((s, ()), x) -> (s, x)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (s, ()) -> s
forall a b. (a, b) -> a
fst x -> x
forall a. a -> a
id) (t a b s
-> ReifiedTransduction' b c ()
-> Fold () ()
-> Fold c x
-> Fold a ((s, ()), x)
forall (s :: * -> * -> * -> *) (t :: * -> * -> * -> *)
       (f :: * -> * -> *) a b r c u v.
(ToTransducer s, ToTransductions' t, ToFold f) =>
s a b r -> t b c u -> f u v -> Transduction' a c (r, v)
groups' t a b s
splitter ReifiedTransduction' b c ()
innertrans Fold () ()
forall a. Fold a ()
unit Fold c x
somefold)
    where
    innertrans :: ReifiedTransduction' b c ()
innertrans = Transduction' b c () -> ReifiedTransduction' b c ()
forall a b r. Transduction' a b r -> ReifiedTransduction' a b r
reify' (Transduction' b c () -> ReifiedTransduction' b c ())
-> Transduction' b c () -> ReifiedTransduction' b c ()
forall a b. (a -> b) -> a -> b
$ \Fold c x
x -> ((c, x) -> ((), x)) -> Fold b (c, x) -> Fold b ((), x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) () (x -> ((), x)) -> ((c, x) -> x) -> (c, x) -> ((), x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c, x) -> x
forall a b. (a, b) -> b
snd) (Transducer b c c -> Fold c x -> Fold b (c, x)
forall (t :: * -> * -> * -> *) i o s.
ToTransducer t =>
t i o s -> Transduction' i o s
transduce' (Fold b c -> Transducer b c c
forall a r. Fold a r -> Transducer a r r
condense Fold b c
innerfold) Fold c x
x)

{-| Monadic version of 'folds'.		

-}
foldsM :: (Applicative m, Monad m, ToTransducerM m t, ToFoldM m f) 
       => t a b () -- ^

       -> f b c 
       -> TransductionM m a c
foldsM :: t a b () -> f b c -> TransductionM m a c
foldsM t a b ()
splitter (f b c -> FoldM m b c
forall (m :: * -> *) (t :: * -> * -> *) i r.
ToFoldM m t =>
t i r -> FoldM m i r
toFoldM -> FoldM m b c
f) = t a b () -> TransducerM m b c () -> TransductionM m a c
forall (m :: * -> *) (s :: * -> * -> * -> *)
       (t :: * -> * -> * -> *) a b c.
(Monad m, ToTransducerM m s, ToTransductionsM' m t) =>
s a b () -> t b c () -> TransductionM m a c
groupsM t a b ()
splitter ((c -> ()) -> TransducerM m b c c -> TransducerM m b c ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> c -> ()
forall a b. a -> b -> a
const ()) (FoldM m b c -> TransducerM m b c c
forall (m :: * -> *) a r.
Applicative m =>
FoldM m a r -> TransducerM m a r r
condenseM FoldM m b c
f))

{-| Monadic version of 'folds''.		

-}
foldsM' :: (Applicative m,Monad m, ToTransducerM m t, ToFoldM m f) 
        => t a b s -- ^

        -> f b c 
        -> TransductionM' m a c s
foldsM' :: t a b s -> f b c -> TransductionM' m a c s
foldsM' t a b s
splitter (f b c -> FoldM m b c
forall (m :: * -> *) (t :: * -> * -> *) i r.
ToFoldM m t =>
t i r -> FoldM m i r
toFoldM -> FoldM m b c
innerfold) FoldM m c x
somefold = 
    (((s, ()), x) -> (s, x))
-> FoldM m a ((s, ()), x) -> FoldM m a (s, x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((s, ()) -> s) -> (x -> x) -> ((s, ()), x) -> (s, x)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (s, ()) -> s
forall a b. (a, b) -> a
fst x -> x
forall a. a -> a
id) (t a b s
-> ReifiedTransductionM' m b c ()
-> Fold () ()
-> FoldM m c x
-> FoldM m a ((s, ()), x)
forall (m :: * -> *) (s :: * -> * -> * -> *)
       (t :: * -> * -> * -> *) (f :: * -> * -> *) a b r c u v.
(Monad m, ToTransducerM m s, ToTransductionsM' m t, ToFoldM m f) =>
s a b r -> t b c u -> f u v -> TransductionM' m a c (r, v)
groupsM' t a b s
splitter ReifiedTransductionM' m b c ()
innertrans Fold () ()
forall a. Fold a ()
unit FoldM m c x
somefold)
    where
    innertrans :: ReifiedTransductionM' m b c ()
innertrans = TransductionM' m b c () -> ReifiedTransductionM' m b c ()
forall (m :: * -> *) a b r.
TransductionM' m a b r -> ReifiedTransductionM' m a b r
reifyM' (TransductionM' m b c () -> ReifiedTransductionM' m b c ())
-> TransductionM' m b c () -> ReifiedTransductionM' m b c ()
forall a b. (a -> b) -> a -> b
$ \FoldM m c x
x -> ((c, x) -> ((), x)) -> FoldM m b (c, x) -> FoldM m b ((), x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) () (x -> ((), x)) -> ((c, x) -> x) -> (c, x) -> ((), x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c, x) -> x
forall a b. (a, b) -> b
snd) (TransducerM m b c c -> FoldM m c x -> FoldM m b (c, x)
forall (m :: * -> *) (t :: * -> * -> * -> *) i o s.
(Monad m, ToTransducerM m t) =>
t i o s -> TransductionM' m i o s
transduceM' (FoldM m b c -> TransducerM m b c c
forall (m :: * -> *) a r.
Applicative m =>
FoldM m a r -> TransducerM m a r r
condenseM FoldM m b c
innerfold) FoldM m c x
x)

------------------------------------------------------------------------------


{-| Splits a stream into chunks of fixed size.		

>>> L.fold (folds (chunksOf 2) L.list L.list) [1..7]
[[1,2],[3,4],[5,6],[7]]

>>> L.fold (groups (chunksOf 2) (surround [] [0]) L.list) [1..7]
[1,2,0,3,4,0,5,6,0,7,0]
-}
chunksOf :: Int -> Transducer a a ()
chunksOf :: Int -> Transducer a a ()
chunksOf Int
0 = (() -> a -> ((), [a], [[a]]))
-> () -> (() -> ((), [a], [[a]])) -> Transducer a a ()
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
Transducer (\()
_ a
_ -> ((),[],[a] -> [[a]]
forall a. a -> [a]
repeat [])) () ([Char] -> () -> ((), [a], [[a]])
forall a. HasCallStack => [Char] -> a
error [Char]
"never happens")
chunksOf Int
groupSize = (Int -> a -> (Int, [a], [[a]]))
-> Int -> (Int -> ((), [a], [[a]])) -> Transducer a a ()
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
Transducer Int -> a -> (Int, [a], [[a]])
step Int
groupSize Int -> ((), [a], [[a]])
forall b a a. b -> ((), [a], [a])
done 
    where
        step :: Int -> a -> (Int, [a], [[a]])
step Int
0 a
a = (Int -> Int
forall a. Enum a => a -> a
pred Int
groupSize, [], [[a
a]])
        step Int
i a
a = (Int -> Int
forall a. Enum a => a -> a
pred Int
i, [a
a], [])
        done :: p -> ((), [a], [a])
done p
_ = ((),[],[])

{-| Splits the stream at a given position.		

>>> L.fold (bisect (splitAt 2) ignore (reify id) L.list) [1..5]
[3,4,5]

-}
splitAt :: Int -> Transducer a a ()
splitAt :: Int -> Transducer a a ()
splitAt Int
howmany = 
    (Maybe Int -> a -> (Maybe Int, [a], [[a]]))
-> Maybe Int
-> (Maybe Int -> ((), [a], [[a]]))
-> Transducer a a ()
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
Transducer Maybe Int -> a -> (Maybe Int, [a], [[a]])
forall a a.
(Eq a, Num a, Enum a) =>
Maybe a -> a -> (Maybe a, [a], [[a]])
step (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
howmany) Maybe Int -> ((), [a], [[a]])
done 
    where
        step :: Maybe a -> a -> (Maybe a, [a], [[a]])
step Maybe a
Nothing a
i =
            (Maybe a
forall a. Maybe a
Nothing,[a
i],[])
        step (Just a
howmanypending) a
i 
            | a
howmanypending a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = 
                (Maybe a
forall a. Maybe a
Nothing,[],[[a
i]])
            | Bool
otherwise = 
                (a -> Maybe a
forall a. a -> Maybe a
Just (a -> a
forall a. Enum a => a -> a
pred a
howmanypending),[a
i],[]) 
        done :: Maybe Int -> ((), [a], [[a]])
done = Maybe Int -> ((), [a], [[a]])
forall a. Monoid a => a
mempty

{-| Similar to `splitAt`, but works with streams of "chunked" data like
    bytestrings, texts, vectors, lists of lists...		

>>> L.fold (bisect (chunkedSplitAt 7) ignore (reify id) L.list) [[1..5],[6..9]]
[[8,9]]

-}
chunkedSplitAt :: SFM.StableFactorialMonoid m => Int -> Transducer m m ()
chunkedSplitAt :: Int -> Transducer m m ()
chunkedSplitAt Int
howmany = 
    (Maybe Int -> m -> (Maybe Int, [m], [[m]]))
-> Maybe Int
-> (Maybe Int -> ((), [m], [[m]]))
-> Transducer m m ()
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
Transducer Maybe Int -> m -> (Maybe Int, [m], [[m]])
forall b.
FactorialMonoid b =>
Maybe Int -> b -> (Maybe Int, [b], [[b]])
step (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
howmany) Maybe Int -> ((), [m], [[m]])
done
    where
        step :: Maybe Int -> b -> (Maybe Int, [b], [[b]])
step Maybe Int
Nothing b
m =
            (Maybe Int
forall a. Maybe a
Nothing,[b
m],[])
        step (Just Int
howmanypending) b
m
            | b -> Bool
forall m. MonoidNull m => m -> Bool
NM.null b
m = 
                (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
howmanypending,[],[])
            | Int
howmanypending Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = 
                (Maybe Int
forall a. Maybe a
Nothing,[],[[b
m]])
            | Int
howmanypending Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= b -> Int
forall m. Factorial m => m -> Int
SFM.length b
m =
                (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
howmanypending Int -> Int -> Int
forall a. Num a => a -> a -> a
- b -> Int
forall m. Factorial m => m -> Int
SFM.length b
m),[b
m],[])
            | Bool
otherwise =
                let (b
prefix,b
suffix) = Int -> b -> (b, b)
forall m. FactorialMonoid m => Int -> m -> (m, m)
SFM.splitAt Int
howmanypending b
m
                in
                (Maybe Int
forall a. Maybe a
Nothing,[b
prefix],[[b
suffix]])
        done :: Maybe Int -> ((), [m], [[m]])
done = Maybe Int -> ((), [m], [[m]])
forall a. Monoid a => a
mempty

data SplitState = 
      PreviousSeparator
    | PreviousNonSeparator

{-| 		

>>> L.fold (folds (split (==2)) L.list L.list) [1,2,2,1,1,2,1]
[[1],[],[1,1],[1]]

>>> L.fold (folds (split (==2)) L.list L.list) [2,1,1,2]
[[],[1,1],[]]

-}
split :: (a -> Bool) -> Transducer a a ()
split :: (a -> Bool) -> Transducer a a ()
split a -> Bool
predicate = 
    (SplitState -> a -> (SplitState, [a], [[a]]))
-> SplitState
-> (SplitState -> ((), [a], [[a]]))
-> Transducer a a ()
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
Transducer SplitState -> a -> (SplitState, [a], [[a]])
step SplitState
PreviousNonSeparator SplitState -> ((), [a], [[a]])
forall a a. SplitState -> ((), [a], [[a]])
done 
    where
        step :: SplitState -> a -> (SplitState, [a], [[a]])
step SplitState
PreviousNonSeparator a
i = 
            if a -> Bool
predicate a
i 
               then (SplitState
PreviousSeparator,[],[])
               else (SplitState
PreviousNonSeparator,[a
i],[])
        step SplitState
PreviousSeparator a
i = 
            if a -> Bool
predicate a
i 
               then (SplitState
PreviousSeparator,[],[[]])
               else (SplitState
PreviousNonSeparator,[],[[a
i]])
        done :: SplitState -> ((), [a], [[a]])
done SplitState
PreviousNonSeparator = ((), [a], [[a]])
forall a. Monoid a => a
mempty
        done SplitState
PreviousSeparator = ((),[],[[]])


data BreakWhenState = 
      BreakConditionEncountered 
    | BreakConditionPending

{-| 		

>>> L.fold (bisect (break (>3)) (reify id) ignore L.list) [1..5]
[1,2,3]

-}
break :: (a -> Bool) -> Transducer a a ()
break :: (a -> Bool) -> Transducer a a ()
break a -> Bool
predicate = 
    (BreakWhenState -> a -> (BreakWhenState, [a], [[a]]))
-> BreakWhenState
-> (BreakWhenState -> ((), [a], [[a]]))
-> Transducer a a ()
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
Transducer BreakWhenState -> a -> (BreakWhenState, [a], [[a]])
step BreakWhenState
BreakConditionPending BreakWhenState -> ((), [a], [[a]])
done 
    where
        step :: BreakWhenState -> a -> (BreakWhenState, [a], [[a]])
step BreakWhenState
BreakConditionPending a
i = 
            if a -> Bool
predicate a
i 
               then (BreakWhenState
BreakConditionEncountered,[],[[a
i]])
               else (BreakWhenState
BreakConditionPending,[a
i],[])
        step BreakWhenState
BreakConditionEncountered a
i = 
               (BreakWhenState
BreakConditionEncountered,[a
i],[])
        done :: BreakWhenState -> ((), [a], [[a]])
done = BreakWhenState -> ((), [a], [[a]])
forall a. Monoid a => a
mempty

{-| Puts the last element of the input stream (if it exists) in a separate
    group.

>>> L.fold (bisect (void splitLast) (reify id) ignore L.list) [1..5]
[1,2,3,4]
-}
splitLast :: Transducer a a (Maybe a)
splitLast :: Transducer a a (Maybe a)
splitLast =
    (Maybe a -> a -> (Maybe a, [a], [[a]]))
-> Maybe a
-> (Maybe a -> (Maybe a, [a], [[a]]))
-> Transducer a a (Maybe a)
forall i o r x.
(x -> i -> (x, [o], [[o]]))
-> x -> (x -> (r, [o], [[o]])) -> Transducer i o r
Transducer Maybe a -> a -> (Maybe a, [a], [[a]])
forall a a a. Maybe a -> a -> (Maybe a, [a], [a])
step Maybe a
forall a. Maybe a
Nothing Maybe a -> (Maybe a, [a], [[a]])
forall a a. Maybe a -> (Maybe a, [a], [[a]])
done
    where
        step :: Maybe a -> a -> (Maybe a, [a], [a])
step Maybe a
Nothing a
i = 
            (a -> Maybe a
forall a. a -> Maybe a
Just a
i,[],[])
        step (Just a
oldi) a
i = 
            (a -> Maybe a
forall a. a -> Maybe a
Just a
i,[a
oldi],[])
        done :: Maybe a -> (Maybe a, [a], [[a]])
done Maybe a
Nothing = 
            (Maybe a
forall a. Maybe a
Nothing,[],[])
        done (Just a
lasti) = (a -> Maybe a
forall a. a -> Maybe a
Just a
lasti, [], [[a
lasti]])

{-| Strip a prefix from a stream of "chunked" data, like packed text.		

    If the prefix doesn't match, fail with the unmatched part of the prefix and
    the input that caused the error.

>>> runExceptT $ L.foldM (transduceM (chunkedStripPrefix [[1..2],[3..4]]) (L.generalize L.list)) [[1..5],[6..9]]
Right [[5],[6,7,8,9]]

>>> runExceptT $ L.foldM (transduceM (chunkedStripPrefix [[1..2],[3,77,99]]) (L.generalize L.list)) [[1..5],[6..9]]
Left ([[77,99]],Just [4,5])
-}
chunkedStripPrefix :: (CM.LeftGCDMonoid i,SFM.StableFactorialMonoid i,Traversable t,Monad m) 
                   => t i -- ^

                   -> TransducerM (ExceptT ([i],Maybe i) m) i i ()
chunkedStripPrefix :: t i -> TransducerM (ExceptT ([i], Maybe i) m) i i ()
chunkedStripPrefix ((i -> Bool) -> [i] -> [i]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (i -> Bool) -> i -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Bool
forall m. MonoidNull m => m -> Bool
NM.null) ([i] -> [i]) -> (t i -> [i]) -> t i -> [i]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t i -> [i]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList -> [i]
chunks) = 
    ([i] -> i -> ExceptT ([i], Maybe i) m ([i], [i], [[i]]))
-> ExceptT ([i], Maybe i) m [i]
-> ([i] -> ExceptT ([i], Maybe i) m ((), [i], [[i]]))
-> TransducerM (ExceptT ([i], Maybe i) m) i i ()
forall (m :: * -> *) i o r x.
(x -> i -> m (x, [o], [[o]]))
-> m x -> (x -> m (r, [o], [[o]])) -> TransducerM m i o r
TransducerM [i] -> i -> ExceptT ([i], Maybe i) m ([i], [i], [[i]])
forall (m :: * -> *) a a a.
(Monad m, LeftGCDMonoid a, MonoidNull a) =>
[a] -> a -> ExceptT ([a], Maybe a) m ([a], [a], [a])
step ([i] -> ExceptT ([i], Maybe i) m [i]
forall (m :: * -> *) a. Monad m => a -> m a
return [i]
chunks) [i] -> ExceptT ([i], Maybe i) m ((), [i], [[i]])
forall (m :: * -> *) a a a.
(Monad m, Monoid a) =>
[a] -> ExceptT ([a], Maybe a) m a
done
    where
        step :: [a] -> a -> ExceptT ([a], Maybe a) m ([a], [a], [a])
step []     a
i = 
            ([a], [a], [a]) -> ExceptT ([a], Maybe a) m ([a], [a], [a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([],[a
i],[])
        step (a
x:[a]
xs) a
i = 
            let (a
prefix',a
i',a
x') = a -> a -> (a, a, a)
forall m. LeftGCDMonoid m => m -> m -> (m, m, m)
CM.stripCommonPrefix a
i a
x 
            in 
            if a -> Bool
forall m. MonoidNull m => m -> Bool
NM.null a
prefix'
                then ([a], Maybe a) -> ExceptT ([a], Maybe a) m ([a], [a], [a])
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs,a -> Maybe a
forall a. a -> Maybe a
Just a
i)
                else 
                    if a -> Bool
forall m. MonoidNull m => m -> Bool
NM.null a
x' 
                       then [a] -> a -> ExceptT ([a], Maybe a) m ([a], [a], [a])
step [a]
xs a
i'
                       else [a] -> a -> ExceptT ([a], Maybe a) m ([a], [a], [a])
step (a
x'a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) a
i'
        done :: [a] -> ExceptT ([a], Maybe a) m a
done [] = 
            a -> ExceptT ([a], Maybe a) m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
        done (a
x:[a]
xs) = 
            ([a], Maybe a) -> ExceptT ([a], Maybe a) m a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs, Maybe a
forall a. Maybe a
Nothing) 

------------------------------------------------------------------------------


{- $reexports

-}