{-# LANGUAGE ExistentialQuantification, RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE CPP #-}
module Control.Foldl.Transduce (
Transduction
, Transduction'
, Transducer(..)
, ToTransducer(..)
, TransductionM
, TransductionM'
, TransducerM(..)
, ToTransducerM(..)
, transduce
, transduce'
, transduceM
, transduceM'
, transduceK
, folds
, folds'
, foldsM
, foldsM'
, ReifiedTransduction' (..)
, reify
, reify'
, Moore(..)
, ToTransductions' (..)
, moveHead
, groups
, bisect
, groups'
, ReifiedTransductionM' (..)
, reifyM
, reifyM'
, MooreM(..)
, ToTransductionsM' (..)
, moveHeadM
, groupsM
, bisectM
, groupsM'
, ignore
, surround
, surroundIO
, chunksOf
, split
, splitAt
, chunkedSplitAt
, splitLast
, break
, chunkedStripPrefix
, foldify
, foldifyM
, condense
, condenseM
, hoistTransducer
, hoistFold
, unit
, trip
, quiesce
, Fallible(..)
, ToFold(..)
, ToFoldM(..)
, 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
#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
type Transduction a b = forall x. Fold b x -> Fold a x
type Transduction' a b r = forall x. Fold b x -> Fold a (r,x)
newtype ReifiedTransduction' a b r = ReifiedTransduction' { ReifiedTransduction' a b r -> forall x. Fold b x -> Fold a (r, x)
getTransduction' :: Transduction' a b r }
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'
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
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
type TransductionM m a b = forall x. Monad m => FoldM m b x -> FoldM m a x
type TransductionM' m a b r = forall x. FoldM m b x -> FoldM m a (r,x)
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 }
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)
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'
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 #-}
class ToTransducerM m t where
toTransducerM :: t i o r -> TransducerM m i o r
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
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)
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)))
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)
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
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 :: 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
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])
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 :: 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 :: 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)
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))
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))
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')
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')
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)
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
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')
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')
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)
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)
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)
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
unit :: Fold a ()
unit :: Fold a ()
unit = () -> Fold a ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
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)
newtype Moore a b u = Moore { Moore a b u -> Cofree ((->) u) (ReifiedTransduction' a b u)
getMoore :: Cofree ((->) u) (ReifiedTransduction' a b u) }
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) }
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)
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)
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
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
groups :: (ToTransducer s, ToTransductions' t)
=> s a b ()
-> t b c ()
-> 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)
bisect :: (ToTransducer s, ToTransductions' h, ToTransductions' t)
=> s a b ()
-> h b c ()
-> t b c ()
-> 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
groups' :: (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 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
([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)
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)
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)
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
([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)
folds :: (ToTransducer t, ToFold f)
=> t a b ()
-> 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))
folds' :: (ToTransducer t, ToFold f)
=> t a b s
-> 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)
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))
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)
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
_ = ((),[],[])
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
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
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
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
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]])
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)