diff --git a/CHANGELOG b/CHANGELOG
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,98 +1,98 @@
-# 0.6.0.0
-
-- Update to match change in foldl library.
-
-# 0.5.1.0
-
-- Removed upper bounds in dependencies.
-
-# 0.5.0.0
-
-- Before, splitters always found at least one group, even for empty streams.
-  Now, no groups are found for empty streams.
-- Made some type signatures a bit more strict.
-- Eliminated previously deprecated functions and modules.
-
-# 0.4.7.0
-
-- Added "sections" splitter.
-- Deprecated Control.Foldl.Transduce.Textual
-
-# 0.4.6.0
-
-- Deprecated Control.Foldl.Transduce.ByteString.IO 
-- Added Control.Foldl.Transduce.ByteString
-- Added "paragraphs" splitter.
-
-# 0.4.5.0
-
-- added split
-
-# 0.4.4.0
-
-- deprecated quiesceWith
-- added Fallible.
-
-# 0.4.3.0
-
-- deprecated splitWhen in favor of break
-- deprecated textualSplitWhen in favor of textualBreak
-
-# 0.4.2.0
-
-- Added "trip" fold.
-- Added Control.Foldl.Transduce.Textual.
-
-# 0.4.1.0
-
-- Added module Control.Foldl.Transduce.ByteString.IO, to
-  avoid having to depend on other packages for simple I/O tasks.
-- Added "unit" fold.
-
-# 0.4.0.0
-
-- Changed order of parameters for groups' and groupsM'. Hopefully the new one
-  is clearer.
-- It was annoying to use "evenly (transduce ...)" every time. Added new
-  ToTransductions' typeclass for types that can be converted to an infinite
-  list of transductions.
-- Added ToFold typeclass as well.
-
-# 0.3.0.0
-
-- Transducers can now delimit segments in the done function, too.
-  This was required for transducers like surround to work as splitters.
-- Strengthened the constraints on the surround function to Traversable.
-- Added dependency on free and monoid-subclasses.
-- group functions can now treat each group differently.
-- Added ignore, splitAt, splitWhen, splitLast
-- removed drop, take... use splitAt, splitWhen + bisect.
-- Added bisect, evenly convenience functions.
-
-# 0.2.1.0
-
-- Comonad and Extend instances for Transducer 
-- Added words splitter
-- Added take, drop, takeWhile, dropWhile transducers
-
-# 0.2.0.0
-
-- Removed the Spliiter type. Now it's transducers for everything!
-- generalizeTransducer -> _generalize
-- simplifyTransducer -> _simplify
-- removed chokepoint and chokepointM
-
-
-# 0.1.2.0
-
-- Added explicit bifunctors dependency.
-- Added Transduce', TransduceM' type synonyms.
-- Added groups', groupsM'.
-
-
-# 0.1.1.0
-
-- Changed signatures of transduce' and transduceM'.
-- generalize' -> generalizeTransducer
-- simplify' -> simplifyTransducer
-- dropped direct profunctors dependency.
+# 0.6.0.0
+
+- Update to match change in foldl library.
+
+# 0.5.1.0
+
+- Removed upper bounds in dependencies.
+
+# 0.5.0.0
+
+- Before, splitters always found at least one group, even for empty streams.
+  Now, no groups are found for empty streams.
+- Made some type signatures a bit more strict.
+- Eliminated previously deprecated functions and modules.
+
+# 0.4.7.0
+
+- Added "sections" splitter.
+- Deprecated Control.Foldl.Transduce.Textual
+
+# 0.4.6.0
+
+- Deprecated Control.Foldl.Transduce.ByteString.IO 
+- Added Control.Foldl.Transduce.ByteString
+- Added "paragraphs" splitter.
+
+# 0.4.5.0
+
+- added split
+
+# 0.4.4.0
+
+- deprecated quiesceWith
+- added Fallible.
+
+# 0.4.3.0
+
+- deprecated splitWhen in favor of break
+- deprecated textualSplitWhen in favor of textualBreak
+
+# 0.4.2.0
+
+- Added "trip" fold.
+- Added Control.Foldl.Transduce.Textual.
+
+# 0.4.1.0
+
+- Added module Control.Foldl.Transduce.ByteString.IO, to
+  avoid having to depend on other packages for simple I/O tasks.
+- Added "unit" fold.
+
+# 0.4.0.0
+
+- Changed order of parameters for groups' and groupsM'. Hopefully the new one
+  is clearer.
+- It was annoying to use "evenly (transduce ...)" every time. Added new
+  ToTransductions' typeclass for types that can be converted to an infinite
+  list of transductions.
+- Added ToFold typeclass as well.
+
+# 0.3.0.0
+
+- Transducers can now delimit segments in the done function, too.
+  This was required for transducers like surround to work as splitters.
+- Strengthened the constraints on the surround function to Traversable.
+- Added dependency on free and monoid-subclasses.
+- group functions can now treat each group differently.
+- Added ignore, splitAt, splitWhen, splitLast
+- removed drop, take... use splitAt, splitWhen + bisect.
+- Added bisect, evenly convenience functions.
+
+# 0.2.1.0
+
+- Comonad and Extend instances for Transducer 
+- Added words splitter
+- Added take, drop, takeWhile, dropWhile transducers
+
+# 0.2.0.0
+
+- Removed the Spliiter type. Now it's transducers for everything!
+- generalizeTransducer -> _generalize
+- simplifyTransducer -> _simplify
+- removed chokepoint and chokepointM
+
+
+# 0.1.2.0
+
+- Added explicit bifunctors dependency.
+- Added Transduce', TransduceM' type synonyms.
+- Added groups', groupsM'.
+
+
+# 0.1.1.0
+
+- Changed signatures of transduce' and transduceM'.
+- generalize' -> generalizeTransducer
+- simplify' -> simplifyTransducer
+- dropped direct profunctors dependency.
diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,28 +1,28 @@
-Copyright (c) 2015, Daniel Díaz Carrete
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-* Redistributions of source code must retain the above copyright notice, this
-  list of conditions and the following disclaimer.
-
-* Redistributions in binary form must reproduce the above copyright notice,
-  this list of conditions and the following disclaimer in the documentation
-  and/or other materials provided with the distribution.
-
-* Neither the name of foldl-transduce nor the names of its
-  contributors may be used to endorse or promote products derived from
-  this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
+Copyright (c) 2015, Daniel Díaz Carrete
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright notice,
+  this list of conditions and the following disclaimer in the documentation
+  and/or other materials provided with the distribution.
+
+* Neither the name of foldl-transduce nor the names of its
+  contributors may be used to endorse or promote products derived from
+  this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,38 +1,38 @@
-## What's in this library?
-
-Stateful transducers and streaming-preserving group operations for the folds in
-Gabriel Gonzalez's [foldl](http://hackage.haskell.org/package/foldl) package.
-
-## When to use this library?
-
-- When you want to wrap a stateful decoder over a **Fold**. An example is
-decoding UTF-8: the decoder must be stateful because a multi-byte character may
-have been split across two blocks of bytes.
-
-- When you want to tweak the stream of data that arrives into a **Fold**, but
-only at certain positions. Stripping whitespace at the beginning of a text
-stream, for example.
-
-- When you want to perform group operations without breaking "streaminess",
-similar to what [pipes-group](http://hackage.haskell.org/package/pipes-group)
-does.
-
-## Why use this library for grouping instead of **pipes-group**?
-
-Grouping fold-side instead of producer-side has the advantage that, since the
-results are still **Fold**s, you can combine them using **Applicative**.
-
-Also, **Fold**s can work with sources other than **Producer**s from pipes.
-
-Grouping fold-side has limitations as well:
-
-- You can't perform bracketing operations like "withFile" that span the folding
-  of an entire group. pipes-group allows them.
-
-- You have more flexibility in pipes-group to decide how to delimit and fold
-  the next group based on previous results.
-
-
-## Where can I find working examples for this library?
-
-In the [examples](https://github.com/danidiaz/foldl-transduce/tree/master/examples) folder of the repo.
+## What's in this library?
+
+Stateful transducers and streaming-preserving group operations for the folds in
+Gabriel Gonzalez's [foldl](http://hackage.haskell.org/package/foldl) package.
+
+## When to use this library?
+
+- When you want to wrap a stateful decoder over a **Fold**. An example is
+decoding UTF-8: the decoder must be stateful because a multi-byte character may
+have been split across two blocks of bytes.
+
+- When you want to tweak the stream of data that arrives into a **Fold**, but
+only at certain positions. Stripping whitespace at the beginning of a text
+stream, for example.
+
+- When you want to perform group operations without breaking "streaminess",
+similar to what [pipes-group](http://hackage.haskell.org/package/pipes-group)
+does.
+
+## Why use this library for grouping instead of **pipes-group**?
+
+Grouping fold-side instead of producer-side has the advantage that, since the
+results are still **Fold**s, you can combine them using **Applicative**.
+
+Also, **Fold**s can work with sources other than **Producer**s from pipes.
+
+Grouping fold-side has limitations as well:
+
+- You can't perform bracketing operations like "withFile" that span the folding
+  of an entire group. pipes-group allows them.
+
+- You have more flexibility in pipes-group to decide how to delimit and fold
+  the next group based on previous results.
+
+
+## Where can I find working examples for this library?
+
+In the [examples](https://github.com/danidiaz/foldl-transduce/tree/master/examples) folder of the repo.
diff --git a/Setup.hs b/Setup.hs
deleted file mode 100644
--- a/Setup.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-import Distribution.Simple
-main = defaultMain
diff --git a/benchmarks/benchmarks.hs b/benchmarks/benchmarks.hs
--- a/benchmarks/benchmarks.hs
+++ b/benchmarks/benchmarks.hs
@@ -1,21 +1,21 @@
-module Main where
-
-import Data.Foldable
-import qualified Control.Foldl as L
-import Control.Foldl.Transduce
-import Lens.Family
-
-import Criterion.Main
-
-main :: IO ()
-main = defaultMain [
-        bgroup "sum" [
-             bench "without trans" (nf 
-                (L.fold L.sum)
-                (take 500000 (cycle [1::Int,-1])))
-        ,
-             bench "with trans"  (nf 
-                (L.fold (folds (chunksOf 1) L.list (L.handles (folding toList) L.sum)))
-                (take 500000 (cycle [1::Int,-1])))
-        ]        
-    ]
+module Main where
+
+import Data.Foldable
+import qualified Control.Foldl as L
+import Control.Foldl.Transduce
+import Lens.Family
+
+import Criterion.Main
+
+main :: IO ()
+main = defaultMain [
+        bgroup "sum" [
+             bench "without trans" (nf 
+                (L.fold L.sum)
+                (take 500000 (cycle [1::Int,-1])))
+        ,
+             bench "with trans"  (nf 
+                (L.fold (folds (chunksOf 1) L.list (L.handles (folding toList) L.sum)))
+                (take 500000 (cycle [1::Int,-1])))
+        ]        
+    ]
diff --git a/foldl-transduce.cabal b/foldl-transduce.cabal
--- a/foldl-transduce.cabal
+++ b/foldl-transduce.cabal
@@ -1,85 +1,89 @@
-Name: foldl-transduce
-Version: 0.6.0.0
-Cabal-Version: >=1.8.0.2
-Build-Type: Simple
-License: BSD3
-License-File: LICENSE
-Copyright: 2015 Daniel Diaz
-Author: Daniel Diaz
-Maintainer: diaz_carrete@yahoo.com
-Bug-Reports: https://github.com/danidiaz/foldl-transduce/issues
-Synopsis: Transducers for foldl folds.
-Description: Stateful transducers and streaming-preserving grouping operations for foldl folds.
-Category: Control
-
-Extra-Source-Files:
-    README.md
-    CHANGELOG
-
-Source-Repository head
-    Type: git
-    Location: git@github.com:danidiaz/foldl-transduce.git
-
-Library
-    HS-Source-Dirs: src
-    Build-Depends:
-        base          >= 4        && < 5   ,
-        bytestring    >= 0.9.2.1           ,
-        text          >= 0.11.2.0          ,
-        transformers  >= 0.2.0.0           ,
-        containers                         ,
-        bifunctors    >= 5                 ,
-        profunctors   >= 5                 ,
-        semigroups    >= 0.18              ,
-        semigroupoids >= 5.0               ,
-        foldl         >= 1.4               ,
-        comonad       >= 4                 ,
-        free          >= 4                 ,         
-        void          >= 0.6               ,
-        split         >= 0.2.2             ,
-        monoid-subclasses == 0.4.*         
-    Exposed-Modules:
-        Control.Foldl.Transduce,
-        Control.Foldl.Transduce.ByteString,
-        Control.Foldl.Transduce.Text
-    GHC-Options: -O2 -Wall
-
-test-suite doctests
-  type:           exitcode-stdio-1.0
-  ghc-options:    -Wall -threaded
-  hs-source-dirs: tests
-  main-is:        doctests.hs
-
-  build-depends:
-        base          >= 4.4 && < 5
-      , free          >= 4
-      , doctest       >= 0.10.1
-
-test-suite tests
-  type:           exitcode-stdio-1.0
-  ghc-options:    -Wall -threaded
-  hs-source-dirs: tests
-  main-is:        tests.hs
-  build-depends:
-        base >= 4.4 && < 5  ,
-        text                ,
-        tasty >= 0.10.1.1   ,
-        tasty-hunit >= 0.9.2,
-        tasty-quickcheck >= 0.8.3.2, 
-        monoid-subclasses >= 0.4,
-        split         >= 0.2.2,
-        foldl               ,
-        foldl-transduce
-
-benchmark benchmarks
-    Type:             exitcode-stdio-1.0
-    HS-Source-Dirs:   benchmarks
-    Main-Is:          benchmarks.hs
-    GHC-Options: -O2 -Wall -rtsopts 
-
-    Build-Depends:
-        base         >= 4.4     && < 5  ,
-        criterion    >= 1.1.0.0 && < 1.2,
-        lens-family-core >= 1.2.0       ,
-        foldl                           ,
-        foldl-transduce
+Cabal-Version: 3.0
+Name: foldl-transduce
+Version: 0.6.0.1
+Build-Type: Simple
+License: BSD-3-Clause
+License-File: LICENSE
+Copyright: 2015 Daniel Diaz
+Author: Daniel Diaz
+Maintainer: diaz_carrete@yahoo.com
+Bug-Reports: https://github.com/danidiaz/foldl-transduce/issues
+Synopsis: Transducers for foldl folds.
+Description: Stateful transducers and streaming-preserving grouping operations for foldl folds.
+Category: Control
+
+Extra-Source-Files:
+    README.md
+    CHANGELOG
+
+Source-Repository head
+    Type: git
+    Location: git@github.com:danidiaz/foldl-transduce.git
+
+Library
+    HS-Source-Dirs: src
+    Build-Depends:
+        base          >= 4        && < 5   ,
+        bytestring    >= 0.9.2.1           ,
+        text          >= 0.11.2.0          ,
+        transformers  >= 0.2.0.0           ,
+        containers                         ,
+        bifunctors    >= 5                 ,
+        profunctors   >= 5                 ,
+        semigroups    >= 0.18              ,
+        semigroupoids >= 5.0               ,
+        foldl         >= 1.4               ,
+        comonad       >= 4                 ,
+        free          >= 4                 ,         
+        void          >= 0.6               ,
+        split         >= 0.2.2             ,
+        monoid-subclasses >= 1.1
+    Exposed-Modules:
+        Control.Foldl.Transduce,
+        Control.Foldl.Transduce.ByteString,
+        Control.Foldl.Transduce.Text
+    GHC-Options: -O2 -Wall
+    default-language: Haskell2010
+
+test-suite doctests
+    type:           exitcode-stdio-1.0
+    ghc-options:    -Wall -threaded
+    hs-source-dirs: tests
+    main-is:        doctests.hs
+
+    build-depends:
+          base          >= 4.4 && < 5
+        , free          >= 4
+        , doctest       >= 0.10.1
+    default-language: Haskell2010
+
+test-suite tests
+    type:           exitcode-stdio-1.0
+    ghc-options:    -Wall -threaded
+    hs-source-dirs: tests
+    main-is:        tests.hs
+    build-depends:
+          base >= 4.4 && < 5  ,
+          text                ,
+          tasty >= 0.10.1.1   ,
+          tasty-hunit >= 0.9.2,
+          tasty-quickcheck >= 0.8.3.2, 
+          monoid-subclasses >= 1.1,
+          split         >= 0.2.2,
+          foldl               ,
+          foldl-transduce
+    default-language: Haskell2010
+
+benchmark benchmarks
+    Type:             exitcode-stdio-1.0
+    HS-Source-Dirs:   benchmarks
+    Main-Is:          benchmarks.hs
+    GHC-Options: -O2 -Wall -rtsopts 
+
+    Build-Depends:
+        base         >= 4.4     && < 5  ,
+        criterion    >= 1.1.0.0 && < 1.6,
+        lens-family-core >= 1.2.0       ,
+        foldl                           ,
+        foldl-transduce
+    default-language: Haskell2010
diff --git a/src/Control/Foldl/Transduce.hs b/src/Control/Foldl/Transduce.hs
--- a/src/Control/Foldl/Transduce.hs
+++ b/src/Control/Foldl/Transduce.hs
@@ -1,1128 +1,1121 @@
-{-# LANGUAGE ExistentialQuantification, RankNTypes #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE CPP #-}
-
-{-| This module builds on module "Control.Foldl", adding stateful transducers
-    and grouping operations.
-
->>> L.fold (transduce (surround "[" "]") L.list) "middle"
-"[middle]"
-
->>> L.fold (folds (chunksOf 2) L.length L.list) "aabbccdd"
-[2,2,2,2]
-
->>> L.fold (groups (chunksOf 2) (surround "[" "]") L.list) "aabbccdd"
-"[aa][bb][cc][dd]"
-
--}
-
-module Control.Foldl.Transduce (
-        -- * Transducer types
-        Transduction 
-    ,   Transduction' 
-    ,   Transducer(..)
-    ,   ToTransducer(..)
-        -- ** Monadic transducer types
-    ,   TransductionM
-    ,   TransductionM'
-    ,   TransducerM(..)
-    ,   ToTransducerM(..)
-        -- * Applying transducers
-    ,   transduce
-    ,   transduce'
-    ,   transduceM
-    ,   transduceM'
-    ,   transduceK
-        -- * Folding over groups
-    ,   folds
-    ,   folds'
-    ,   foldsM
-    ,   foldsM'
-        -- * Group operations
-    ,   ReifiedTransduction' (..)
-    ,   reify
-    ,   reify'
-    ,   Moore(..)
-    ,   ToTransductions' (..)
-    ,   moveHead
-    ,   groups
-    ,   bisect
-    ,   groups'
-        -- ** Monadic group operations
-    ,   ReifiedTransductionM' (..)
-    ,   reifyM
-    ,   reifyM'
-    ,   MooreM(..)
-    ,   ToTransductionsM' (..)
-    ,   moveHeadM
-    ,   groupsM
-    ,   bisectM
-    ,   groupsM'
-        -- * Transducers
-    ,   ignore
-    ,   surround
-    ,   surroundIO
-        -- * Splitters
-    ,   chunksOf
-    ,   split
-    ,   splitAt
-    ,   chunkedSplitAt
-    ,   splitLast
-    ,   break
-    ,   chunkedStripPrefix
-        -- * Transducer utilities
-    ,   foldify
-    ,   foldifyM
-    ,   condense
-    ,   condenseM
-    ,   hoistTransducer
-        -- * Fold utilities
-    ,   hoistFold
-    ,   unit
-    ,   trip
-    ,   quiesce
-    ,   Fallible(..)
-    ,   ToFold(..)
-    ,   ToFoldM(..)
-        -- * Deprecated
-        -- * Re-exports
-        -- $reexports
-    ,   module Data.Functor.Extend
-    ,   module Control.Foldl
-    ,   module Control.Comonad.Cofree
-    ) where
-
-import Prelude hiding (split,splitAt,break)
-
-import Data.Functor
-import Data.Bifunctor
-import Data.Profunctor
-import Data.Monoid
-import Data.Void
-import qualified Data.Monoid.Cancellative as CM
-import qualified Data.Monoid.Null as NM
-import qualified Data.Monoid.Factorial as SFM
-import Data.Functor.Identity
-import Data.Functor.Extend
-import Data.Foldable (Foldable,foldlM,foldl',toList)
-import Data.Traversable
-import Control.Applicative
-import Control.Monad
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.Except
-import Control.Comonad
-import Control.Comonad.Cofree 
-import Control.Foldl (Fold(..),FoldM(..),hoists)
-import qualified Control.Foldl as L
-
-{- $setup
-
->>> import qualified Control.Foldl as L
->>> import Control.Foldl.Transduce
->>> import Control.Applicative
->>> import qualified Control.Comonad.Cofree as C
->>> import Prelude hiding (split,splitAt,break)
-
--}
-
-------------------------------------------------------------------------------
-
-#if !(MIN_VERSION_foldl(1,1,2))
-instance Comonad (Fold a) where
-    extract (Fold _ begin done) = done begin
-    {-# INLINABLE extract #-}
-
-    duplicate (Fold step begin done) = Fold step begin (\x -> Fold step x done)
-    {-# INLINABLE duplicate #-}
-#endif
-
-instance Extend (Fold a) where
-    duplicated f = duplicate f
-    {-# INLINABLE duplicated #-}
-
-instance Monad m => Extend (FoldM m a) where
-    duplicated (FoldM step begin done) = 
-        FoldM step begin (\x -> return $! FoldM step (return x) done)
-    {-# INLINABLE duplicated #-}
-
-------------------------------------------------------------------------------
-
-data Pair a b = Pair !a !b
-
-data Quartet a b c d = Quartet !a !b !c !d
-
-fst3 :: (a,b,c) -> a
-fst3 (x,_,_) = x
-
-------------------------------------------------------------------------------
-
-{-| A (possibly stateful) transformation on the inputs of a 'Fold'.
-
-    Functions constructed with combinators like 'L.premap' or 'L.handles' from
-    "Control.Foldl" also typecheck as a 'Transduction'.
--}
-type Transduction a b = forall x. Fold b x -> Fold a x
-
-{-| A more general from of 'Transduction' that adds new information to the
-    return value of the 'Fold'.
-
--}
-type Transduction' a b r = forall x. Fold b x -> Fold a (r,x)
-
-{-| Helper for storing a 'Transduction'' safely on a container.		
-
--}
-newtype ReifiedTransduction' a b r = ReifiedTransduction' { getTransduction' :: Transduction' a b r }
-
-{-| Convenience constructor, often useful with pure functions like 'id'.		
-
--}
-reify :: Transduction a b -> ReifiedTransduction' a b ()
-reify t = reify' (fmap (fmap ((,) ())) t)  
-
-reify' :: Transduction' a b r -> ReifiedTransduction' a b r
-reify' = ReifiedTransduction' 
-
-{-| A stateful process that transforms a stream of inputs into a stream of
-    outputs, and may optionally demarcate groups in the stream of outputs.
-
-    Composed of a step function, an initial state, and a extraction function. 
-
-    The step function returns a triplet of:
-
-    * The new internal state.
-    * List of outputs belonging to the last segment detected in the previous step.
-    * A list of lists of outputs belonging to segments detected in the current
-      step. If the list is empty, that means no splitting has taken place in the
-      current step. 'Transducer's that do not perform grouping never return anything
-      other than @[]@ here. In effect, they treat the whole stream as a single group.
-
-    The extraction function returns the 'Transducer's own result value, along with any
-    pending output.
--}
-data Transducer i o r
-     = forall x. Transducer (x -> i -> (x,[o],[[o]])) x (x -> (r,[o],[[o]]))
-
-instance Comonad (Transducer i o) where
-    extract (Transducer _ begin done) = fst3 (done begin)
-    {-# INLINABLE extract #-}
-
-    duplicate (Transducer step begin done) = Transducer step begin (\x -> (Transducer step x done,[],[]))
-    {-# INLINABLE duplicate #-}
-
-instance Extend (Transducer i o) where
-    duplicated f = duplicate f
-    {-# INLINABLE duplicated #-}
-
-instance Functor (Transducer i o) where
-    fmap f (Transducer step begin done) = 
-        Transducer 
-            step 
-            begin 
-            ((\(x,xs,xss) -> (f x,xs,xss)) . done)
-
-instance Bifunctor (Transducer i) where
-    first f (Transducer step begin done) =
-        Transducer 
-            (fmap (\(x,xs,xss) -> (x,map f xs, map (map f) xss)) . step) 
-            begin 
-            ((\(x,xs,xss) -> (x,map f xs, map (map f) xss)) . done) 
-    second f w = fmap f w
-
-{-| Helps converting monadic transducers (over 'Identity') into pure ones.		
-
--}
-class ToTransducer t where
-    toTransducer :: t i o r -> Transducer i o r
-
-instance ToTransducer Transducer where
-    toTransducer = id
-
-instance ToTransducer (TransducerM Identity) where
-    toTransducer = _simplify
-
-class ToFold t where
-    toFold :: t i r -> Fold i r
-
-instance ToFold Fold where
-    toFold = id
-
-instance ToFold (FoldM Identity) where
-    toFold = L.simplify
-
-{-| Like 'Transduction', but works on monadic 'Fold's.		
-
--}
-type TransductionM m a b = forall x. Monad m => FoldM m b x -> FoldM m a x
-
-{-| Like 'Transduction'', but works on monadic 'Fold's.		
-
--}
-type TransductionM' m a b r = forall x. FoldM m b x -> FoldM m a (r,x)
-
-{-| Helper for storing a 'TransductionM'' safely on a container.		
-
--}
-newtype ReifiedTransductionM' m a b r = ReifiedTransductionM' { getTransductionM' :: TransductionM' m a b r }
-
-{-| Monadic version of 'reify'.		
-
--}
-reifyM :: Monad m => TransductionM m a b -> ReifiedTransductionM' m a b ()
-reifyM t = reifyM' (fmap (fmap ((,) ())) t)  
-
-{-| Monadic version of 'reifyM'.		
-
--}
-reifyM' :: TransductionM' m a b r -> ReifiedTransductionM' m a b r
-reifyM' = ReifiedTransductionM' 
-
-{-| Like 'Transducer', but monadic.
-
--}
-data TransducerM m i o r
-     = forall x. TransducerM (x -> i -> m (x,[o],[[o]])) (m x) (x -> m (r,[o],[[o]]))
-
-
-instance Monad m => Functor (TransducerM m i o) where
-    fmap f (TransducerM step begin done) = TransducerM step begin done'
-      where
-        done' x = do
-            (r,os,oss) <- done x
-            let r' = f r
-            return $! (r' `seq` (r',os,oss))
-
-instance (Functor m, Monad m) => Bifunctor (TransducerM m i) where
-    first f (TransducerM step begin done) =
-        TransducerM 
-        (fmap (fmap (\(x,xs,xss) -> (x,map f xs, map (map f) xss))) . step) 
-        begin 
-        (fmap (\(x,xs,xss) -> (x,map f xs, map (map f) xss)) . done) 
-    second f w = fmap f w
-
-instance Monad m => Extend (TransducerM m i o) where
-    duplicated (TransducerM step begin done) = 
-        TransducerM step begin (\x -> return $! (TransducerM step (return x) done,[],[]))
-    {-# INLINABLE duplicated #-}
-
-
-{-| Helps converting pure transducers into monadic ones.		
-
--}
-class ToTransducerM m t where
-    toTransducerM :: t i o r -> TransducerM m i o r
-
--- http://chrisdone.com/posts/haskell-constraint-trick
-instance (m ~ m') => ToTransducerM m (TransducerM m') where
-    toTransducerM = id
-
-instance Monad m => ToTransducerM m Transducer where
-    toTransducerM = _generalize
-
-class ToFoldM m t where
-    toFoldM :: t i r -> FoldM m i r
-
-instance (m ~ m') => ToFoldM m (FoldM m') where
-    toFoldM = id
-
-instance Monad m => ToFoldM m Fold where
-    toFoldM = L.generalize
-
-
-{-| Apply a 'Transducer' to a 'Fold', discarding the return value of the
-    'Transducer'.		
-
->>> L.fold (transduce (Transducer (\_ i -> ((),[i],[])) () (\_ -> ((),[],[]))) L.list) [1..7]
-[1,2,3,4,5,6,7]
--}
-transduce :: ToTransducer t => t i o () -> Transduction i o 
-transduce t = fmap snd . (transduce' t)
-
-{-| Generalized version of 'transduce' that preserves the return value of
-    the 'Transducer'.
-
->>> L.fold (transduce' (Transducer (\_ i -> ((),[i],[])) () (\_ -> ('r',[],[]))) L.list) [1..7]
-('r',[1,2,3,4,5,6,7])
--}
-transduce' :: ToTransducer t => t i o s -> Transduction' i o s
-transduce' (toTransducer -> Transducer wstep wstate wdone) (Fold fstep fstate fdone) =
-    Fold step (Pair wstate fstate) done 
-        where
-            step (Pair ws fs) i = 
-                let (ws',os,oss) = wstep ws i 
-                in
-                Pair ws' (foldl' fstep fs (os ++ mconcat oss))  
-            done (Pair ws fs) = 
-                let (wr,os,oss) = wdone ws
-                in 
-                (,) wr (fdone (foldl' fstep fs (os ++ mconcat oss)))
-
-
-{-| Like 'transduce', but works on monadic 'Fold's.		
-
--}
-transduceM :: (Monad m, ToTransducerM m t)  => t i o () -> TransductionM m i o 
-transduceM t = fmap snd . (transduceM' t)
-
-{-| Like 'transduce'', but works on monadic 'Fold's.		
-
--}
-transduceM' :: (Monad m, ToTransducerM m t)  => t i o s -> TransductionM' m i o s
-transduceM' (toTransducerM -> TransducerM wstep wstate wdone) (FoldM fstep fstate fdone) =
-    FoldM step (liftM2 Pair wstate fstate) done 
-        where
-            step (Pair ws fs) i = do
-                (ws',os,oss) <- wstep ws i
-                fs' <- foldlM fstep fs (os ++ mconcat oss)
-                return $! Pair ws' fs'
-            done (Pair ws fs) = do
-                (wr,os,oss) <- wdone ws
-                fr <- fdone =<< foldlM fstep fs (os ++ mconcat oss)
-                return $! (,) wr fr
-
-{-| Transduce with a Kleisli arrow that returns a list.		
-
--}
-transduceK :: (Monad m) => (i -> m [o]) -> TransductionM m i o 
-transduceK k = transduceM (TransducerM step (return ()) (\_ -> return ((),[],[])))
-    where
-    step _ i = liftM (\os -> ((),os,[])) (k i)
-
-
-------------------------------------------------------------------------------
-
-{-| Ignore all the inputs coming into the fold.
-
-    Polymorphic in both inputs and outputs.		
-
--}
-ignore :: Transducer a b ()
-ignore = 
-    Transducer step () done 
-    where
-        step _ _ = 
-            ((),[],[])
-        done = 
-            const ((),[],[])
-
-data SurroundState = PrefixAdded | PrefixPending
-
-{-| Adds a prefix and a suffix to the stream arriving into a 'Fold'.		
-
->>> L.fold (transduce (surround "prefix" "suffix") L.list) "middle"
-"prefixmiddlesuffix"
-
-    Used as a splitter, it puts the prefix, the original stream and
-    the suffix in separate groups:
-
->>> L.fold (groups (surround "prefix" "suffix") (surround "[" "]") L.list) "middle"
-"[prefix][middle][suffix]"
-
--}
-surround :: (Traversable p, Traversable s) => p a -> s a -> Transducer a a ()
-surround (toList -> ps) (toList -> ss) = 
-    Transducer step PrefixPending done 
-    where
-        step PrefixPending a = 
-            (PrefixAdded, ps,[[a]])
-        step PrefixAdded a = 
-            (PrefixAdded, [a],[])
-        done PrefixPending = 
-            ((), ps, [[],ss])
-        done PrefixAdded = 
-            ((), [], [ss])
-
-{-| Like 'surround', but the prefix and suffix are obtained using a 'IO'
-    action.
-
->>> L.foldM (transduceM (surroundIO (return "prefix") (return "suffix")) (L.generalize L.list)) "middle"
-"prefixmiddlesuffix"
--}
-surroundIO :: (Traversable p, Traversable s, Functor m, MonadIO m) 
-           => m (p a) 
-           -> m (s a) 
-           -> TransducerM m a a ()
-surroundIO prefixa suffixa = 
-    TransducerM step (return PrefixPending) done 
-    where
-        step PrefixPending a = do
-            ps <- fmap toList prefixa
-            return (PrefixAdded, ps, [[a]])
-        step PrefixAdded a = 
-            return (PrefixAdded, [a], [])
-        done PrefixPending = do
-            ps <- fmap toList prefixa
-            ss <- fmap toList suffixa
-            return ((), ps, [[],ss])
-        done PrefixAdded = do
-            ss <- fmap toList suffixa
-            return ((), [], [ss])
-
-------------------------------------------------------------------------------
-
-{-| Generalize a 'Transducer' to a 'TransducerM'.		
-
--}
-_generalize :: Monad m => Transducer i o s -> TransducerM m i o s
-_generalize (Transducer step begin done) = TransducerM step' begin' done'
-    where
-    step' x a = return (step x a)
-    begin'    = return  begin
-    done' x   = return (done x)
-
-{-| Simplify a pure 'TransducerM' to a 'Transducer'.		
-
--}
-_simplify :: TransducerM Identity i o s -> Transducer i o s
-_simplify (TransducerM step begin done) = Transducer step' begin' done' 
-    where
-    step' x a = runIdentity (step x a)
-    begin'    = runIdentity  begin
-    done' x   = runIdentity (done x)
-
-
-{-| Transforms a 'Transducer' into a 'Fold' by forgetting about the data sent
-    downstream.		
-
--}
-foldify :: Transducer i o s -> Fold i s
-foldify (Transducer step begin done) =
-    Fold (\x i -> fst3 (step x i)) begin (\x -> fst3 (done x))
-
-{-| Monadic version of 'foldify'.		
-
--}
-foldifyM :: Functor m => TransducerM m i o s -> FoldM m i s
-foldifyM (TransducerM step begin done) =
-    FoldM (\x i -> fmap fst3 (step x i)) begin (\x -> fmap fst3 (done x))
-
-{-| Transforms a 'Fold' into a 'Transducer' that sends the return value of the
-    'Fold' downstream when upstream closes.		
-
--}
-condense :: Fold a r -> Transducer a r r
-condense (Fold fstep fstate fdone) =
-    (Transducer wstep fstate wdone)
-    where
-        wstep = \fstate' i -> (fstep fstate' i,[],[])
-        wdone = \fstate' -> (\r -> (r,[r],[])) (fdone fstate')
-
-{-| Monadic version of 'condense'.		
-
--}
-condenseM :: Applicative m => FoldM m a r -> TransducerM m a r r
-condenseM (FoldM fstep fstate fdone) = 
-    (TransducerM wstep fstate wdone)
-    where
-        wstep = \fstate' i -> fmap (\s -> (s,[],[])) (fstep fstate' i)
-        wdone = \fstate' -> fmap (\r -> (r,[r],[])) (fdone fstate')
-
-
-{-| Changes the base monad used by a 'TransducerM'.		
-
--}
-hoistTransducer :: Monad m => (forall a. m a -> n a) -> TransducerM m i o s -> TransducerM n i o s 
-hoistTransducer g (TransducerM step begin done) = TransducerM (\s i -> g (step s i)) (g begin) (g . done)
-
-{-| Changes the base monad used by a 'FoldM'.		
-
-    Another name for 'Control.Foldl.hoists'.
--}
-hoistFold :: Monad m => (forall a. m a -> n a) -> FoldM m i r -> FoldM n i r 
-hoistFold = Control.Foldl.hoists
-
-{-| Turn a 'FoldM' that fails abruptly into one that encodes the error into
-    its return value.
-
-    Can be useful when combining fallible 'FoldM's with non-fallible ones.
-
->>> L.foldM (quiesce (FoldM (\_ _-> throwE ()) (return ()) (\_ -> throwE ()))) [1..7]
-Left ()
--}
-quiesce :: Monad m => FoldM (ExceptT e m) a r -> FoldM m a (Either e r)
-quiesce (FoldM step initial done) = 
-    FoldM step' (runExceptT initial) done'
-    where
-    step' x i = do  
-        case x of
-            Left _ -> return x
-            Right notyetfail -> runExceptT (step notyetfail i)
-    done' x = do
-        case x of 
-            Left e -> return (Left e)
-            Right notyetfail -> do
-                result <- runExceptT (done notyetfail)
-                case result of 
-                    Left e -> return (Left e)
-                    Right r -> return (Right r)
-
-newtype Fallible m r i e = Fallible { 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 (FoldM step initial done)) k =
-    Fallible (FoldM step' (lift (runExceptT (withExceptT (getFallible . k) initial))) done')
-    where 
-        step' x i = ExceptT (case x of
-            Left ffold -> do
-                rx <- runExceptT (L.foldM (duplicated ffold) [i])
-                case rx of
-                    Left e' -> return (Left e') -- true failure
-                    Right ffold' -> return (Right (Left ffold'))
-            Right notyetfail -> do
-                 x' <- runExceptT (step notyetfail i)
-                 case x' of
-                     Left e -> do
-                         return (Right (Left ((getFallible . k) e)))
-                     Right x'' -> return (Right (Right x'')))
-        done' x = ExceptT (case x of
-            Left ffold -> do
-                rx <- runExceptT (L.foldM ffold [])
-                case rx of
-                    Left e' -> return (Left e') -- true failure
-                    Right r -> return (Right r)
-            Right notyetfail -> do
-                 x' <- runExceptT (done notyetfail)
-                 case x' of
-                     Left e -> do
-                         runExceptT (done' (Left (getFallible (k e))))
-                     Right x'' -> return (Right x''))
-
-instance (Functor m, Monad m) => Functor (Fallible m r i) where
-    fmap g (Fallible fallible) = 
-        Fallible (hoistFold (withExceptT g) fallible)
-
-
-{-| 'pure' creates a 'Fallible' that starts in a failed state.		
-
--}
-instance (Functor m,Monad m) => Applicative (Fallible m r i) where
-    pure e = Fallible (FoldM (\_ _ -> throwE e) (throwE e) (\_ -> throwE e))
-
-    u <*> v = u >>= \f -> fmap f v
-
-instance (Functor m, Monad m) => Profunctor (Fallible m r) where
-    lmap f (Fallible fallible) = 
-        Fallible (L.premapM (return . f) fallible)
-
-    rmap g (Fallible fallible) = 
-        Fallible (hoistFold (withExceptT g) fallible)
-
-{-| Fail immediately when an input comes in the wrong branch.		
-
--}
-instance (Functor m,Monad m,Monoid r) => Choice (Fallible m r) where
-    left' (Fallible fallible) = 
-        Fallible (liftA2 mappend (hoistFold (withExceptT Left) (L.handlesM _Left fallible)) (hoistFold (withExceptT Right) (L.handlesM _Right (trip $> mempty))))
-
-_Left :: Applicative f => (a -> f a) -> Either a b -> f (Either a b)
-_Left f e = case e of
-    Right b -> pure (Right b)
-    Left a -> fmap Left (f a)
-
-_Right :: Applicative f => (b -> f b) -> Either a b -> f (Either a b)
-_Right f e = case e of
-    Left b -> pure (Left b)
-    Right a -> fmap Right (f a)
-
-{-| '>>=' continues folding after an error using a 'Fallible' constructed from the error.		
-
--}
-instance (Functor m,Monad m) => Monad (Fallible m r i) where
-    (>>=) = bindFallible
-    return = pure
-
-{-| The "do-nothing" fold.		
-
--}
-unit :: Fold a ()
-unit = pure () 
-
-{-| A fold that fails if it receives any input at all. The received input is
-    used as the error.		
-
--}
-trip :: Monad m => FoldM (ExceptT a m) a ()
-trip = FoldM (\_ x -> throwE x) (return ()) (\_ -> return mempty)
-
-------------------------------------------------------------------------------
-
-{-| An unending machine that eats @u@ values and returns 
-    'ReifiedTransduction''s whose result type is also @u@.
-
--}
-newtype Moore a b u = Moore { getMoore :: Cofree ((->) u) (ReifiedTransduction' a b u) }
-
-{-| Monadic version of 'Moore'.		
-
--}
-newtype MooreM m a b u = MooreM { getMooreM :: Cofree ((->) u) (ReifiedTransductionM' m a b u) }
-
-{-| Prepend the head of the first argument to the second argument.		
-
--}
-moveHead :: (ToTransductions' h,ToTransductions' t) => h a b u -> t a b u -> Moore a b u 
-moveHead (toTransductions' -> Moore (theHead :< _)) (toTransductions' -> Moore theTail) = Moore (theHead :< const theTail)
-
-{-| Monadic version of 'moveHead'.		
-
--}
-moveHeadM :: (Monad m, ToTransductionsM' m h, ToTransductionsM' m t) => h a b u -> t a b u -> MooreM m a b u 
-moveHeadM (toTransductionsM' -> MooreM (theHead :< _)) (toTransductionsM' -> MooreM theTail) = MooreM (theHead :< const theTail)
-
-{-| Helper for obtaining infinite sequences of 'Transduction''s from suitable
-    types (in order to avoid explicit conversions).		
-
--}
-class ToTransductions' t where
-    toTransductions' :: t a b u -> Moore a b u
-
-instance ToTransductions' Moore where
-    toTransductions' = id
-
-instance ToTransductions' Transducer where
-    toTransductions' t = toTransductions' (reify' (transduce' t))
-
-instance ToTransductions' ReifiedTransduction' where
-    toTransductions' = Moore . coiter const
-
-{-| Monadic version of 'ToTransductions''.		
-
--}
-class Monad m => ToTransductionsM' m t where
-    toTransductionsM' :: t a b u -> MooreM m a b u
-
-instance (m ~ m', Monad m') => ToTransductionsM' m (MooreM m') where
-    toTransductionsM' = id
-
-instance (m ~ m', Monad m') => ToTransductionsM' m (TransducerM m') where
-    toTransductionsM' t = toTransductionsM' (reifyM' (transduceM' t))
-
-instance Monad m => ToTransductionsM' m Transducer where
-    toTransductionsM' (toTransducerM -> t) = toTransductionsM' (reifyM' (transduceM' t))
-
-instance (m ~ m', Monad m') => ToTransductionsM' m (ReifiedTransductionM' m') where
-    toTransductionsM' = MooreM . coiter const
-
-{-| Processes each of the groups demarcated by a 'Transducer' using 
-    a 'Transduction' taken from an unending supply, 
-    returning a 'Transduction' what works over the undivided stream of inputs. 
-    
-    The return value of the 'Transducer' is discarded.
-
->>> L.fold (groups (chunksOf 2) (surround "<" ">") L.list) "aabbccdd"
-"<aa><bb><cc><dd>"
-
->>> :{ 
-    let transductions = Moore (C.unfold (\i ->
-          (reify (transduce (surround (show i) [])), \_ -> succ i)) 0)
-    in L.fold (groups (chunksOf 2) transductions L.list) "aabbccdd"
-    :}
-"0aa1bb2cc3dd"
--}
-groups :: (ToTransducer s, ToTransductions' t) 
-       => s a b () -- ^ 'Transducer' working as a splitter.
-       -> t b c () -- ^ infinite list of transductions
-       -> Transduction a c 
-groups splitter transductions oldfold = 
-        fmap snd (groups' splitter transductions unit oldfold)
-
-{-| Use a different 'Transduction' for the first detected group.		
-
->>> :{ 
-    let drop n = bisect (splitAt n) ignore (reify id)
-    in L.fold (drop 2 L.list) "aabbccdd"
-    :}
-"bbccdd"
--}
-bisect :: (ToTransducer s, ToTransductions' h, ToTransductions' t)
-       => s a b () -- ^ 'Transducer' working as a splitter.
-       -> h b c () -- ^ Machine to process the first group
-       -> t b c () -- ^ Machine to process the second and subsequent groups
-       -> Transduction a c
-bisect sp t1 t2 = groups sp (moveHead t1 t2)
-
-data StrictSum a b = Left' !a | Right' !b
-
-{-| Generalized version of 'groups' that preserves the return value of the
-    'Transducer'.
-
-    A summary value for each group is also calculated. These values are 
-    aggregated for the whole stream, with the help of an auxiliary 'Fold'.
-
-
->>> :{ 
-    let transductions = 
-          reify' (\f -> transduce (surround "<" ">") ((,) <$> L.list <*> f))
-    in L.fold (groups' (chunksOf 2) transductions L.list L.list) "aabbccdd"
-    :}
-(((),["<aa>","<bb>","<cc>","<dd>"]),"<aa><bb><cc><dd>")
--}
-groups' :: (ToTransducer s, ToTransductions' t, ToFold f)
-        => s a b r -- ^ 'Transducer' working as a splitter. 
-        -> t b c u -- ^ machine that eats @u@ values and spits transductions
-        -> f     u v -- ^ auxiliary 'Fold' that aggregates the @u@ values produced for each group
-        -> Transduction' a c (r,v) 
-groups' (toTransducer -> Transducer sstep sbegin sdone) 
-        (toTransductions' -> Moore (rt0 :< somemachine)) 
-        (toFold -> Fold astep abegin adone) 
-        somefold 
-        =
-    Fold step (Quartet sbegin somemachine abegin (Left' (rt0,somefold))) done 
-    where 
-        step (Quartet sstate machine astate innerfold) i =
-           let (sstate',oldSplit,newSplits) = sstep sstate i
-           in
-           case (oldSplit,newSplits) of
-                ([],[]) -> 
-                    Quartet sstate' machine astate innerfold -- pass innerfold untouched
-                _ -> 
-                    let actualinnerfold = case innerfold of
-                            Left' (ReifiedTransduction' t0,pristine) -> t0 (duplicated pristine)
-                            Right' touched -> touched
-                        (machine',astate',innerfold') = 
-                           foldl' 
-                           step'
-                           (machine,astate,feed actualinnerfold oldSplit) 
-                           newSplits
-                    in
-                    Quartet sstate' machine' astate' (Right' innerfold')
-        
-        done (Quartet sstate machine astate innerfold) = 
-            let (s,oldSplit,newSplits) = sdone sstate
-            in
-            case (oldSplit,newSplits,innerfold) of
-                ([],[],Left' (_,pristine)) -> 
-                    ((s,adone astate), extract pristine)
-                _ ->     
-                    let actualinnerfold = case innerfold of
-                            Left' (ReifiedTransduction' t0,pristine) -> t0 (duplicated pristine)
-                            Right' touched -> touched
-                        (_,astate',innerfold') = 
-                           foldl' 
-                           step'
-                           (machine,astate,feed actualinnerfold oldSplit) 
-                           newSplits
-                        (u,finalfold) = extract innerfold'
-                    in  
-                    ((s,adone (astep astate' u)),extract finalfold)
-
-        step' (machine_,astate,innerfold_) somesplit = 
-           let (u,resetted,nextmachine) = reset machine_ innerfold_
-           in  (nextmachine,astep astate u,feed resetted somesplit)
-
-        feed = L.fold . duplicated
-
-        reset machine (Fold _ fstate fdone) = 
-            let (u,nextfold) = fdone fstate
-                ReifiedTransduction' t1 :< nextmachine = machine u
-            in  (u,t1 (duplicated nextfold),nextmachine)
-
-{-| Monadic version of 'groups'.		
-
--}
-groupsM :: (Monad m, ToTransducerM m s, ToTransductionsM' m t)
-               => s a b () -- ^
-               -> t b c ()
-               -> TransductionM m a c
-groupsM splitter transductions oldfold = 
-        fmap snd (groupsM' splitter transductions unit oldfold)
-
-
-{-| Monadic version of 'bisect'.		
-
--}
-bisectM :: (Monad m, ToTransducerM m s, ToTransductionsM' m h, ToTransductionsM' m t)
-               => s a b () -- ^
-               -> h b c ()
-               -> t b c ()
-               -> TransductionM m a c
-bisectM s t1 t2 = groupsM s (moveHeadM t1 t2)
-
-{-| Monadic version of 'groups''.		
-
--}
-groupsM' :: (Monad m, ToTransducerM m s, ToTransductionsM' m t, ToFoldM m f) 
-         => s a b r 
-         -> t b c u -- ^ 
-         -> f     u v 
-         -> TransductionM' m a c (r,v) 
-groupsM' (toTransducerM -> TransducerM sstep sbegin sdone) 
-         (toTransductionsM' -> MooreM (rt0 :< somemachine)) 
-         (toFoldM -> FoldM astep abegin adone) 
-         somefold 
-         =
-    FoldM step 
-          (do sbegin' <- sbegin
-              abegin' <- abegin
-              return (Quartet sbegin' somemachine abegin' (Left' (rt0,somefold))))
-          done        
-    where
-        step (Quartet sstate machine astate innerfold) i = do
-            (sstate',oldSplit, newSplits) <- sstep sstate i 
-            case (oldSplit,newSplits) of 
-                ([],[]) -> 
-                    return $! Quartet sstate' machine astate innerfold -- pass innerfold untouched
-                _       -> do
-                    let actualinnerfold = case innerfold of
-                            Left' (ReifiedTransductionM' t0,pristine) -> t0 (duplicated pristine)
-                            Right' touched -> touched
-                    innerfold' <- feed actualinnerfold oldSplit
-                    (machine',astate',innerfold'') <- foldlM step' (machine,astate,innerfold') newSplits
-                    return $! Quartet sstate' machine' astate' (Right' innerfold'')
-
-        done (Quartet sstate machine astate innerfold) = do
-            (s,oldSplit,newSplits) <- sdone sstate
-            case (oldSplit,newSplits,innerfold) of 
-              ([],[],Left' (_,pristine)) -> do
-                  a <- adone astate
-                  p <- L.foldM pristine []
-                  return ((s,a),p)
-              _ -> do
-                  let actualinnerfold = case innerfold of
-                          Left' (ReifiedTransductionM' t0,pristine) -> t0 (duplicated pristine)
-                          Right' touched -> touched
-                  innerfold' <- feed actualinnerfold oldSplit
-                  (_,astate',innerfold'') <- foldlM step' (machine,astate,innerfold') newSplits
-                  (u,finalfold) <- L.foldM innerfold'' []
-                  v <- adone =<< astep astate' u
-                  r <- L.foldM finalfold []
-                  return ((s,v),r)
-
-        step' (machine,astate,innerfold) is = do
-            (u,innerfold',machine') <- reset machine innerfold 
-            astate' <- astep astate u
-            innerfold'' <- feed innerfold' is
-            return $! (machine',astate',innerfold'') 
-
-        feed = L.foldM . duplicated
-
-        reset machine (FoldM _ fstate fdone) = do
-           (u,nextfold) <- fdone =<< fstate 
-           let 
-               ReifiedTransductionM' t1 :< nextmachine = machine u
-           return (u,t1 (duplicated nextfold),nextmachine)
-
-{-| Summarizes each of the groups demarcated by the 'Transducer' using a
-    'Fold'. 
-    
-    The result value of the 'Transducer' is discarded.
-
->>> L.fold (folds (chunksOf 3) L.sum L.list) [1..7]
-[6,15,7]
--}
-folds :: (ToTransducer t, ToFold f) 
-      => t a b () -- ^ 'Transducer' working as a splitter.
-      -> f b c 
-      -> Transduction a c
-folds splitter (toFold -> f) = groups splitter (fmap (const ()) (condense f))
-
-{-| Like 'folds', but preserves the return value of the 'Transducer'.
-
->>> L.fold (folds' (chunksOf 3) L.sum L.list) [1..7]
-((),[6,15,7])
--}
-folds' :: (ToTransducer t, ToFold f) 
-       => t a b s -- ^ 'Transducer' working as a splitter.
-       -> f b c 
-       -> Transduction' a c s
-folds' splitter (toFold -> innerfold) somefold = 
-    fmap (bimap fst id) (groups' splitter innertrans unit somefold)
-    where
-    innertrans = reify' $ \x -> fmap ((,) () . snd) (transduce' (condense innerfold) x)
-
-{-| Monadic version of 'folds'.		
-
--}
-foldsM :: (Applicative m, Monad m, ToTransducerM m t, ToFoldM m f) 
-       => t a b () -- ^
-       -> f b c 
-       -> TransductionM m a c
-foldsM splitter (toFoldM -> f) = groupsM splitter (fmap (const ()) (condenseM f))
-
-{-| Monadic version of 'folds''.		
-
--}
-foldsM' :: (Applicative m,Monad m, ToTransducerM m t, ToFoldM m f) 
-        => t a b s -- ^
-        -> f b c 
-        -> TransductionM' m a c s
-foldsM' splitter (toFoldM -> innerfold) somefold = 
-    fmap (bimap fst id) (groupsM' splitter innertrans unit somefold)
-    where
-    innertrans = reifyM' $ \x -> fmap ((,) () . snd) (transduceM' (condenseM innerfold) x)
-
-------------------------------------------------------------------------------
-
-{-| Splits a stream into chunks of fixed size.		
-
->>> L.fold (folds (chunksOf 2) L.list L.list) [1..7]
-[[1,2],[3,4],[5,6],[7]]
-
->>> L.fold (groups (chunksOf 2) (surround [] [0]) L.list) [1..7]
-[1,2,0,3,4,0,5,6,0,7,0]
--}
-chunksOf :: Int -> Transducer a a ()
-chunksOf 0 = Transducer (\_ _ -> ((),[],repeat [])) () (error "never happens")
-chunksOf groupSize = Transducer step groupSize done 
-    where
-        step 0 a = (pred groupSize, [], [[a]])
-        step i a = (pred i, [a], [])
-        done _ = ((),[],[])
-
-{-| Splits the stream at a given position.		
-
->>> L.fold (bisect (splitAt 2) ignore (reify id) L.list) [1..5]
-[3,4,5]
-
--}
-splitAt :: Int -> Transducer a a ()
-splitAt howmany = 
-    Transducer step (Just howmany) done 
-    where
-        step Nothing i =
-            (Nothing,[i],[])
-        step (Just howmanypending) i 
-            | howmanypending == 0 = 
-                (Nothing,[],[[i]])
-            | otherwise = 
-                (Just (pred howmanypending),[i],[]) 
-        done = mempty
-
-{-| Similar to `splitAt`, but works with streams of "chunked" data like
-    bytestrings, texts, vectors, lists of lists...		
-
->>> L.fold (bisect (chunkedSplitAt 7) ignore (reify id) L.list) [[1..5],[6..9]]
-[[8,9]]
-
--}
-chunkedSplitAt :: SFM.StableFactorialMonoid m => Int -> Transducer m m ()
-chunkedSplitAt howmany = 
-    Transducer step (Just howmany) done
-    where
-        step Nothing m =
-            (Nothing,[m],[])
-        step (Just howmanypending) m
-            | NM.null m = 
-                (Just howmanypending,[],[])
-            | howmanypending == 0 = 
-                (Nothing,[],[[m]])
-            | howmanypending >= SFM.length m =
-                (Just (howmanypending - SFM.length m),[m],[])
-            | otherwise =
-                let (prefix,suffix) = SFM.splitAt howmanypending m
-                in
-                (Nothing,[prefix],[[suffix]])
-        done = mempty
-
-data SplitState = 
-      PreviousSeparator
-    | PreviousNonSeparator
-
-{-| 		
-
->>> L.fold (folds (split (==2)) L.list L.list) [1,2,2,1,1,2,1]
-[[1],[],[1,1],[1]]
-
->>> L.fold (folds (split (==2)) L.list L.list) [2,1,1,2]
-[[],[1,1],[]]
-
--}
-split :: (a -> Bool) -> Transducer a a ()
-split predicate = 
-    Transducer step PreviousNonSeparator done 
-    where
-        step PreviousNonSeparator i = 
-            if predicate i 
-               then (PreviousSeparator,[],[])
-               else (PreviousNonSeparator,[i],[])
-        step PreviousSeparator i = 
-            if predicate i 
-               then (PreviousSeparator,[],[[]])
-               else (PreviousNonSeparator,[],[[i]])
-        done PreviousNonSeparator = mempty
-        done PreviousSeparator = ((),[],[[]])
-
-
-data BreakWhenState = 
-      BreakConditionEncountered 
-    | BreakConditionPending
-
-{-| 		
-
->>> L.fold (bisect (break (>3)) (reify id) ignore L.list) [1..5]
-[1,2,3]
-
--}
-break :: (a -> Bool) -> Transducer a a ()
-break predicate = 
-    Transducer step BreakConditionPending done 
-    where
-        step BreakConditionPending i = 
-            if predicate i 
-               then (BreakConditionEncountered,[],[[i]])
-               else (BreakConditionPending,[i],[])
-        step BreakConditionEncountered i = 
-               (BreakConditionEncountered,[i],[])
-        done = mempty
-
-{-| Puts the last element of the input stream (if it exists) in a separate
-    group.
-
->>> L.fold (bisect (void splitLast) (reify id) ignore L.list) [1..5]
-[1,2,3,4]
--}
-splitLast :: Transducer a a (Maybe a)
-splitLast =
-    Transducer step Nothing done
-    where
-        step Nothing i = 
-            (Just i,[],[])
-        step (Just oldi) i = 
-            (Just i,[oldi],[])
-        done Nothing = 
-            (Nothing,[],[])
-        done (Just lasti) = (Just lasti, [], [[lasti]])
-
-{-| Strip a prefix from a stream of "chunked" data, like packed text.		
-
-    If the prefix doesn't match, fail with the unmatched part of the prefix and
-    the input that caused the error.
-
->>> runExceptT $ L.foldM (transduceM (chunkedStripPrefix [[1..2],[3..4]]) (L.generalize L.list)) [[1..5],[6..9]]
-Right [[5],[6,7,8,9]]
-
->>> runExceptT $ L.foldM (transduceM (chunkedStripPrefix [[1..2],[3,77,99]]) (L.generalize L.list)) [[1..5],[6..9]]
-Left ([[77,99]],Just [4,5])
--}
-chunkedStripPrefix :: (CM.LeftGCDMonoid i,SFM.StableFactorialMonoid i,Traversable t,Monad m) 
-                   => t i -- ^
-                   -> TransducerM (ExceptT ([i],Maybe i) m) i i ()
-chunkedStripPrefix (filter (not . NM.null) . toList -> chunks) = 
-    TransducerM step (return chunks) done
-    where
-        step []     i = 
-            return ([],[i],[])
-        step (x:xs) i = 
-            let (prefix',i',x') = CM.stripCommonPrefix i x 
-            in 
-            if NM.null prefix'
-                then throwE (x:xs,Just i)
-                else 
-                    if NM.null x' 
-                       then step xs i'
-                       else step (x':xs) i'
-        done [] = 
-            return mempty
-        done (x:xs) = 
-            throwE (x:xs, Nothing) 
-
-------------------------------------------------------------------------------
-
-{- $reexports
-
--}
+{-# LANGUAGE ExistentialQuantification, RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE CPP #-}
+
+{-| This module builds on module "Control.Foldl", adding stateful transducers
+    and grouping operations.
+
+>>> L.fold (transduce (surround "[" "]") L.list) "middle"
+"[middle]"
+
+>>> L.fold (folds (chunksOf 2) L.length L.list) "aabbccdd"
+[2,2,2,2]
+
+>>> L.fold (groups (chunksOf 2) (surround "[" "]") L.list) "aabbccdd"
+"[aa][bb][cc][dd]"
+
+-}
+
+module Control.Foldl.Transduce (
+        -- * Transducer types
+        Transduction 
+    ,   Transduction' 
+    ,   Transducer(..)
+    ,   ToTransducer(..)
+        -- ** Monadic transducer types
+    ,   TransductionM
+    ,   TransductionM'
+    ,   TransducerM(..)
+    ,   ToTransducerM(..)
+        -- * Applying transducers
+    ,   transduce
+    ,   transduce'
+    ,   transduceM
+    ,   transduceM'
+    ,   transduceK
+        -- * Folding over groups
+    ,   folds
+    ,   folds'
+    ,   foldsM
+    ,   foldsM'
+        -- * Group operations
+    ,   ReifiedTransduction' (..)
+    ,   reify
+    ,   reify'
+    ,   Moore(..)
+    ,   ToTransductions' (..)
+    ,   moveHead
+    ,   groups
+    ,   bisect
+    ,   groups'
+        -- ** Monadic group operations
+    ,   ReifiedTransductionM' (..)
+    ,   reifyM
+    ,   reifyM'
+    ,   MooreM(..)
+    ,   ToTransductionsM' (..)
+    ,   moveHeadM
+    ,   groupsM
+    ,   bisectM
+    ,   groupsM'
+        -- * Transducers
+    ,   ignore
+    ,   surround
+    ,   surroundIO
+        -- * Splitters
+    ,   chunksOf
+    ,   split
+    ,   splitAt
+    ,   chunkedSplitAt
+    ,   splitLast
+    ,   break
+    ,   chunkedStripPrefix
+        -- * Transducer utilities
+    ,   foldify
+    ,   foldifyM
+    ,   condense
+    ,   condenseM
+    ,   hoistTransducer
+        -- * Fold utilities
+    ,   hoistFold
+    ,   unit
+    ,   trip
+    ,   quiesce
+    ,   Fallible(..)
+    ,   ToFold(..)
+    ,   ToFoldM(..)
+        -- * Deprecated
+        -- * Re-exports
+        -- $reexports
+    ,   module Data.Functor.Extend
+    ,   module Control.Foldl
+    ,   module Control.Comonad.Cofree
+    ) where
+
+import Prelude hiding (split,splitAt,break)
+
+import Data.Functor
+import Data.Bifunctor
+import Data.Profunctor
+import Data.Monoid
+import Data.Void
+import qualified Data.Monoid.Cancellative as CM
+import qualified Data.Monoid.Null as NM
+import qualified Data.Monoid.Factorial as SFM
+import Data.Functor.Identity
+import Data.Functor.Extend
+import Data.Foldable (Foldable,foldlM,foldl',toList)
+import Data.Traversable
+import Control.Applicative
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Except
+import Control.Comonad
+import Control.Comonad.Cofree 
+import Control.Foldl (Fold(..),FoldM(..),hoists)
+import qualified Control.Foldl as L
+
+{- $setup
+
+>>> import qualified Control.Foldl as L
+>>> import Control.Foldl.Transduce
+>>> import Control.Applicative
+>>> import qualified Control.Comonad.Cofree as C
+>>> import Prelude hiding (split,splitAt,break)
+
+-}
+
+------------------------------------------------------------------------------
+
+#if !(MIN_VERSION_foldl(1,4,12))
+instance Extend (Fold a) where
+    duplicated f = duplicate f
+    {-# INLINABLE duplicated #-}
+
+instance Monad m => Extend (FoldM m a) where
+    duplicated (FoldM step begin done) = 
+        FoldM step begin (\x -> return $! FoldM step (return x) 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 (x,_,_) = x
+
+------------------------------------------------------------------------------
+
+{-| A (possibly stateful) transformation on the inputs of a 'Fold'.
+
+    Functions constructed with combinators like 'L.premap' or 'L.handles' from
+    "Control.Foldl" also typecheck as a 'Transduction'.
+-}
+type Transduction a b = forall x. Fold b x -> Fold a x
+
+{-| A more general from of 'Transduction' that adds new information to the
+    return value of the 'Fold'.
+
+-}
+type Transduction' a b r = forall x. Fold b x -> Fold a (r,x)
+
+{-| Helper for storing a 'Transduction'' safely on a container.		
+
+-}
+newtype ReifiedTransduction' a b r = ReifiedTransduction' { getTransduction' :: Transduction' a b r }
+
+{-| Convenience constructor, often useful with pure functions like 'id'.		
+
+-}
+reify :: Transduction a b -> ReifiedTransduction' a b ()
+reify t = reify' (fmap (fmap ((,) ())) t)  
+
+reify' :: Transduction' a b r -> ReifiedTransduction' a b r
+reify' = ReifiedTransduction' 
+
+{-| A stateful process that transforms a stream of inputs into a stream of
+    outputs, and may optionally demarcate groups in the stream of outputs.
+
+    Composed of a step function, an initial state, and a extraction function. 
+
+    The step function returns a triplet of:
+
+    * The new internal state.
+    * List of outputs belonging to the last segment detected in the previous step.
+    * A list of lists of outputs belonging to segments detected in the current
+      step. If the list is empty, that means no splitting has taken place in the
+      current step. 'Transducer's that do not perform grouping never return anything
+      other than @[]@ here. In effect, they treat the whole stream as a single group.
+
+    The extraction function returns the 'Transducer's own result value, along with any
+    pending output.
+-}
+data Transducer i o r
+     = forall x. Transducer (x -> i -> (x,[o],[[o]])) x (x -> (r,[o],[[o]]))
+
+instance Comonad (Transducer i o) where
+    extract (Transducer _ begin done) = fst3 (done begin)
+    {-# INLINABLE extract #-}
+
+    duplicate (Transducer step begin done) = Transducer step begin (\x -> (Transducer step x done,[],[]))
+    {-# INLINABLE duplicate #-}
+
+instance Extend (Transducer i o) where
+    duplicated f = duplicate f
+    {-# INLINABLE duplicated #-}
+
+instance Functor (Transducer i o) where
+    fmap f (Transducer step begin done) = 
+        Transducer 
+            step 
+            begin 
+            ((\(x,xs,xss) -> (f x,xs,xss)) . done)
+
+instance Bifunctor (Transducer i) where
+    first f (Transducer step begin done) =
+        Transducer 
+            (fmap (\(x,xs,xss) -> (x,map f xs, map (map f) xss)) . step) 
+            begin 
+            ((\(x,xs,xss) -> (x,map f xs, map (map f) xss)) . done) 
+    second f w = fmap f w
+
+{-| Helps converting monadic transducers (over 'Identity') into pure ones.		
+
+-}
+class ToTransducer t where
+    toTransducer :: t i o r -> Transducer i o r
+
+instance ToTransducer Transducer where
+    toTransducer = id
+
+instance ToTransducer (TransducerM Identity) where
+    toTransducer = _simplify
+
+class ToFold t where
+    toFold :: t i r -> Fold i r
+
+instance ToFold Fold where
+    toFold = id
+
+instance ToFold (FoldM Identity) where
+    toFold = L.simplify
+
+{-| Like 'Transduction', but works on monadic 'Fold's.		
+
+-}
+type TransductionM m a b = forall x. Monad m => FoldM m b x -> FoldM m a x
+
+{-| Like 'Transduction'', but works on monadic 'Fold's.		
+
+-}
+type TransductionM' m a b r = forall x. FoldM m b x -> FoldM m a (r,x)
+
+{-| Helper for storing a 'TransductionM'' safely on a container.		
+
+-}
+newtype ReifiedTransductionM' m a b r = ReifiedTransductionM' { getTransductionM' :: TransductionM' m a b r }
+
+{-| Monadic version of 'reify'.		
+
+-}
+reifyM :: Monad m => TransductionM m a b -> ReifiedTransductionM' m a b ()
+reifyM t = reifyM' (fmap (fmap ((,) ())) t)  
+
+{-| Monadic version of 'reifyM'.		
+
+-}
+reifyM' :: TransductionM' m a b r -> ReifiedTransductionM' m a b r
+reifyM' = ReifiedTransductionM' 
+
+{-| Like 'Transducer', but monadic.
+
+-}
+data TransducerM m i o r
+     = forall x. TransducerM (x -> i -> m (x,[o],[[o]])) (m x) (x -> m (r,[o],[[o]]))
+
+
+instance Monad m => Functor (TransducerM m i o) where
+    fmap f (TransducerM step begin done) = TransducerM step begin done'
+      where
+        done' x = do
+            (r,os,oss) <- done x
+            let r' = f r
+            return $! (r' `seq` (r',os,oss))
+
+instance (Functor m, Monad m) => Bifunctor (TransducerM m i) where
+    first f (TransducerM step begin done) =
+        TransducerM 
+        (fmap (fmap (\(x,xs,xss) -> (x,map f xs, map (map f) xss))) . step) 
+        begin 
+        (fmap (\(x,xs,xss) -> (x,map f xs, map (map f) xss)) . done) 
+    second f w = fmap f w
+
+instance Monad m => Extend (TransducerM m i o) where
+    duplicated (TransducerM step begin done) = 
+        TransducerM step begin (\x -> return $! (TransducerM step (return x) done,[],[]))
+    {-# INLINABLE duplicated #-}
+
+
+{-| Helps converting pure transducers into monadic ones.		
+
+-}
+class ToTransducerM m t where
+    toTransducerM :: t i o r -> TransducerM m i o r
+
+-- http://chrisdone.com/posts/haskell-constraint-trick
+instance (m ~ m') => ToTransducerM m (TransducerM m') where
+    toTransducerM = id
+
+instance Monad m => ToTransducerM m Transducer where
+    toTransducerM = _generalize
+
+class ToFoldM m t where
+    toFoldM :: t i r -> FoldM m i r
+
+instance (m ~ m') => ToFoldM m (FoldM m') where
+    toFoldM = id
+
+instance Monad m => ToFoldM m Fold where
+    toFoldM = L.generalize
+
+
+{-| Apply a 'Transducer' to a 'Fold', discarding the return value of the
+    'Transducer'.		
+
+>>> L.fold (transduce (Transducer (\_ i -> ((),[i],[])) () (\_ -> ((),[],[]))) L.list) [1..7]
+[1,2,3,4,5,6,7]
+-}
+transduce :: ToTransducer t => t i o () -> Transduction i o 
+transduce t = fmap snd . (transduce' t)
+
+{-| Generalized version of 'transduce' that preserves the return value of
+    the 'Transducer'.
+
+>>> L.fold (transduce' (Transducer (\_ i -> ((),[i],[])) () (\_ -> ('r',[],[]))) L.list) [1..7]
+('r',[1,2,3,4,5,6,7])
+-}
+transduce' :: ToTransducer t => t i o s -> Transduction' i o s
+transduce' (toTransducer -> Transducer wstep wstate wdone) (Fold fstep fstate fdone) =
+    Fold step (Pair wstate fstate) done 
+        where
+            step (Pair ws fs) i = 
+                let (ws',os,oss) = wstep ws i 
+                in
+                Pair ws' (foldl' fstep fs (os ++ mconcat oss))  
+            done (Pair ws fs) = 
+                let (wr,os,oss) = wdone ws
+                in 
+                (,) wr (fdone (foldl' fstep fs (os ++ mconcat oss)))
+
+
+{-| Like 'transduce', but works on monadic 'Fold's.		
+
+-}
+transduceM :: (Monad m, ToTransducerM m t)  => t i o () -> TransductionM m i o 
+transduceM t = fmap snd . (transduceM' t)
+
+{-| Like 'transduce'', but works on monadic 'Fold's.		
+
+-}
+transduceM' :: (Monad m, ToTransducerM m t)  => t i o s -> TransductionM' m i o s
+transduceM' (toTransducerM -> TransducerM wstep wstate wdone) (FoldM fstep fstate fdone) =
+    FoldM step (liftM2 Pair wstate fstate) done 
+        where
+            step (Pair ws fs) i = do
+                (ws',os,oss) <- wstep ws i
+                fs' <- foldlM fstep fs (os ++ mconcat oss)
+                return $! Pair ws' fs'
+            done (Pair ws fs) = do
+                (wr,os,oss) <- wdone ws
+                fr <- fdone =<< foldlM fstep fs (os ++ mconcat oss)
+                return $! (,) wr fr
+
+{-| Transduce with a Kleisli arrow that returns a list.		
+
+-}
+transduceK :: (Monad m) => (i -> m [o]) -> TransductionM m i o 
+transduceK k = transduceM (TransducerM step (return ()) (\_ -> return ((),[],[])))
+    where
+    step _ i = liftM (\os -> ((),os,[])) (k i)
+
+
+------------------------------------------------------------------------------
+
+{-| Ignore all the inputs coming into the fold.
+
+    Polymorphic in both inputs and outputs.		
+
+-}
+ignore :: Transducer a b ()
+ignore = 
+    Transducer step () done 
+    where
+        step _ _ = 
+            ((),[],[])
+        done = 
+            const ((),[],[])
+
+data SurroundState = PrefixAdded | PrefixPending
+
+{-| Adds a prefix and a suffix to the stream arriving into a 'Fold'.		
+
+>>> L.fold (transduce (surround "prefix" "suffix") L.list) "middle"
+"prefixmiddlesuffix"
+
+    Used as a splitter, it puts the prefix, the original stream and
+    the suffix in separate groups:
+
+>>> L.fold (groups (surround "prefix" "suffix") (surround "[" "]") L.list) "middle"
+"[prefix][middle][suffix]"
+
+-}
+surround :: (Traversable p, Traversable s) => p a -> s a -> Transducer a a ()
+surround (toList -> ps) (toList -> ss) = 
+    Transducer step PrefixPending done 
+    where
+        step PrefixPending a = 
+            (PrefixAdded, ps,[[a]])
+        step PrefixAdded a = 
+            (PrefixAdded, [a],[])
+        done PrefixPending = 
+            ((), ps, [[],ss])
+        done PrefixAdded = 
+            ((), [], [ss])
+
+{-| Like 'surround', but the prefix and suffix are obtained using a 'IO'
+    action.
+
+>>> L.foldM (transduceM (surroundIO (return "prefix") (return "suffix")) (L.generalize L.list)) "middle"
+"prefixmiddlesuffix"
+-}
+surroundIO :: (Traversable p, Traversable s, Functor m, MonadIO m) 
+           => m (p a) 
+           -> m (s a) 
+           -> TransducerM m a a ()
+surroundIO prefixa suffixa = 
+    TransducerM step (return PrefixPending) done 
+    where
+        step PrefixPending a = do
+            ps <- fmap toList prefixa
+            return (PrefixAdded, ps, [[a]])
+        step PrefixAdded a = 
+            return (PrefixAdded, [a], [])
+        done PrefixPending = do
+            ps <- fmap toList prefixa
+            ss <- fmap toList suffixa
+            return ((), ps, [[],ss])
+        done PrefixAdded = do
+            ss <- fmap toList suffixa
+            return ((), [], [ss])
+
+------------------------------------------------------------------------------
+
+{-| Generalize a 'Transducer' to a 'TransducerM'.		
+
+-}
+_generalize :: Monad m => Transducer i o s -> TransducerM m i o s
+_generalize (Transducer step begin done) = TransducerM step' begin' done'
+    where
+    step' x a = return (step x a)
+    begin'    = return  begin
+    done' x   = return (done x)
+
+{-| Simplify a pure 'TransducerM' to a 'Transducer'.		
+
+-}
+_simplify :: TransducerM Identity i o s -> Transducer i o s
+_simplify (TransducerM step begin done) = Transducer step' begin' done' 
+    where
+    step' x a = runIdentity (step x a)
+    begin'    = runIdentity  begin
+    done' x   = runIdentity (done x)
+
+
+{-| Transforms a 'Transducer' into a 'Fold' by forgetting about the data sent
+    downstream.		
+
+-}
+foldify :: Transducer i o s -> Fold i s
+foldify (Transducer step begin done) =
+    Fold (\x i -> fst3 (step x i)) begin (\x -> fst3 (done x))
+
+{-| Monadic version of 'foldify'.		
+
+-}
+foldifyM :: Functor m => TransducerM m i o s -> FoldM m i s
+foldifyM (TransducerM step begin done) =
+    FoldM (\x i -> fmap fst3 (step x i)) begin (\x -> fmap fst3 (done x))
+
+{-| Transforms a 'Fold' into a 'Transducer' that sends the return value of the
+    'Fold' downstream when upstream closes.		
+
+-}
+condense :: Fold a r -> Transducer a r r
+condense (Fold fstep fstate fdone) =
+    (Transducer wstep fstate wdone)
+    where
+        wstep = \fstate' i -> (fstep fstate' i,[],[])
+        wdone = \fstate' -> (\r -> (r,[r],[])) (fdone fstate')
+
+{-| Monadic version of 'condense'.		
+
+-}
+condenseM :: Applicative m => FoldM m a r -> TransducerM m a r r
+condenseM (FoldM fstep fstate fdone) = 
+    (TransducerM wstep fstate wdone)
+    where
+        wstep = \fstate' i -> fmap (\s -> (s,[],[])) (fstep fstate' i)
+        wdone = \fstate' -> fmap (\r -> (r,[r],[])) (fdone fstate')
+
+
+{-| Changes the base monad used by a 'TransducerM'.		
+
+-}
+hoistTransducer :: Monad m => (forall a. m a -> n a) -> TransducerM m i o s -> TransducerM n i o s 
+hoistTransducer g (TransducerM step begin done) = TransducerM (\s i -> g (step s i)) (g begin) (g . done)
+
+{-| Changes the base monad used by a 'FoldM'.		
+
+    Another name for 'Control.Foldl.hoists'.
+-}
+hoistFold :: Monad m => (forall a. m a -> n a) -> FoldM m i r -> FoldM n i r 
+hoistFold = Control.Foldl.hoists
+
+{-| Turn a 'FoldM' that fails abruptly into one that encodes the error into
+    its return value.
+
+    Can be useful when combining fallible 'FoldM's with non-fallible ones.
+
+>>> L.foldM (quiesce (FoldM (\_ _-> throwE ()) (return ()) (\_ -> throwE ()))) [1..7]
+Left ()
+-}
+quiesce :: Monad m => FoldM (ExceptT e m) a r -> FoldM m a (Either e r)
+quiesce (FoldM step initial done) = 
+    FoldM step' (runExceptT initial) done'
+    where
+    step' x i = do  
+        case x of
+            Left _ -> return x
+            Right notyetfail -> runExceptT (step notyetfail i)
+    done' x = do
+        case x of 
+            Left e -> return (Left e)
+            Right notyetfail -> do
+                result <- runExceptT (done notyetfail)
+                case result of 
+                    Left e -> return (Left e)
+                    Right r -> return (Right r)
+
+newtype Fallible m r i e = Fallible { 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 (FoldM step initial done)) k =
+    Fallible (FoldM step' (lift (runExceptT (withExceptT (getFallible . k) initial))) done')
+    where 
+        step' x i = ExceptT (case x of
+            Left ffold -> do
+                rx <- runExceptT (L.foldM (duplicated ffold) [i])
+                case rx of
+                    Left e' -> return (Left e') -- true failure
+                    Right ffold' -> return (Right (Left ffold'))
+            Right notyetfail -> do
+                 x' <- runExceptT (step notyetfail i)
+                 case x' of
+                     Left e -> do
+                         return (Right (Left ((getFallible . k) e)))
+                     Right x'' -> return (Right (Right x'')))
+        done' x = ExceptT (case x of
+            Left ffold -> do
+                rx <- runExceptT (L.foldM ffold [])
+                case rx of
+                    Left e' -> return (Left e') -- true failure
+                    Right r -> return (Right r)
+            Right notyetfail -> do
+                 x' <- runExceptT (done notyetfail)
+                 case x' of
+                     Left e -> do
+                         runExceptT (done' (Left (getFallible (k e))))
+                     Right x'' -> return (Right x''))
+
+instance (Functor m, Monad m) => Functor (Fallible m r i) where
+    fmap g (Fallible fallible) = 
+        Fallible (hoistFold (withExceptT g) fallible)
+
+
+{-| 'pure' creates a 'Fallible' that starts in a failed state.		
+
+-}
+instance (Functor m,Monad m) => Applicative (Fallible m r i) where
+    pure e = Fallible (FoldM (\_ _ -> throwE e) (throwE e) (\_ -> throwE e))
+
+    u <*> v = u >>= \f -> fmap f v
+
+instance (Functor m, Monad m) => Profunctor (Fallible m r) where
+    lmap f (Fallible fallible) = 
+        Fallible (L.premapM (return . f) fallible)
+
+    rmap g (Fallible fallible) = 
+        Fallible (hoistFold (withExceptT g) fallible)
+
+{-| Fail immediately when an input comes in the wrong branch.		
+
+-}
+instance (Functor m,Monad m,Monoid r) => Choice (Fallible m r) where
+    left' (Fallible fallible) = 
+        Fallible (liftA2 mappend (hoistFold (withExceptT Left) (L.handlesM _Left fallible)) (hoistFold (withExceptT Right) (L.handlesM _Right (trip $> mempty))))
+
+_Left :: Applicative f => (a -> f a) -> Either a b -> f (Either a b)
+_Left f e = case e of
+    Right b -> pure (Right b)
+    Left a -> fmap Left (f a)
+
+_Right :: Applicative f => (b -> f b) -> Either a b -> f (Either a b)
+_Right f e = case e of
+    Left b -> pure (Left b)
+    Right a -> fmap Right (f a)
+
+{-| '>>=' continues folding after an error using a 'Fallible' constructed from the error.		
+
+-}
+instance (Functor m,Monad m) => Monad (Fallible m r i) where
+    (>>=) = bindFallible
+    return = pure
+
+{-| The "do-nothing" fold.		
+
+-}
+unit :: Fold a ()
+unit = pure () 
+
+{-| A fold that fails if it receives any input at all. The received input is
+    used as the error.		
+
+-}
+trip :: Monad m => FoldM (ExceptT a m) a ()
+trip = FoldM (\_ x -> throwE x) (return ()) (\_ -> return mempty)
+
+------------------------------------------------------------------------------
+
+{-| An unending machine that eats @u@ values and returns 
+    'ReifiedTransduction''s whose result type is also @u@.
+
+-}
+newtype Moore a b u = Moore { getMoore :: Cofree ((->) u) (ReifiedTransduction' a b u) }
+
+{-| Monadic version of 'Moore'.		
+
+-}
+newtype MooreM m a b u = MooreM { getMooreM :: Cofree ((->) u) (ReifiedTransductionM' m a b u) }
+
+{-| Prepend the head of the first argument to the second argument.		
+
+-}
+moveHead :: (ToTransductions' h,ToTransductions' t) => h a b u -> t a b u -> Moore a b u 
+moveHead (toTransductions' -> Moore (theHead :< _)) (toTransductions' -> Moore theTail) = Moore (theHead :< const theTail)
+
+{-| Monadic version of 'moveHead'.		
+
+-}
+moveHeadM :: (Monad m, ToTransductionsM' m h, ToTransductionsM' m t) => h a b u -> t a b u -> MooreM m a b u 
+moveHeadM (toTransductionsM' -> MooreM (theHead :< _)) (toTransductionsM' -> MooreM theTail) = MooreM (theHead :< const theTail)
+
+{-| Helper for obtaining infinite sequences of 'Transduction''s from suitable
+    types (in order to avoid explicit conversions).		
+
+-}
+class ToTransductions' t where
+    toTransductions' :: t a b u -> Moore a b u
+
+instance ToTransductions' Moore where
+    toTransductions' = id
+
+instance ToTransductions' Transducer where
+    toTransductions' t = toTransductions' (reify' (transduce' t))
+
+instance ToTransductions' ReifiedTransduction' where
+    toTransductions' = Moore . coiter const
+
+{-| Monadic version of 'ToTransductions''.		
+
+-}
+class Monad m => ToTransductionsM' m t where
+    toTransductionsM' :: t a b u -> MooreM m a b u
+
+instance (m ~ m', Monad m') => ToTransductionsM' m (MooreM m') where
+    toTransductionsM' = id
+
+instance (m ~ m', Monad m') => ToTransductionsM' m (TransducerM m') where
+    toTransductionsM' t = toTransductionsM' (reifyM' (transduceM' t))
+
+instance Monad m => ToTransductionsM' m Transducer where
+    toTransductionsM' (toTransducerM -> t) = toTransductionsM' (reifyM' (transduceM' t))
+
+instance (m ~ m', Monad m') => ToTransductionsM' m (ReifiedTransductionM' m') where
+    toTransductionsM' = MooreM . coiter const
+
+{-| Processes each of the groups demarcated by a 'Transducer' using 
+    a 'Transduction' taken from an unending supply, 
+    returning a 'Transduction' what works over the undivided stream of inputs. 
+    
+    The return value of the 'Transducer' is discarded.
+
+>>> L.fold (groups (chunksOf 2) (surround "<" ">") L.list) "aabbccdd"
+"<aa><bb><cc><dd>"
+
+>>> :{ 
+    let transductions = Moore (C.unfold (\i ->
+          (reify (transduce (surround (show i) [])), \_ -> succ i)) 0)
+    in L.fold (groups (chunksOf 2) transductions L.list) "aabbccdd"
+    :}
+"0aa1bb2cc3dd"
+-}
+groups :: (ToTransducer s, ToTransductions' t) 
+       => s a b () -- ^ 'Transducer' working as a splitter.
+       -> t b c () -- ^ infinite list of transductions
+       -> Transduction a c 
+groups splitter transductions oldfold = 
+        fmap snd (groups' splitter transductions unit oldfold)
+
+{-| Use a different 'Transduction' for the first detected group.		
+
+>>> :{ 
+    let drop n = bisect (splitAt n) ignore (reify id)
+    in L.fold (drop 2 L.list) "aabbccdd"
+    :}
+"bbccdd"
+-}
+bisect :: (ToTransducer s, ToTransductions' h, ToTransductions' t)
+       => s a b () -- ^ 'Transducer' working as a splitter.
+       -> h b c () -- ^ Machine to process the first group
+       -> t b c () -- ^ Machine to process the second and subsequent groups
+       -> Transduction a c
+bisect sp t1 t2 = groups sp (moveHead t1 t2)
+
+data StrictSum a b = Left' !a | Right' !b
+
+{-| Generalized version of 'groups' that preserves the return value of the
+    'Transducer'.
+
+    A summary value for each group is also calculated. These values are 
+    aggregated for the whole stream, with the help of an auxiliary 'Fold'.
+
+
+>>> :{ 
+    let transductions = 
+          reify' (\f -> transduce (surround "<" ">") ((,) <$> L.list <*> f))
+    in L.fold (groups' (chunksOf 2) transductions L.list L.list) "aabbccdd"
+    :}
+(((),["<aa>","<bb>","<cc>","<dd>"]),"<aa><bb><cc><dd>")
+-}
+groups' :: (ToTransducer s, ToTransductions' t, ToFold f)
+        => s a b r -- ^ 'Transducer' working as a splitter. 
+        -> t b c u -- ^ machine that eats @u@ values and spits transductions
+        -> f     u v -- ^ auxiliary 'Fold' that aggregates the @u@ values produced for each group
+        -> Transduction' a c (r,v) 
+groups' (toTransducer -> Transducer sstep sbegin sdone) 
+        (toTransductions' -> Moore (rt0 :< somemachine)) 
+        (toFold -> Fold astep abegin adone) 
+        somefold 
+        =
+    Fold step (Quartet sbegin somemachine abegin (Left' (rt0,somefold))) done 
+    where 
+        step (Quartet sstate machine astate innerfold) i =
+           let (sstate',oldSplit,newSplits) = sstep sstate i
+           in
+           case (oldSplit,newSplits) of
+                ([],[]) -> 
+                    Quartet sstate' machine astate innerfold -- pass innerfold untouched
+                _ -> 
+                    let actualinnerfold = case innerfold of
+                            Left' (ReifiedTransduction' t0,pristine) -> t0 (duplicated pristine)
+                            Right' touched -> touched
+                        (machine',astate',innerfold') = 
+                           foldl' 
+                           step'
+                           (machine,astate,feed actualinnerfold oldSplit) 
+                           newSplits
+                    in
+                    Quartet sstate' machine' astate' (Right' innerfold')
+        
+        done (Quartet sstate machine astate innerfold) = 
+            let (s,oldSplit,newSplits) = sdone sstate
+            in
+            case (oldSplit,newSplits,innerfold) of
+                ([],[],Left' (_,pristine)) -> 
+                    ((s,adone astate), extract pristine)
+                _ ->     
+                    let actualinnerfold = case innerfold of
+                            Left' (ReifiedTransduction' t0,pristine) -> t0 (duplicated pristine)
+                            Right' touched -> touched
+                        (_,astate',innerfold') = 
+                           foldl' 
+                           step'
+                           (machine,astate,feed actualinnerfold oldSplit) 
+                           newSplits
+                        (u,finalfold) = extract innerfold'
+                    in  
+                    ((s,adone (astep astate' u)),extract finalfold)
+
+        step' (machine_,astate,innerfold_) somesplit = 
+           let (u,resetted,nextmachine) = reset machine_ innerfold_
+           in  (nextmachine,astep astate u,feed resetted somesplit)
+
+        feed = L.fold . duplicated
+
+        reset machine (Fold _ fstate fdone) = 
+            let (u,nextfold) = fdone fstate
+                ReifiedTransduction' t1 :< nextmachine = machine u
+            in  (u,t1 (duplicated nextfold),nextmachine)
+
+{-| Monadic version of 'groups'.		
+
+-}
+groupsM :: (Monad m, ToTransducerM m s, ToTransductionsM' m t)
+               => s a b () -- ^
+               -> t b c ()
+               -> TransductionM m a c
+groupsM splitter transductions oldfold = 
+        fmap snd (groupsM' splitter transductions unit oldfold)
+
+
+{-| Monadic version of 'bisect'.		
+
+-}
+bisectM :: (Monad m, ToTransducerM m s, ToTransductionsM' m h, ToTransductionsM' m t)
+               => s a b () -- ^
+               -> h b c ()
+               -> t b c ()
+               -> TransductionM m a c
+bisectM s t1 t2 = groupsM s (moveHeadM t1 t2)
+
+{-| Monadic version of 'groups''.		
+
+-}
+groupsM' :: (Monad m, ToTransducerM m s, ToTransductionsM' m t, ToFoldM m f) 
+         => s a b r 
+         -> t b c u -- ^ 
+         -> f     u v 
+         -> TransductionM' m a c (r,v) 
+groupsM' (toTransducerM -> TransducerM sstep sbegin sdone) 
+         (toTransductionsM' -> MooreM (rt0 :< somemachine)) 
+         (toFoldM -> FoldM astep abegin adone) 
+         somefold 
+         =
+    FoldM step 
+          (do sbegin' <- sbegin
+              abegin' <- abegin
+              return (Quartet sbegin' somemachine abegin' (Left' (rt0,somefold))))
+          done        
+    where
+        step (Quartet sstate machine astate innerfold) i = do
+            (sstate',oldSplit, newSplits) <- sstep sstate i 
+            case (oldSplit,newSplits) of 
+                ([],[]) -> 
+                    return $! Quartet sstate' machine astate innerfold -- pass innerfold untouched
+                _       -> do
+                    let actualinnerfold = case innerfold of
+                            Left' (ReifiedTransductionM' t0,pristine) -> t0 (duplicated pristine)
+                            Right' touched -> touched
+                    innerfold' <- feed actualinnerfold oldSplit
+                    (machine',astate',innerfold'') <- foldlM step' (machine,astate,innerfold') newSplits
+                    return $! Quartet sstate' machine' astate' (Right' innerfold'')
+
+        done (Quartet sstate machine astate innerfold) = do
+            (s,oldSplit,newSplits) <- sdone sstate
+            case (oldSplit,newSplits,innerfold) of 
+              ([],[],Left' (_,pristine)) -> do
+                  a <- adone astate
+                  p <- L.foldM pristine []
+                  return ((s,a),p)
+              _ -> do
+                  let actualinnerfold = case innerfold of
+                          Left' (ReifiedTransductionM' t0,pristine) -> t0 (duplicated pristine)
+                          Right' touched -> touched
+                  innerfold' <- feed actualinnerfold oldSplit
+                  (_,astate',innerfold'') <- foldlM step' (machine,astate,innerfold') newSplits
+                  (u,finalfold) <- L.foldM innerfold'' []
+                  v <- adone =<< astep astate' u
+                  r <- L.foldM finalfold []
+                  return ((s,v),r)
+
+        step' (machine,astate,innerfold) is = do
+            (u,innerfold',machine') <- reset machine innerfold 
+            astate' <- astep astate u
+            innerfold'' <- feed innerfold' is
+            return $! (machine',astate',innerfold'') 
+
+        feed = L.foldM . duplicated
+
+        reset machine (FoldM _ fstate fdone) = do
+           (u,nextfold) <- fdone =<< fstate 
+           let 
+               ReifiedTransductionM' t1 :< nextmachine = machine u
+           return (u,t1 (duplicated nextfold),nextmachine)
+
+{-| Summarizes each of the groups demarcated by the 'Transducer' using a
+    'Fold'. 
+    
+    The result value of the 'Transducer' is discarded.
+
+>>> L.fold (folds (chunksOf 3) L.sum L.list) [1..7]
+[6,15,7]
+-}
+folds :: (ToTransducer t, ToFold f) 
+      => t a b () -- ^ 'Transducer' working as a splitter.
+      -> f b c 
+      -> Transduction a c
+folds splitter (toFold -> f) = groups splitter (fmap (const ()) (condense f))
+
+{-| Like 'folds', but preserves the return value of the 'Transducer'.
+
+>>> L.fold (folds' (chunksOf 3) L.sum L.list) [1..7]
+((),[6,15,7])
+-}
+folds' :: (ToTransducer t, ToFold f) 
+       => t a b s -- ^ 'Transducer' working as a splitter.
+       -> f b c 
+       -> Transduction' a c s
+folds' splitter (toFold -> innerfold) somefold = 
+    fmap (bimap fst id) (groups' splitter innertrans unit somefold)
+    where
+    innertrans = reify' $ \x -> fmap ((,) () . snd) (transduce' (condense innerfold) x)
+
+{-| Monadic version of 'folds'.		
+
+-}
+foldsM :: (Applicative m, Monad m, ToTransducerM m t, ToFoldM m f) 
+       => t a b () -- ^
+       -> f b c 
+       -> TransductionM m a c
+foldsM splitter (toFoldM -> f) = groupsM splitter (fmap (const ()) (condenseM f))
+
+{-| Monadic version of 'folds''.		
+
+-}
+foldsM' :: (Applicative m,Monad m, ToTransducerM m t, ToFoldM m f) 
+        => t a b s -- ^
+        -> f b c 
+        -> TransductionM' m a c s
+foldsM' splitter (toFoldM -> innerfold) somefold = 
+    fmap (bimap fst id) (groupsM' splitter innertrans unit somefold)
+    where
+    innertrans = reifyM' $ \x -> fmap ((,) () . snd) (transduceM' (condenseM innerfold) x)
+
+------------------------------------------------------------------------------
+
+{-| Splits a stream into chunks of fixed size.		
+
+>>> L.fold (folds (chunksOf 2) L.list L.list) [1..7]
+[[1,2],[3,4],[5,6],[7]]
+
+>>> L.fold (groups (chunksOf 2) (surround [] [0]) L.list) [1..7]
+[1,2,0,3,4,0,5,6,0,7,0]
+-}
+chunksOf :: Int -> Transducer a a ()
+chunksOf 0 = Transducer (\_ _ -> ((),[],repeat [])) () (error "never happens")
+chunksOf groupSize = Transducer step groupSize done 
+    where
+        step 0 a = (pred groupSize, [], [[a]])
+        step i a = (pred i, [a], [])
+        done _ = ((),[],[])
+
+{-| Splits the stream at a given position.		
+
+>>> L.fold (bisect (splitAt 2) ignore (reify id) L.list) [1..5]
+[3,4,5]
+
+-}
+splitAt :: Int -> Transducer a a ()
+splitAt howmany = 
+    Transducer step (Just howmany) done 
+    where
+        step Nothing i =
+            (Nothing,[i],[])
+        step (Just howmanypending) i 
+            | howmanypending == 0 = 
+                (Nothing,[],[[i]])
+            | otherwise = 
+                (Just (pred howmanypending),[i],[]) 
+        done = mempty
+
+{-| Similar to `splitAt`, but works with streams of "chunked" data like
+    bytestrings, texts, vectors, lists of lists...		
+
+>>> L.fold (bisect (chunkedSplitAt 7) ignore (reify id) L.list) [[1..5],[6..9]]
+[[8,9]]
+
+-}
+chunkedSplitAt :: SFM.StableFactorialMonoid m => Int -> Transducer m m ()
+chunkedSplitAt howmany = 
+    Transducer step (Just howmany) done
+    where
+        step Nothing m =
+            (Nothing,[m],[])
+        step (Just howmanypending) m
+            | NM.null m = 
+                (Just howmanypending,[],[])
+            | howmanypending == 0 = 
+                (Nothing,[],[[m]])
+            | howmanypending >= SFM.length m =
+                (Just (howmanypending - SFM.length m),[m],[])
+            | otherwise =
+                let (prefix,suffix) = SFM.splitAt howmanypending m
+                in
+                (Nothing,[prefix],[[suffix]])
+        done = mempty
+
+data SplitState = 
+      PreviousSeparator
+    | PreviousNonSeparator
+
+{-| 		
+
+>>> L.fold (folds (split (==2)) L.list L.list) [1,2,2,1,1,2,1]
+[[1],[],[1,1],[1]]
+
+>>> L.fold (folds (split (==2)) L.list L.list) [2,1,1,2]
+[[],[1,1],[]]
+
+-}
+split :: (a -> Bool) -> Transducer a a ()
+split predicate = 
+    Transducer step PreviousNonSeparator done 
+    where
+        step PreviousNonSeparator i = 
+            if predicate i 
+               then (PreviousSeparator,[],[])
+               else (PreviousNonSeparator,[i],[])
+        step PreviousSeparator i = 
+            if predicate i 
+               then (PreviousSeparator,[],[[]])
+               else (PreviousNonSeparator,[],[[i]])
+        done PreviousNonSeparator = mempty
+        done PreviousSeparator = ((),[],[[]])
+
+
+data BreakWhenState = 
+      BreakConditionEncountered 
+    | BreakConditionPending
+
+{-| 		
+
+>>> L.fold (bisect (break (>3)) (reify id) ignore L.list) [1..5]
+[1,2,3]
+
+-}
+break :: (a -> Bool) -> Transducer a a ()
+break predicate = 
+    Transducer step BreakConditionPending done 
+    where
+        step BreakConditionPending i = 
+            if predicate i 
+               then (BreakConditionEncountered,[],[[i]])
+               else (BreakConditionPending,[i],[])
+        step BreakConditionEncountered i = 
+               (BreakConditionEncountered,[i],[])
+        done = mempty
+
+{-| Puts the last element of the input stream (if it exists) in a separate
+    group.
+
+>>> L.fold (bisect (void splitLast) (reify id) ignore L.list) [1..5]
+[1,2,3,4]
+-}
+splitLast :: Transducer a a (Maybe a)
+splitLast =
+    Transducer step Nothing done
+    where
+        step Nothing i = 
+            (Just i,[],[])
+        step (Just oldi) i = 
+            (Just i,[oldi],[])
+        done Nothing = 
+            (Nothing,[],[])
+        done (Just lasti) = (Just lasti, [], [[lasti]])
+
+{-| Strip a prefix from a stream of "chunked" data, like packed text.		
+
+    If the prefix doesn't match, fail with the unmatched part of the prefix and
+    the input that caused the error.
+
+>>> runExceptT $ L.foldM (transduceM (chunkedStripPrefix [[1..2],[3..4]]) (L.generalize L.list)) [[1..5],[6..9]]
+Right [[5],[6,7,8,9]]
+
+>>> runExceptT $ L.foldM (transduceM (chunkedStripPrefix [[1..2],[3,77,99]]) (L.generalize L.list)) [[1..5],[6..9]]
+Left ([[77,99]],Just [4,5])
+-}
+chunkedStripPrefix :: (CM.LeftGCDMonoid i,SFM.StableFactorialMonoid i,Traversable t,Monad m) 
+                   => t i -- ^
+                   -> TransducerM (ExceptT ([i],Maybe i) m) i i ()
+chunkedStripPrefix (filter (not . NM.null) . toList -> chunks) = 
+    TransducerM step (return chunks) done
+    where
+        step []     i = 
+            return ([],[i],[])
+        step (x:xs) i = 
+            let (prefix',i',x') = CM.stripCommonPrefix i x 
+            in 
+            if NM.null prefix'
+                then throwE (x:xs,Just i)
+                else 
+                    if NM.null x' 
+                       then step xs i'
+                       else step (x':xs) i'
+        done [] = 
+            return mempty
+        done (x:xs) = 
+            throwE (x:xs, Nothing) 
+
+------------------------------------------------------------------------------
+
+{- $reexports
+
+-}
diff --git a/src/Control/Foldl/Transduce/ByteString.hs b/src/Control/Foldl/Transduce/ByteString.hs
--- a/src/Control/Foldl/Transduce/ByteString.hs
+++ b/src/Control/Foldl/Transduce/ByteString.hs
@@ -1,88 +1,88 @@
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
--- |
---
--- Pour handles into folds,
--- write to handles using folds. 
-module Control.Foldl.Transduce.ByteString (
-        -- * Reading from handles
-        drainHandle
-    ,   ChunkSize
-    ,   chunkSize
-    ,   chunkSizeDefault
-        -- * Writing to handles
-    ,   toHandle
-    ,   toHandleBuilder  
-    ) where
-
-import qualified Control.Foldl as L
-import Control.Foldl.Transduce 
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Builder as B
-import Control.Monad.IO.Class
-import System.IO
-import Data.ByteString.Lazy.Internal (defaultChunkSize)
-
-{-| Feed a fold with bytes read from a 'Handle'.
-
--}
-drainHandle 
-    :: (MonadIO m,ToFoldM m f) 
-    => f B.ByteString r 
-    -> ChunkSize 
-    -> Handle 
-    -> m r 
-drainHandle f (ChunkSize csize) h = driveHandle f csize h
-
-{-| Maximum chunk size		
-
--}
-newtype ChunkSize = ChunkSize Int deriving (Show,Eq,Ord,Num)
-
-chunkSize :: Int -> ChunkSize
-chunkSize = ChunkSize
-
-chunkSizeDefault :: ChunkSize
-chunkSizeDefault = chunkSize defaultChunkSize
-
-driveHandle :: (MonadIO m,ToFoldM m f) 
-            => f B.ByteString r 
-            -> Int -- ^ max chunk size
-            -> Handle 
-            -> m r 
-driveHandle (toFoldM -> f) chunkSize handle = 
-    L.impurely consumeFunc f (B.hGetSome handle chunkSize,hIsEOF handle)
-    where
-        -- adapted from foldM in Pipes.Prelude
-        consumeFunc step begin done (readChunk,checkEOF) = do
-            x0 <- begin
-            loop x0
-              where
-                loop x = do
-                    atEOF <- liftIO checkEOF
-                    if atEOF 
-                       then done x 
-                       else do
-                           chunk <- liftIO readChunk
-                           x' <- step x chunk
-                           loop $! x'
-
-
-toHandle :: (MonadIO m) => Handle -> L.FoldM m B.ByteString ()
-toHandle handle = 
-    L.FoldM 
-    (\_ b -> liftIO (B.hPut handle b))  
-    (return ()) 
-    (\_ -> return ())
-
-
-toHandleBuilder :: (MonadIO m) => Handle -> L.FoldM m B.Builder ()
-toHandleBuilder handle = 
-    L.FoldM
-    (\_ b -> liftIO (B.hPutBuilder handle b)) 
-    (return ()) 
-    (\_ -> return ())
-
-
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+-- |
+--
+-- Pour handles into folds,
+-- write to handles using folds. 
+module Control.Foldl.Transduce.ByteString (
+        -- * Reading from handles
+        drainHandle
+    ,   ChunkSize
+    ,   chunkSize
+    ,   chunkSizeDefault
+        -- * Writing to handles
+    ,   toHandle
+    ,   toHandleBuilder  
+    ) where
+
+import qualified Control.Foldl as L
+import Control.Foldl.Transduce 
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Builder as B
+import Control.Monad.IO.Class
+import System.IO
+import Data.ByteString.Lazy.Internal (defaultChunkSize)
+
+{-| Feed a fold with bytes read from a 'Handle'.
+
+-}
+drainHandle 
+    :: (MonadIO m,ToFoldM m f) 
+    => f B.ByteString r 
+    -> ChunkSize 
+    -> Handle 
+    -> m r 
+drainHandle f (ChunkSize csize) h = driveHandle f csize h
+
+{-| Maximum chunk size		
+
+-}
+newtype ChunkSize = ChunkSize Int deriving (Show,Eq,Ord,Num)
+
+chunkSize :: Int -> ChunkSize
+chunkSize = ChunkSize
+
+chunkSizeDefault :: ChunkSize
+chunkSizeDefault = chunkSize defaultChunkSize
+
+driveHandle :: (MonadIO m,ToFoldM m f) 
+            => f B.ByteString r 
+            -> Int -- ^ max chunk size
+            -> Handle 
+            -> m r 
+driveHandle (toFoldM -> f) chunkSize handle = 
+    L.impurely consumeFunc f (B.hGetSome handle chunkSize,hIsEOF handle)
+    where
+        -- adapted from foldM in Pipes.Prelude
+        consumeFunc step begin done (readChunk,checkEOF) = do
+            x0 <- begin
+            loop x0
+              where
+                loop x = do
+                    atEOF <- liftIO checkEOF
+                    if atEOF 
+                       then done x 
+                       else do
+                           chunk <- liftIO readChunk
+                           x' <- step x chunk
+                           loop $! x'
+
+
+toHandle :: (MonadIO m) => Handle -> L.FoldM m B.ByteString ()
+toHandle handle = 
+    L.FoldM 
+    (\_ b -> liftIO (B.hPut handle b))  
+    (return ()) 
+    (\_ -> return ())
+
+
+toHandleBuilder :: (MonadIO m) => Handle -> L.FoldM m B.Builder ()
+toHandleBuilder handle = 
+    L.FoldM
+    (\_ b -> liftIO (B.hPutBuilder handle b)) 
+    (return ()) 
+    (\_ -> return ())
+
+
diff --git a/src/Control/Foldl/Transduce/Text.hs b/src/Control/Foldl/Transduce/Text.hs
--- a/src/Control/Foldl/Transduce/Text.hs
+++ b/src/Control/Foldl/Transduce/Text.hs
@@ -1,536 +1,536 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ViewPatterns #-}
-
--- |
---
--- This module builds on module "Control.Foldl.Text", adding stateful
--- transducers and grouping operations.
-module Control.Foldl.Transduce.Text (
-        -- * Decoding transducers
-        decoder
-    ,   utf8
-    ,   utf8lenient 
-    ,   utf8strict
-    ,   decoderE
-    ,   utf8E
-        -- * Other transducers
-    ,   newline
-    ,   stripStart
-    ,   stripEnd
-        -- * Splitters
-    ,   words
-    ,   lines
-    ,   paragraphs
-    ,   sections
-        -- * Textual
-        -- $textual
-    ,   textualSplit
-    ,   textualBreak
-    ) where
-
-import Prelude hiding (lines,words)
-import Data.Char
-import Data.Bool
-import Data.Maybe
-import Data.List (unfoldr)
-import Data.Monoid (mempty,(<>))
-import Data.Foldable (foldMap,foldl')
-import qualified Data.ByteString as B
-import qualified Data.Text 
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
-import qualified Data.Text.Encoding.Error as T
-import qualified Data.Monoid.Textual as MT
-import qualified Data.Monoid.Null as MN
-import Control.Applicative
-import Control.Monad.Trans.Except
-import Control.Monad.IO.Class
-import Control.Exception.Base 
-import qualified Control.Foldl.Transduce as L
-import qualified Data.List
-import Data.List.NonEmpty (NonEmpty(..))
-import qualified Data.List.NonEmpty as NonEmpty
-
-{- $setup
-
->>> :set -XFlexibleContexts
->>> import Data.String hiding (lines,words)
->>> import Data.Text (Text)
->>> import Control.Applicative
->>> import Control.Monad.Trans.Except
->>> import qualified Control.Foldl as L
->>> import Control.Foldl.Transduce
-
--}
-
-data Pair a b = Pair !a !b
-
-{-| Builds a decoding 'Transducer' out of a stream-oriented decoding function
-    from "Data.Text.Encoding" and an error handler from
-    "Data.Text.Encoding.Error".        
-
--}
-decoder :: (B.ByteString -> T.Decoding) -> T.OnDecodeError -> L.Transducer B.ByteString T.Text ()
-decoder _step onLeftovers = L.Transducer step (Pair mempty _step) done
-    where
-    step (Pair _ next) i = 
-        let 
-            T.Some txt leftovers next' = next i 
-        in
-        (Pair leftovers next',[txt],[])
-    done (Pair leftovers _) = 
-        if B.null leftovers
-            then ((), [], [])
-            else ((), foldMap (pure . T.singleton) onLeftovers',[])
-    onLeftovers' = onLeftovers "leftovers" Nothing
-
-{-| Builds a UTF8-decoding 'Transducer'. Takes an error handler from
-    "Data.Text.Encoding.Error".        
-
--}
-utf8 :: T.OnDecodeError -> L.Transducer B.ByteString T.Text ()
-utf8 onDecodeError = 
-    decoder (T.streamDecodeUtf8With onDecodeError)  onDecodeError
-
-{-| UTF8-decoding 'Transducer' that replaces invalid input bytes with the
-    Unicode replacement character U+FFFD.
-
->>> L.fold (transduce utf8lenient L.list) (map fromString ["decode","this"])
-["decode","this"]
-
->>> L.fold (transduce utf8lenient L.list) (map fromString ["across \xe2","\x98\x83 boundaries"])
-["across ","\9731 boundaries"]
-
->>> L.fold (transduce utf8lenient L.list) (map fromString ["invalid \xc3\x28 sequence"])
-["invalid \65533( sequence"]
-
->>> L.fold (transduce utf8lenient L.list) (map fromString ["incomplete \xe2"])
-["incomplete ","\65533"]
--}
-utf8lenient :: L.Transducer B.ByteString T.Text ()
-utf8lenient = utf8 T.lenientDecode
-
-{-| __/BEWARE!/__ 
-    This 'Transducer' may throw 'UnicodeException'.
-    __/BEWARE!/__ 
-
->>> L.fold (transduce utf8strict L.list) (map fromString ["invalid \xc3\x28 sequence"])
-*** Exception: Cannot decode byte '\xc3': Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream
-
->>> L.fold (transduce utf8strict L.list) (map fromString ["incomplete \xe2"])
-*** Exception: Cannot decode input: leftovers
--}
-utf8strict :: L.Transducer B.ByteString T.Text ()
-utf8strict = utf8 T.strictDecode
-
-{-| Similar to 'decoder', but catches 'UnicodeException' in 'IO' and uses
-    'Control.Monad.Trans.Except' to communicate the error.        
-
--}
-decoderE :: MonadIO m
-         => (T.OnDecodeError -> B.ByteString -> T.Decoding)
-         -> L.TransducerM (ExceptT T.UnicodeException m) B.ByteString T.Text ()   
-decoderE next = L.TransducerM step (return (Pair mempty next')) done
-    where
-        step (Pair _ next1) i = do
-            emc <- liftIO . try . evaluate $ next1 i 
-            case emc of 
-                Left ue -> do
-                    throwE ue
-                Right (T.Some txt leftovers next2) -> do
-                    return (Pair leftovers next2,[txt],[])
-        done (Pair leftovers _) = do
-            if B.null leftovers
-                then return ((), [], [])
-                else do
-                    emc <- liftIO . try . evaluate $ onLeftovers'
-                    case emc of
-                        Left ue -> do
-                            throwE ue
-                        Right mc -> do
-                            return ((), foldMap (return . T.singleton) mc,[])
-        next' = next T.strictDecode  
-        onLeftovers' = T.strictDecode "leftovers" Nothing
-
-{-| Like 'utf8strict', but catches 'UnicodeException' in 'IO' and uses
-    'Control.Monad.Trans.Except' to communicate the error.        
-
->>> runExceptT $ L.foldM (transduceM utf8E (L.generalize L.list)) (map fromString ["invalid \xc3\x28 sequence"])
-Left Cannot decode byte '\xc3': Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream
-
->>> runExceptT $ L.foldM (transduceM utf8E (L.generalize L.list)) (map fromString ["incomplete \xe2"])
-Left Cannot decode input: leftovers
--}
-utf8E :: MonadIO m => L.TransducerM (ExceptT T.UnicodeException m) B.ByteString T.Text ()   
-utf8E = decoderE T.streamDecodeUtf8With
-
-{-| Appends a newline at the end of the stream.        
-
->>> L.fold (transduce newline L.list) (map T.pack ["without","newline"])
-["without","newline","\n"]
--}
-newline :: L.Transducer T.Text T.Text ()
-newline = L.surround [] ["\n"]
-
-blank :: T.Text -> Bool
-blank = Data.Text.all isSpace
-
-{-| Remove leading white space from a stream of 'Text'.        
-
->>> L.fold (transduce stripStart L.list) (map T.pack ["   ","", "   text "])
-["text "]
--}
-stripStart :: L.Transducer T.Text T.Text ()
-stripStart = L.Transducer step False done
-    where
-        step True i = (True, [i],[])
-        step False i =
-            if blank i 
-                then (False,[],[])
-                else (True, [T.stripStart i],[])
-        done _  = ((),[],[])
-
-{-| Remove trailing white space from a stream of 'Text'.        
-
-    __/BEWARE!/__ 
-    This function naively accumulates in memory any arriving "blank blocks" of
-    text until a non-blank block or end-of-stream arrives, and therefore it is
-    potentially dangerous. Do not use with untrusted inputs.
-
->>> L.fold (transduce stripEnd L.list) (map T.pack [" ", " \n  text ", "   ", "" , " "])
-[" "," \n  text"]
--}
-stripEnd :: L.Transducer T.Text T.Text ()
-stripEnd = L.Transducer step [] done
-    where
-        step txts i =
-            if blank i
-                -- dangerous!
-                then (i:txts, [], [])
-                else ([i], reverse txts, [])
-        done txts = case reverse txts of
-            txt : _ -> ((), [T.stripEnd txt], [])
-            _ -> ((), [], [])
-
-{-| Splits a stream of text into lines, removing the newlines.
-
->>> L.fold (L.groups lines (surround [T.pack "x"] []) L.list) (map T.pack ["line 1\n line 2\n"])
-["x","line 1","x"," line 2"]
-
->>> L.fold (L.groups lines newline L.list) (map T.pack ["line 1\n line 2\n"])
-["line 1","\n"," line 2","\n"]
-
-    Used with 'L.transduce', it simply removes newlines:
-
->>> L.fold (L.transduce lines L.list) (map T.pack ["line 1\n line 2\n"])
-["line 1"," line 2"]
--}
-lines :: L.Transducer T.Text T.Text ()
-lines = L.Transducer step False done 
-    where
-        step previousnl txt =
-            if Data.Text.null txt
-               then  
-                   (previousnl,[],[])
-               else
-                   let
-                       lastc = Data.Text.last txt == '\n'
-                       txts = T.lines txt
-                   in
-                   case (previousnl,txts) of
-                       (_,[]) -> error "never happens"
-                       (True,_) -> (lastc, [], map pure txts)
-                       (False,t:ts) -> (lastc, [t], map pure ts)
-
-        done _ = ((),[],[])
-
-
-data WordsState = 
-      NoLastChar
-    | LastCharSpace
-    | LastCharNotSpace
-
-{-| Splits a stream of text into words, removing whitespace.
-
->>> L.fold (folds words L.list L.list) (map T.pack ["  a","aa ", "bb c","cc dd ","ee f","f"])
-[["a","aa"],["bb"],["c","cc"],["dd"],["ee"],["f","f"]]
-
-    Used with 'L.transduce', it simply removes all whitespace:
-
->>> L.fold (L.transduce words L.list) (map T.pack ["  a","aa ", "bb c","cc dd ","ee f","f"])
-["a","aa","bb","c","cc","dd","ee","f","f"]
--}
-words :: L.Transducer T.Text T.Text ()
-words = L.Transducer step NoLastChar done 
-    where
-        step tstate txt 
-            | Data.Text.null txt = (tstate,[],[])
-            | blank txt = 
-                case tstate of
-                    NoLastChar -> (NoLastChar,[],[])
-                    _ -> (LastCharSpace,[],[])
-            | otherwise =                    
-                let nextstate = 
-                        if isSpace (T.last txt) 
-                           then LastCharSpace 
-                           else LastCharNotSpace
-                    (oldgroup,newgroups) = case (tstate, T.words txt) of
-                        (NoLastChar,w:ws) -> 
-                            ([w],map pure ws)
-                        (LastCharSpace,ws) -> 
-                            ([],map pure ws)
-                        (LastCharNotSpace,w:ws) -> 
-                            if isSpace (T.head txt)
-                               then ([],map pure (w:ws))
-                               else ([w],map pure ws)
-                        (_,[]) -> error "never happens, txt not blank"
-                in (nextstate,oldgroup,newgroups)
-        done _ = ((),[],[])
-
-
-data ParagraphsState = 
-      SkippingAfterStreamStart
-    | SkippingAfterNewline
-    | SkippingAfterBlankLine
-    | ContinuingNonemptyLine
-
-{-| Splits a stream of text into paragraphs, removing empty lines and trimming
-    newspace from the start of each line.
-
->>> map mconcat (L.fold (folds paragraphs L.list L.list) (map T.pack [" \n aaa","\naa ", " \n\nbb\n"]))
-["aaa\naa  \n","bb\n"]
-
-    Used with 'L.transduce', it removes empty lines and trims newspace from the
-    start of each line.
--}
-paragraphs :: L.Transducer T.Text T.Text ()
-paragraphs = L.Transducer step SkippingAfterStreamStart done 
-    where
-        step tstate txt
-            | Data.Text.null txt = 
-                (tstate,[],[])
-            | otherwise = 
-                let (initlines,lastline) = splittedLines txt
-                    (tstate', outputsreversed) =
-                        advanceLast
-                        (foldl' 
-                            advance
-                            (tstate,pure [])
-                            initlines)
-                        lastline          
-                    (xs :| xss) = fmap reverse (NonEmpty.reverse outputsreversed)
-                in (tstate',xs,xss)
-        done _ = 
-            ((),[],[])
-        splittedLines :: T.Text -> ([T.Text],T.Text)
-        splittedLines nonEmptyChunk = 
-            let splitted = 
-                    Data.Text.lines nonEmptyChunk 
-                    ++
-                    if T.last nonEmptyChunk == '\n' then [mempty] else mempty
-            in (init splitted, last splitted) -- unsafe with empty lists!!!
-        advance 
-            :: (ParagraphsState, NonEmpty [T.Text]) 
-            -> T.Text 
-            -> (ParagraphsState, NonEmpty [T.Text])
-        advance (s,outputs) i = 
-            case (s, blank i) of
-                (SkippingAfterStreamStart, True) -> 
-                    (,) 
-                    SkippingAfterStreamStart 
-                    outputs
-                (SkippingAfterStreamStart, False) -> 
-                    (,)
-                    SkippingAfterNewline
-                    (continue ["\n",T.stripStart i] outputs) 
-                (SkippingAfterNewline, True) -> 
-                    (,) 
-                    SkippingAfterBlankLine 
-                    outputs 
-                (SkippingAfterNewline, False) -> 
-                    (,)
-                    SkippingAfterNewline
-                    (continue ["\n",T.stripStart i] outputs)
-                (SkippingAfterBlankLine, True) -> 
-                    (,) 
-                    SkippingAfterBlankLine 
-                    outputs 
-                (SkippingAfterBlankLine, False) -> 
-                    (,)
-                    SkippingAfterNewline
-                    (continue ["\n",T.stripStart i] (NonEmpty.cons [] outputs)) 
-                (ContinuingNonemptyLine, _) -> 
-                    (,)
-                    SkippingAfterNewline
-                    (continue ["\n",i] outputs)
-        advanceLast 
-                :: (ParagraphsState, NonEmpty [T.Text]) 
-                -> T.Text 
-                -> (ParagraphsState, NonEmpty [T.Text])
-        advanceLast (s,outputs) i = 
-            case (s, blank i) of
-                (SkippingAfterStreamStart, True) -> 
-                    (,) 
-                    SkippingAfterStreamStart 
-                    outputs
-                (SkippingAfterStreamStart, False) -> 
-                    (,)
-                    ContinuingNonemptyLine
-                    (continue [T.stripStart i] outputs)
-                (SkippingAfterNewline, True) -> 
-                    (,) 
-                    SkippingAfterNewline 
-                    outputs
-                (SkippingAfterNewline, False) -> 
-                    (,)
-                    ContinuingNonemptyLine
-                    (continue [T.stripStart i] outputs)
-                (SkippingAfterBlankLine, True) -> 
-                    (,)
-                    SkippingAfterBlankLine
-                    outputs 
-                (SkippingAfterBlankLine, False) -> 
-                    (,)
-                    ContinuingNonemptyLine
-                    (continue [T.stripStart i] (NonEmpty.cons [] outputs))
-                (ContinuingNonemptyLine, _) -> 
-                    (,)
-                    ContinuingNonemptyLine
-                    (continue [i] outputs)
-
-{-| 
-
-    Given a (possibly infinite) list of section headings, split the stream into
-    sections and remove the headings. 
-
->>> map mconcat (L.fold (folds (sections (map T.pack ["#1\n","#2\n"])) L.list L.list) (map T.pack [" #1\naa\n#","2\nbb"]))
-[" ","aa\n","bb"]
-
->>> map mconcat (L.fold (folds (sections (map T.pack ["1234"])) L.list L.list) (map T.pack [" 1","2","x","1","2","3","4","5"]))
-[" 12x","5"]
-
-    Used with 'L.transduce', it simply removes all headings.
--}
-sections :: [T.Text] -> L.Transducer T.Text T.Text ()
-sections seps = L.Transducer step (initialstate seps) done 
-    where
-        step tstate txt =
-            let (emitted,fmap snd -> states) = Data.List.unzip (unfoldWithState splitTextStep (txt,tstate))
-                finalState = NonEmpty.last (tstate :| states)
-                continuing :| following = NonEmpty.reverse (fmap Data.List.reverse (foldl' advance ([]:|[]) emitted))
-            in (finalState, continuing, following)                        
-        advance :: NonEmpty [x] -> ([x],Bool) -> NonEmpty [x]
-        advance l (e,b) = bool id (separate []) b (continue e l)
-        done Done = 
-            ((),[],[])
-        done (Pending acc _ _) =
-            ((),[acc],[])    
-        initialstate [] = Done
-        initialstate (x:xs) = Pending T.empty x xs
-
-
-continue :: [a] -> NonEmpty [a] -> NonEmpty [a]
-continue as (as':| rest) = (as ++ as') :| rest
-
-separate :: [x] -> NonEmpty [x] -> NonEmpty [x]
-separate = NonEmpty.cons
-
-data SectionsState = 
-      Done
-    | Pending T.Text T.Text [T.Text] -- first is the accumulator
-    deriving (Show)
-
-{-| 		
-
->>> splitTextStep (T.pack "x",Done)
-Just ((["x"],False),("",Done))
-
->>> splitTextStep (T.pack "aabbcc",Pending T.empty (T.pack "bb") [])
-Just ((["aa"],True),("cc",Done))
-
->>> splitTextStep (T.pack "cc",Pending (T.pack "bb") (T.pack "bbcc") [T.pack "nextsep"])
-Just (([""],True),("",Pending "" "nextsep" []))
-
->>> splitTextStep (T.pack "xx",Pending (T.pack "bb") (T.pack "bbcc") [])
-Just ((["bbxx"],False),("",Pending "" "bbcc" []))
-
->>> splitTextStep (T.pack "xbb",Pending (T.pack "bbc") (T.pack "bbcccc") [])
-Just ((["bbcx"],False),("",Pending "bb" "bbcccc" []))
-
--}
-splitTextStep 
-    :: (T.Text, SectionsState) 
-    -> Maybe (([T.Text],Bool), (T.Text, SectionsState))
-splitTextStep (txt, _) | T.null txt           = Nothing
-splitTextStep (txt, Done)                     = Just (([txt],False),(T.empty,Done))
-splitTextStep (txt, Pending acc sep nextseps) = Just $
-    let (before,after) = T.breakOn sep (acc <> txt)
-    in
-    if T.null after 
-       then -- not present
-          let (m0,m) = maxintersect before sep
-          in
-          (([m0],False),(T.empty, Pending m sep nextseps))
-       else -- present
-          let unprefixed = T.drop (T.length sep) after
-              nextstate = case nextseps of
-                  [] -> Done
-                  z:zs -> Pending T.empty z zs
-          in
-          (([before],True),(unprefixed,nextstate))
-                               
-maxintersect :: T.Text -> T.Text -> (T.Text,T.Text)
-maxintersect txt sep = 
-    let prefixes = (tail . reverse . tail . T.inits) sep 
-        partialmatches = filter (flip T.isSuffixOf txt) prefixes
-        m = maybe T.empty id (listToMaybe partialmatches)
-    in
-    (T.take (T.length txt - T.length m) txt,m)
-        
-unfoldWithState :: (b -> Maybe (a, b)) -> b -> [(a, b)]
-unfoldWithState f = unfoldr (fmap (\t@(_, b) -> (t, b)) . f)
-
-------------------------------------------------------------------------------
-
-{- $textual
-
-    Transducers that work on 'Text' and other text-like types.
-
--}
-
-{-| 
-
->>> L.fold (folds (textualSplit (=='.')) L.list L.list) [".","bb.bb","c.c."]
-[[""],["","bb"],["bb","c"],["c"],[""]]
-
--}
-
-textualSplit :: MT.TextualMonoid m => (Char -> Bool) -> L.Transducer m m ()
-textualSplit predicate = L.Transducer step () done 
-  where
-    step _ txt = case MT.split predicate txt of
-        x:xs -> ((),[x],map (:[]) xs)
-        _ -> error "never happens"
-    done _ = mempty
-
-
-data SplitWhenWhenState = 
-      SplitWhenConditionEncountered 
-    | SplitWhenConditionPending
-
-{-| 		
-
->>> L.fold (bisect (textualBreak (=='.')) (reify id) ignore L.list) ["aa","bb.bb","cc"]
-["aa","bb"]
--}
-textualBreak :: MT.TextualMonoid m => (Char -> Bool) -> L.Transducer m m ()
-textualBreak predicate = 
-    L.Transducer step SplitWhenConditionPending done 
-    where
-        step SplitWhenConditionPending (MT.break (const False) predicate -> (i0,i1)) = 
-            if MN.null i1
-               then (SplitWhenConditionPending,[i0],[])
-               else (SplitWhenConditionEncountered,[i0],[[i1]])
-        step SplitWhenConditionEncountered i = 
-               (SplitWhenConditionEncountered,[i],[])
-        done = mempty
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
+
+-- |
+--
+-- This module builds on module "Control.Foldl.Text", adding stateful
+-- transducers and grouping operations.
+module Control.Foldl.Transduce.Text (
+        -- * Decoding transducers
+        decoder
+    ,   utf8
+    ,   utf8lenient 
+    ,   utf8strict
+    ,   decoderE
+    ,   utf8E
+        -- * Other transducers
+    ,   newline
+    ,   stripStart
+    ,   stripEnd
+        -- * Splitters
+    ,   words
+    ,   lines
+    ,   paragraphs
+    ,   sections
+        -- * Textual
+        -- $textual
+    ,   textualSplit
+    ,   textualBreak
+    ) where
+
+import Prelude hiding (lines,words)
+import Data.Char
+import Data.Bool
+import Data.Maybe
+import Data.List (unfoldr)
+import Data.Monoid (mempty,(<>))
+import Data.Foldable (foldMap,foldl')
+import qualified Data.ByteString as B
+import qualified Data.Text 
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.Encoding.Error as T
+import qualified Data.Monoid.Textual as MT
+import qualified Data.Monoid.Null as MN
+import Control.Applicative
+import Control.Monad.Trans.Except
+import Control.Monad.IO.Class
+import Control.Exception.Base 
+import qualified Control.Foldl.Transduce as L
+import qualified Data.List
+import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as NonEmpty
+
+{- $setup
+
+>>> :set -XFlexibleContexts
+>>> import Data.String hiding (lines,words)
+>>> import Data.Text (Text)
+>>> import Control.Applicative
+>>> import Control.Monad.Trans.Except
+>>> import qualified Control.Foldl as L
+>>> import Control.Foldl.Transduce
+
+-}
+
+data Pair a b = Pair !a !b
+
+{-| Builds a decoding 'Transducer' out of a stream-oriented decoding function
+    from "Data.Text.Encoding" and an error handler from
+    "Data.Text.Encoding.Error".        
+
+-}
+decoder :: (B.ByteString -> T.Decoding) -> T.OnDecodeError -> L.Transducer B.ByteString T.Text ()
+decoder _step onLeftovers = L.Transducer step (Pair mempty _step) done
+    where
+    step (Pair _ next) i = 
+        let 
+            T.Some txt leftovers next' = next i 
+        in
+        (Pair leftovers next',[txt],[])
+    done (Pair leftovers _) = 
+        if B.null leftovers
+            then ((), [], [])
+            else ((), foldMap (pure . T.singleton) onLeftovers',[])
+    onLeftovers' = onLeftovers "leftovers" Nothing
+
+{-| Builds a UTF8-decoding 'Transducer'. Takes an error handler from
+    "Data.Text.Encoding.Error".        
+
+-}
+utf8 :: T.OnDecodeError -> L.Transducer B.ByteString T.Text ()
+utf8 onDecodeError = 
+    decoder (T.streamDecodeUtf8With onDecodeError)  onDecodeError
+
+{-| UTF8-decoding 'Transducer' that replaces invalid input bytes with the
+    Unicode replacement character U+FFFD.
+
+>>> L.fold (transduce utf8lenient L.list) (map fromString ["decode","this"])
+["decode","this"]
+
+>>> L.fold (transduce utf8lenient L.list) (map fromString ["across \xe2","\x98\x83 boundaries"])
+["across ","\9731 boundaries"]
+
+>>> L.fold (transduce utf8lenient L.list) (map fromString ["invalid \xc3\x28 sequence"])
+["invalid \65533( sequence"]
+
+>>> L.fold (transduce utf8lenient L.list) (map fromString ["incomplete \xe2"])
+["incomplete ","\65533"]
+-}
+utf8lenient :: L.Transducer B.ByteString T.Text ()
+utf8lenient = utf8 T.lenientDecode
+
+{-| __/BEWARE!/__ 
+    This 'Transducer' may throw 'UnicodeException'.
+    __/BEWARE!/__ 
+
+>>> L.fold (transduce utf8strict L.list) (map fromString ["invalid \xc3\x28 sequence"])
+*** Exception: Cannot decode byte '\xc3': Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream
+
+>>> L.fold (transduce utf8strict L.list) (map fromString ["incomplete \xe2"])
+*** Exception: Cannot decode input: leftovers
+-}
+utf8strict :: L.Transducer B.ByteString T.Text ()
+utf8strict = utf8 T.strictDecode
+
+{-| Similar to 'decoder', but catches 'UnicodeException' in 'IO' and uses
+    'Control.Monad.Trans.Except' to communicate the error.        
+
+-}
+decoderE :: MonadIO m
+         => (T.OnDecodeError -> B.ByteString -> T.Decoding)
+         -> L.TransducerM (ExceptT T.UnicodeException m) B.ByteString T.Text ()   
+decoderE next = L.TransducerM step (return (Pair mempty next')) done
+    where
+        step (Pair _ next1) i = do
+            emc <- liftIO . try . evaluate $ next1 i 
+            case emc of 
+                Left ue -> do
+                    throwE ue
+                Right (T.Some txt leftovers next2) -> do
+                    return (Pair leftovers next2,[txt],[])
+        done (Pair leftovers _) = do
+            if B.null leftovers
+                then return ((), [], [])
+                else do
+                    emc <- liftIO . try . evaluate $ onLeftovers'
+                    case emc of
+                        Left ue -> do
+                            throwE ue
+                        Right mc -> do
+                            return ((), foldMap (return . T.singleton) mc,[])
+        next' = next T.strictDecode  
+        onLeftovers' = T.strictDecode "leftovers" Nothing
+
+{-| Like 'utf8strict', but catches 'UnicodeException' in 'IO' and uses
+    'Control.Monad.Trans.Except' to communicate the error.        
+
+>>> runExceptT $ L.foldM (transduceM utf8E (L.generalize L.list)) (map fromString ["invalid \xc3\x28 sequence"])
+Left Cannot decode byte '\xc3': Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream
+
+>>> runExceptT $ L.foldM (transduceM utf8E (L.generalize L.list)) (map fromString ["incomplete \xe2"])
+Left Cannot decode input: leftovers
+-}
+utf8E :: MonadIO m => L.TransducerM (ExceptT T.UnicodeException m) B.ByteString T.Text ()   
+utf8E = decoderE T.streamDecodeUtf8With
+
+{-| Appends a newline at the end of the stream.        
+
+>>> L.fold (transduce newline L.list) (map T.pack ["without","newline"])
+["without","newline","\n"]
+-}
+newline :: L.Transducer T.Text T.Text ()
+newline = L.surround [] ["\n"]
+
+blank :: T.Text -> Bool
+blank = Data.Text.all isSpace
+
+{-| Remove leading white space from a stream of 'Text'.        
+
+>>> L.fold (transduce stripStart L.list) (map T.pack ["   ","", "   text "])
+["text "]
+-}
+stripStart :: L.Transducer T.Text T.Text ()
+stripStart = L.Transducer step False done
+    where
+        step True i = (True, [i],[])
+        step False i =
+            if blank i 
+                then (False,[],[])
+                else (True, [T.stripStart i],[])
+        done _  = ((),[],[])
+
+{-| Remove trailing white space from a stream of 'Text'.        
+
+    __/BEWARE!/__ 
+    This function naively accumulates in memory any arriving "blank blocks" of
+    text until a non-blank block or end-of-stream arrives, and therefore it is
+    potentially dangerous. Do not use with untrusted inputs.
+
+>>> L.fold (transduce stripEnd L.list) (map T.pack [" ", " \n  text ", "   ", "" , " "])
+[" "," \n  text"]
+-}
+stripEnd :: L.Transducer T.Text T.Text ()
+stripEnd = L.Transducer step [] done
+    where
+        step txts i =
+            if blank i
+                -- dangerous!
+                then (i:txts, [], [])
+                else ([i], reverse txts, [])
+        done txts = case reverse txts of
+            txt : _ -> ((), [T.stripEnd txt], [])
+            _ -> ((), [], [])
+
+{-| Splits a stream of text into lines, removing the newlines.
+
+>>> L.fold (L.groups lines (surround [T.pack "x"] []) L.list) (map T.pack ["line 1\n line 2\n"])
+["x","line 1","x"," line 2"]
+
+>>> L.fold (L.groups lines newline L.list) (map T.pack ["line 1\n line 2\n"])
+["line 1","\n"," line 2","\n"]
+
+    Used with 'L.transduce', it simply removes newlines:
+
+>>> L.fold (L.transduce lines L.list) (map T.pack ["line 1\n line 2\n"])
+["line 1"," line 2"]
+-}
+lines :: L.Transducer T.Text T.Text ()
+lines = L.Transducer step False done 
+    where
+        step previousnl txt =
+            if Data.Text.null txt
+               then  
+                   (previousnl,[],[])
+               else
+                   let
+                       lastc = Data.Text.last txt == '\n'
+                       txts = T.lines txt
+                   in
+                   case (previousnl,txts) of
+                       (_,[]) -> error "never happens"
+                       (True,_) -> (lastc, [], map pure txts)
+                       (False,t:ts) -> (lastc, [t], map pure ts)
+
+        done _ = ((),[],[])
+
+
+data WordsState = 
+      NoLastChar
+    | LastCharSpace
+    | LastCharNotSpace
+
+{-| Splits a stream of text into words, removing whitespace.
+
+>>> L.fold (folds words L.list L.list) (map T.pack ["  a","aa ", "bb c","cc dd ","ee f","f"])
+[["a","aa"],["bb"],["c","cc"],["dd"],["ee"],["f","f"]]
+
+    Used with 'L.transduce', it simply removes all whitespace:
+
+>>> L.fold (L.transduce words L.list) (map T.pack ["  a","aa ", "bb c","cc dd ","ee f","f"])
+["a","aa","bb","c","cc","dd","ee","f","f"]
+-}
+words :: L.Transducer T.Text T.Text ()
+words = L.Transducer step NoLastChar done 
+    where
+        step tstate txt 
+            | Data.Text.null txt = (tstate,[],[])
+            | blank txt = 
+                case tstate of
+                    NoLastChar -> (NoLastChar,[],[])
+                    _ -> (LastCharSpace,[],[])
+            | otherwise =                    
+                let nextstate = 
+                        if isSpace (T.last txt) 
+                           then LastCharSpace 
+                           else LastCharNotSpace
+                    (oldgroup,newgroups) = case (tstate, T.words txt) of
+                        (NoLastChar,w:ws) -> 
+                            ([w],map pure ws)
+                        (LastCharSpace,ws) -> 
+                            ([],map pure ws)
+                        (LastCharNotSpace,w:ws) -> 
+                            if isSpace (T.head txt)
+                               then ([],map pure (w:ws))
+                               else ([w],map pure ws)
+                        (_,[]) -> error "never happens, txt not blank"
+                in (nextstate,oldgroup,newgroups)
+        done _ = ((),[],[])
+
+
+data ParagraphsState = 
+      SkippingAfterStreamStart
+    | SkippingAfterNewline
+    | SkippingAfterBlankLine
+    | ContinuingNonemptyLine
+
+{-| Splits a stream of text into paragraphs, removing empty lines and trimming
+    newspace from the start of each line.
+
+>>> map mconcat (L.fold (folds paragraphs L.list L.list) (map T.pack [" \n aaa","\naa ", " \n\nbb\n"]))
+["aaa\naa  \n","bb\n"]
+
+    Used with 'L.transduce', it removes empty lines and trims newspace from the
+    start of each line.
+-}
+paragraphs :: L.Transducer T.Text T.Text ()
+paragraphs = L.Transducer step SkippingAfterStreamStart done 
+    where
+        step tstate txt
+            | Data.Text.null txt = 
+                (tstate,[],[])
+            | otherwise = 
+                let (initlines,lastline) = splittedLines txt
+                    (tstate', outputsreversed) =
+                        advanceLast
+                        (foldl' 
+                            advance
+                            (tstate,pure [])
+                            initlines)
+                        lastline          
+                    (xs :| xss) = fmap reverse (NonEmpty.reverse outputsreversed)
+                in (tstate',xs,xss)
+        done _ = 
+            ((),[],[])
+        splittedLines :: T.Text -> ([T.Text],T.Text)
+        splittedLines nonEmptyChunk = 
+            let splitted = 
+                    Data.Text.lines nonEmptyChunk 
+                    ++
+                    if T.last nonEmptyChunk == '\n' then [mempty] else mempty
+            in (init splitted, last splitted) -- unsafe with empty lists!!!
+        advance 
+            :: (ParagraphsState, NonEmpty [T.Text]) 
+            -> T.Text 
+            -> (ParagraphsState, NonEmpty [T.Text])
+        advance (s,outputs) i = 
+            case (s, blank i) of
+                (SkippingAfterStreamStart, True) -> 
+                    (,) 
+                    SkippingAfterStreamStart 
+                    outputs
+                (SkippingAfterStreamStart, False) -> 
+                    (,)
+                    SkippingAfterNewline
+                    (continue ["\n",T.stripStart i] outputs) 
+                (SkippingAfterNewline, True) -> 
+                    (,) 
+                    SkippingAfterBlankLine 
+                    outputs 
+                (SkippingAfterNewline, False) -> 
+                    (,)
+                    SkippingAfterNewline
+                    (continue ["\n",T.stripStart i] outputs)
+                (SkippingAfterBlankLine, True) -> 
+                    (,) 
+                    SkippingAfterBlankLine 
+                    outputs 
+                (SkippingAfterBlankLine, False) -> 
+                    (,)
+                    SkippingAfterNewline
+                    (continue ["\n",T.stripStart i] (NonEmpty.cons [] outputs)) 
+                (ContinuingNonemptyLine, _) -> 
+                    (,)
+                    SkippingAfterNewline
+                    (continue ["\n",i] outputs)
+        advanceLast 
+                :: (ParagraphsState, NonEmpty [T.Text]) 
+                -> T.Text 
+                -> (ParagraphsState, NonEmpty [T.Text])
+        advanceLast (s,outputs) i = 
+            case (s, blank i) of
+                (SkippingAfterStreamStart, True) -> 
+                    (,) 
+                    SkippingAfterStreamStart 
+                    outputs
+                (SkippingAfterStreamStart, False) -> 
+                    (,)
+                    ContinuingNonemptyLine
+                    (continue [T.stripStart i] outputs)
+                (SkippingAfterNewline, True) -> 
+                    (,) 
+                    SkippingAfterNewline 
+                    outputs
+                (SkippingAfterNewline, False) -> 
+                    (,)
+                    ContinuingNonemptyLine
+                    (continue [T.stripStart i] outputs)
+                (SkippingAfterBlankLine, True) -> 
+                    (,)
+                    SkippingAfterBlankLine
+                    outputs 
+                (SkippingAfterBlankLine, False) -> 
+                    (,)
+                    ContinuingNonemptyLine
+                    (continue [T.stripStart i] (NonEmpty.cons [] outputs))
+                (ContinuingNonemptyLine, _) -> 
+                    (,)
+                    ContinuingNonemptyLine
+                    (continue [i] outputs)
+
+{-| 
+
+    Given a (possibly infinite) list of section headings, split the stream into
+    sections and remove the headings. 
+
+>>> map mconcat (L.fold (folds (sections (map T.pack ["#1\n","#2\n"])) L.list L.list) (map T.pack [" #1\naa\n#","2\nbb"]))
+[" ","aa\n","bb"]
+
+>>> map mconcat (L.fold (folds (sections (map T.pack ["1234"])) L.list L.list) (map T.pack [" 1","2","x","1","2","3","4","5"]))
+[" 12x","5"]
+
+    Used with 'L.transduce', it simply removes all headings.
+-}
+sections :: [T.Text] -> L.Transducer T.Text T.Text ()
+sections seps = L.Transducer step (initialstate seps) done 
+    where
+        step tstate txt =
+            let (emitted,fmap snd -> states) = Data.List.unzip (unfoldWithState splitTextStep (txt,tstate))
+                finalState = NonEmpty.last (tstate :| states)
+                continuing :| following = NonEmpty.reverse (fmap Data.List.reverse (foldl' advance ([]:|[]) emitted))
+            in (finalState, continuing, following)                        
+        advance :: NonEmpty [x] -> ([x],Bool) -> NonEmpty [x]
+        advance l (e,b) = bool id (separate []) b (continue e l)
+        done Done = 
+            ((),[],[])
+        done (Pending acc _ _) =
+            ((),[acc],[])    
+        initialstate [] = Done
+        initialstate (x:xs) = Pending T.empty x xs
+
+
+continue :: [a] -> NonEmpty [a] -> NonEmpty [a]
+continue as (as':| rest) = (as ++ as') :| rest
+
+separate :: [x] -> NonEmpty [x] -> NonEmpty [x]
+separate = NonEmpty.cons
+
+data SectionsState = 
+      Done
+    | Pending T.Text T.Text [T.Text] -- first is the accumulator
+    deriving (Show)
+
+{-| 		
+
+>>> splitTextStep (T.pack "x",Done)
+Just ((["x"],False),("",Done))
+
+>>> splitTextStep (T.pack "aabbcc",Pending T.empty (T.pack "bb") [])
+Just ((["aa"],True),("cc",Done))
+
+>>> splitTextStep (T.pack "cc",Pending (T.pack "bb") (T.pack "bbcc") [T.pack "nextsep"])
+Just (([""],True),("",Pending "" "nextsep" []))
+
+>>> splitTextStep (T.pack "xx",Pending (T.pack "bb") (T.pack "bbcc") [])
+Just ((["bbxx"],False),("",Pending "" "bbcc" []))
+
+>>> splitTextStep (T.pack "xbb",Pending (T.pack "bbc") (T.pack "bbcccc") [])
+Just ((["bbcx"],False),("",Pending "bb" "bbcccc" []))
+
+-}
+splitTextStep 
+    :: (T.Text, SectionsState) 
+    -> Maybe (([T.Text],Bool), (T.Text, SectionsState))
+splitTextStep (txt, _) | T.null txt           = Nothing
+splitTextStep (txt, Done)                     = Just (([txt],False),(T.empty,Done))
+splitTextStep (txt, Pending acc sep nextseps) = Just $
+    let (before,after) = T.breakOn sep (acc <> txt)
+    in
+    if T.null after 
+       then -- not present
+          let (m0,m) = maxintersect before sep
+          in
+          (([m0],False),(T.empty, Pending m sep nextseps))
+       else -- present
+          let unprefixed = T.drop (T.length sep) after
+              nextstate = case nextseps of
+                  [] -> Done
+                  z:zs -> Pending T.empty z zs
+          in
+          (([before],True),(unprefixed,nextstate))
+                               
+maxintersect :: T.Text -> T.Text -> (T.Text,T.Text)
+maxintersect txt sep = 
+    let prefixes = (tail . reverse . tail . T.inits) sep 
+        partialmatches = filter (flip T.isSuffixOf txt) prefixes
+        m = maybe T.empty id (listToMaybe partialmatches)
+    in
+    (T.take (T.length txt - T.length m) txt,m)
+        
+unfoldWithState :: (b -> Maybe (a, b)) -> b -> [(a, b)]
+unfoldWithState f = unfoldr (fmap (\t@(_, b) -> (t, b)) . f)
+
+------------------------------------------------------------------------------
+
+{- $textual
+
+    Transducers that work on 'Text' and other text-like types.
+
+-}
+
+{-| 
+
+>>> L.fold (folds (textualSplit (=='.')) L.list L.list) [".","bb.bb","c.c."]
+[[""],["","bb"],["bb","c"],["c"],[""]]
+
+-}
+
+textualSplit :: MT.TextualMonoid m => (Char -> Bool) -> L.Transducer m m ()
+textualSplit predicate = L.Transducer step () done 
+  where
+    step _ txt = case MT.split predicate txt of
+        x:xs -> ((),[x],map (:[]) xs)
+        _ -> error "never happens"
+    done _ = mempty
+
+
+data SplitWhenWhenState = 
+      SplitWhenConditionEncountered 
+    | SplitWhenConditionPending
+
+{-| 		
+
+>>> L.fold (bisect (textualBreak (=='.')) (reify id) ignore L.list) ["aa","bb.bb","cc"]
+["aa","bb"]
+-}
+textualBreak :: MT.TextualMonoid m => (Char -> Bool) -> L.Transducer m m ()
+textualBreak predicate = 
+    L.Transducer step SplitWhenConditionPending done 
+    where
+        step SplitWhenConditionPending (MT.break (const False) predicate -> (i0,i1)) = 
+            if MN.null i1
+               then (SplitWhenConditionPending,[i0],[])
+               else (SplitWhenConditionEncountered,[i0],[[i1]])
+        step SplitWhenConditionEncountered i = 
+               (SplitWhenConditionEncountered,[i],[])
+        done = mempty
diff --git a/tests/doctests.hs b/tests/doctests.hs
--- a/tests/doctests.hs
+++ b/tests/doctests.hs
@@ -1,11 +1,11 @@
-module Main where
-
-import Test.DocTest
-
-main :: IO ()
-main = doctest 
-    [
-        "src/Control/Foldl/Transduce.hs",
-        "src/Control/Foldl/Transduce/ByteString.hs",
-        "src/Control/Foldl/Transduce/Text.hs"
-    ]
+module Main where
+
+import Test.DocTest
+
+main :: IO ()
+main = doctest 
+    [
+        "src/Control/Foldl/Transduce.hs",
+        "src/Control/Foldl/Transduce/ByteString.hs",
+        "src/Control/Foldl/Transduce/Text.hs"
+    ]
diff --git a/tests/tests.hs b/tests/tests.hs
--- a/tests/tests.hs
+++ b/tests/tests.hs
@@ -1,243 +1,243 @@
-module Main where
-
-import Prelude hiding (splitAt,lines,words)
-import Data.Char
-import Data.String hiding (lines,words)
-import Data.Monoid
-import Data.Bifunctor
-import qualified Data.List (intersperse,splitAt)
-import qualified Data.List.Split as Split
-import qualified Data.Monoid.Factorial as SFM
-import Test.Tasty
-import Test.Tasty.HUnit
-import Test.Tasty.QuickCheck
-
-import qualified Data.Text as T
-import qualified Data.Text.Lazy as TL
-
-import qualified Control.Foldl as L
-import Control.Foldl.Transduce
-import Control.Foldl.Transduce.Text
-
-{- $quickcheck
-
-   Notes for quickchecking on the REPL:
-
-cabal repl tests
-:t sample
-sample :: Show a => Gen a -> IO ()
-sample (arbitrary :: Gen WordA)
-
--}
-
-main :: IO ()
-main = defaultMain tests
-
-testCaseEq :: (Eq a, Show a) => TestName -> a -> a -> TestTree
-testCaseEq name a1 a2 = testCase name (assertEqual "" a1 a2)
-
-blank :: T.Text -> Bool
-blank = T.all isSpace
-
-nl :: T.Text
-nl = T.pack "\n"
-
-sp :: T.Text
-sp = T.pack " "
-
-c :: T.Text
-c = T.pack "c"
-
-{- $words
-
--}
-
-newtype WordA = WordA { getWord :: T.Text } deriving (Show)
-
-instance Arbitrary WordA where
-    arbitrary = do
-        firstChar <- oneof [pure ' ', pure '\n', arbitrary]
-        lastChar <- oneof [pure ' ', pure '\n', arbitrary]
-        middle <- listOf (frequency [(1,pure ' '),(4,arbitrary)])
-        return (WordA (T.pack (firstChar : (middle ++ [lastChar]))))
-
-{- $paragraphs
-
--}
-
-newtype TextChunksA = TextChunksA { getChunks :: [T.Text] } deriving (Show)
-
-instance Arbitrary TextChunksA where
-    arbitrary = flip suchThat (not . blank . mconcat . getChunks) (do
-        TextChunksA <$> partz)
-            where
-                chunkz = frequency [
-                      (20::Int, flip T.replicate sp <$> choose (1,40)) 
-                    , (20, flip T.replicate sp <$> choose (1,3)) 
-                    , (50, pure nl)
-                    , (20, flip T.replicate c <$> choose (1,30))
-                    , (20, flip T.replicate c <$> choose (1,3))
-                    ]
-                combined = mconcat <$> vectorOf 40 chunkz 
-                partitions = infiniteListOf (choose (1::Int,7))
-                partz = partition [] <$> combined <*> partitions
-                partition :: [T.Text] -> T.Text -> [Int] -> [T.Text]
-                partition accum text (x:xs) =
-                    if x >= T.length text    
-                       then reverse (text:accum)
-                       else 
-                           let (point,rest) = T.splitAt x text 
-                           in 
-                           partition (point:accum) rest xs
-                partition _ _ [] = error "never happens"
-    shrink (TextChunksA texts) = 
-        let removeIndex i xs = 
-                let (xs',xs'') = Data.List.splitAt i xs
-                in xs' ++ tail xs'' 
-            l = length texts
-        in 
-        if l == 1 
-           then []
-           else map (\i -> TextChunksA (removeIndex i texts)) [0..l-1] 
-
-paragraphsBaseline 
-    :: T.Text -> [T.Text] 
-paragraphsBaseline =  
-      map (T.unlines . map T.stripStart . T.lines)
-    . map mconcat 
-    . map (`mappend` [nl])
-    . map (Data.List.intersperse nl)
-    . filter (not . null) 
-    . Split.splitWhen blank 
-    . T.lines
-
-ignoreLastNewline :: [T.Text] -> [T.Text]
-ignoreLastNewline ts = 
-    let 
-        lastt = last ts
-        lastt' = if T.last lastt == '\n' then T.init lastt else lastt 
-    in init ts ++ [lastt']
-
--- (paragraphs,chunks)
-splittedParagraphs :: T.Text -> [Int] -> [([T.Text],[T.Text])]
-splittedParagraphs txt splitsizes =   
-    let 
-        splitted = paragraphsBaseline txt
-    in 
-    zip (repeat splitted) (map (flip T.chunksOf txt) splitsizes)
-
-paragraphsUnderTest
-    :: [T.Text] -> [T.Text] 
-paragraphsUnderTest txt =
-    map mconcat (L.fold (folds paragraphs L.list L.list) txt)
-
-sectionsUnderTest
-    :: [T.Text] -> [T.Text] -> [T.Text] 
-sectionsUnderTest stns txt =
-    map mconcat (L.fold (folds (sections stns) L.list L.list) txt)
-
-paragraph01 :: T.Text
-paragraph01 = 
-    T.pack 
-    "  \n \n\n \n \n \
-    \a aa aaa \nb bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb bb \n \
-    \ ccccccccccccccccccccccc cccccccc \n\n  \n \n\n ccc\     
-    \ \n \n \nd\n\n\ne \
-    \\n" 
-    
-paragraph02 :: T.Text
-paragraph02 = T.pack " cc  "
-
-tests :: TestTree
-tests = 
-    testGroup "Tests" 
-    [
-        testGroup "surround" 
-        [
-            testCaseEq "surroundempty" 
-                "prefixsuffix"
-                (L.fold (transduce (surround "prefix" "suffix") L.list) "")
-        ],
-        testGroup "chunksOf" 
-        [
-            testCaseEq "emptyList3"
-                ([]::[[Int]])
-                (L.fold (folds (chunksOf 3) L.list L.list) [])
-            ,
-            testCaseEq "size1" 
-                ([[1],[2],[3],[4],[5],[6],[7]]::[[Int]])
-                (L.fold (folds (chunksOf 1) L.list L.list) [1..7])
-            ,
-            testCaseEq "size3" 
-                ([[1,2,3],[4,5,6],[7]]::[[Int]])
-                (L.fold (folds (chunksOf 3) L.list L.list) [1..7])
-        ],
-        testGroup "textualBreak"
-        [
-            testCaseEq "beginwithdot"
-                ".bb"
-                (L.fold (bisect (textualBreak (=='.')) ignore (reify id) L.mconcat) ["aa",".bb"])
-            ,
-            testCaseEq "endwithdot"
-                "."
-                (L.fold (bisect (textualBreak (=='.')) ignore (reify id) L.mconcat) ["aa","bb."])
-        ],
-        testGroup "newline"
-        [
-            testCaseEq "newlineempty"
-                (T.pack "\n")
-                (mconcat (L.fold (transduce newline L.list) (map T.pack [])))
-            ,
-            testCaseEq "newlinenull"
-                (T.pack "\n")
-                (mconcat (L.fold (transduce newline L.list) (map T.pack [""])))
-        ],
-        testGroup "words" 
-        [ 
-            testGroup "quickcheck" 
-            [ 
-                testProperty "quickcheck1" (\chunks -> -- list of words 
-                    let tchunks = fmap getWord chunks 
-                    in
-                    TL.words (TL.fromChunks tchunks)
-                    ==
-                    (fmap TL.fromChunks (L.fold (folds words L.list L.list) tchunks)))
-            ]
-        ],
-        testGroup "paragraphs" 
-        [
-            testCase "paragraphs01"
-                (mapM_
-                    (\(x,y) -> assertEqual "" (ignoreLastNewline x) (ignoreLastNewline (paragraphsUnderTest y))) 
-                    (splittedParagraphs paragraph01 [1..7])),
-            testCaseEq "newlineAtEnd"
-                (map T.pack ["aa\n"]) 
-                (paragraphsUnderTest (map T.pack ["a","a","\n"])),
-            testCaseEq "noNewlineAtEnd"
-                (map T.pack ["aa"]) 
-                (paragraphsUnderTest (map T.pack ["a","a"])),
-            testGroup "quickcheck" 
-            [ 
-                testProperty "quickcheck1" (\(TextChunksA chunks) ->
-                        ignoreLastNewline (paragraphsUnderTest chunks)
-                        ==
-                        ignoreLastNewline (paragraphsBaseline (mconcat chunks)))
-            ]
-        ],
-        testGroup "sections"
-        [
-            testCaseEq "no separators at all"
-                (map T.pack ["aaabbcc"])
-                (sectionsUnderTest (map T.pack []) (map T.pack ["a","aa","bbc","c"])),
-            testCaseEq "incomplete separator"
-                (map T.pack ["123#_","aa","bb#"])
-                (sectionsUnderTest (map T.pack ["1234","#"]) (map T.pack ["1","23","#_1234aa#b","b#"])),
-            testCaseEq "small chunks"
-                (map T.pack ["0","01","aa","a#bb","c"])
-                (sectionsUnderTest (map T.pack ["_","_","##","##","##"]) (map T.pack ["0","_","0","1_","a","a","#","#a","#","b","b#","#","c"])),
-            testCaseEq "big chunk with multiple seps"
-                (map T.pack ["1x","aa","bb","cc1x","dd"])
-                (sectionsUnderTest (map T.pack (cycle ["12"])) (map T.pack ["1","x12aa12bb12cc1","x1","2dd"]))
-        ]
-    ]
-
+module Main where
+
+import Prelude hiding (splitAt,lines,words)
+import Data.Char
+import Data.String hiding (lines,words)
+import Data.Monoid
+import Data.Bifunctor
+import qualified Data.List (intersperse,splitAt)
+import qualified Data.List.Split as Split
+import qualified Data.Monoid.Factorial as SFM
+import Test.Tasty
+import Test.Tasty.HUnit
+import Test.Tasty.QuickCheck
+
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+
+import qualified Control.Foldl as L
+import Control.Foldl.Transduce
+import Control.Foldl.Transduce.Text
+
+{- $quickcheck
+
+   Notes for quickchecking on the REPL:
+
+cabal repl tests
+:t sample
+sample :: Show a => Gen a -> IO ()
+sample (arbitrary :: Gen WordA)
+
+-}
+
+main :: IO ()
+main = defaultMain tests
+
+testCaseEq :: (Eq a, Show a) => TestName -> a -> a -> TestTree
+testCaseEq name a1 a2 = testCase name (assertEqual "" a1 a2)
+
+blank :: T.Text -> Bool
+blank = T.all isSpace
+
+nl :: T.Text
+nl = T.pack "\n"
+
+sp :: T.Text
+sp = T.pack " "
+
+c :: T.Text
+c = T.pack "c"
+
+{- $words
+
+-}
+
+newtype WordA = WordA { getWord :: T.Text } deriving (Show)
+
+instance Arbitrary WordA where
+    arbitrary = do
+        firstChar <- oneof [pure ' ', pure '\n', arbitrary]
+        lastChar <- oneof [pure ' ', pure '\n', arbitrary]
+        middle <- listOf (frequency [(1,pure ' '),(4,arbitrary)])
+        return (WordA (T.pack (firstChar : (middle ++ [lastChar]))))
+
+{- $paragraphs
+
+-}
+
+newtype TextChunksA = TextChunksA { getChunks :: [T.Text] } deriving (Show)
+
+instance Arbitrary TextChunksA where
+    arbitrary = flip suchThat (not . blank . mconcat . getChunks) (do
+        TextChunksA <$> partz)
+            where
+                chunkz = frequency [
+                      (20::Int, flip T.replicate sp <$> choose (1,40)) 
+                    , (20, flip T.replicate sp <$> choose (1,3)) 
+                    , (50, pure nl)
+                    , (20, flip T.replicate c <$> choose (1,30))
+                    , (20, flip T.replicate c <$> choose (1,3))
+                    ]
+                combined = mconcat <$> vectorOf 40 chunkz 
+                partitions = infiniteListOf (choose (1::Int,7))
+                partz = partition [] <$> combined <*> partitions
+                partition :: [T.Text] -> T.Text -> [Int] -> [T.Text]
+                partition accum text (x:xs) =
+                    if x >= T.length text    
+                       then reverse (text:accum)
+                       else 
+                           let (point,rest) = T.splitAt x text 
+                           in 
+                           partition (point:accum) rest xs
+                partition _ _ [] = error "never happens"
+    shrink (TextChunksA texts) = 
+        let removeIndex i xs = 
+                let (xs',xs'') = Data.List.splitAt i xs
+                in xs' ++ tail xs'' 
+            l = length texts
+        in 
+        if l == 1 
+           then []
+           else map (\i -> TextChunksA (removeIndex i texts)) [0..l-1] 
+
+paragraphsBaseline 
+    :: T.Text -> [T.Text] 
+paragraphsBaseline =  
+      map (T.unlines . map T.stripStart . T.lines)
+    . map mconcat 
+    . map (`mappend` [nl])
+    . map (Data.List.intersperse nl)
+    . filter (not . null) 
+    . Split.splitWhen blank 
+    . T.lines
+
+ignoreLastNewline :: [T.Text] -> [T.Text]
+ignoreLastNewline ts = 
+    let 
+        lastt = last ts
+        lastt' = if T.last lastt == '\n' then T.init lastt else lastt 
+    in init ts ++ [lastt']
+
+-- (paragraphs,chunks)
+splittedParagraphs :: T.Text -> [Int] -> [([T.Text],[T.Text])]
+splittedParagraphs txt splitsizes =   
+    let 
+        splitted = paragraphsBaseline txt
+    in 
+    zip (repeat splitted) (map (flip T.chunksOf txt) splitsizes)
+
+paragraphsUnderTest
+    :: [T.Text] -> [T.Text] 
+paragraphsUnderTest txt =
+    map mconcat (L.fold (folds paragraphs L.list L.list) txt)
+
+sectionsUnderTest
+    :: [T.Text] -> [T.Text] -> [T.Text] 
+sectionsUnderTest stns txt =
+    map mconcat (L.fold (folds (sections stns) L.list L.list) txt)
+
+paragraph01 :: T.Text
+paragraph01 = 
+    T.pack 
+    "  \n \n\n \n \n \
+    \a aa aaa \nb bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb bb \n \
+    \ ccccccccccccccccccccccc cccccccc \n\n  \n \n\n ccc\     
+    \ \n \n \nd\n\n\ne \
+    \\n" 
+    
+paragraph02 :: T.Text
+paragraph02 = T.pack " cc  "
+
+tests :: TestTree
+tests = 
+    testGroup "Tests" 
+    [
+        testGroup "surround" 
+        [
+            testCaseEq "surroundempty" 
+                "prefixsuffix"
+                (L.fold (transduce (surround "prefix" "suffix") L.list) "")
+        ],
+        testGroup "chunksOf" 
+        [
+            testCaseEq "emptyList3"
+                ([]::[[Int]])
+                (L.fold (folds (chunksOf 3) L.list L.list) [])
+            ,
+            testCaseEq "size1" 
+                ([[1],[2],[3],[4],[5],[6],[7]]::[[Int]])
+                (L.fold (folds (chunksOf 1) L.list L.list) [1..7])
+            ,
+            testCaseEq "size3" 
+                ([[1,2,3],[4,5,6],[7]]::[[Int]])
+                (L.fold (folds (chunksOf 3) L.list L.list) [1..7])
+        ],
+        testGroup "textualBreak"
+        [
+            testCaseEq "beginwithdot"
+                ".bb"
+                (L.fold (bisect (textualBreak (=='.')) ignore (reify id) L.mconcat) ["aa",".bb"])
+            ,
+            testCaseEq "endwithdot"
+                "."
+                (L.fold (bisect (textualBreak (=='.')) ignore (reify id) L.mconcat) ["aa","bb."])
+        ],
+        testGroup "newline"
+        [
+            testCaseEq "newlineempty"
+                (T.pack "\n")
+                (mconcat (L.fold (transduce newline L.list) (map T.pack [])))
+            ,
+            testCaseEq "newlinenull"
+                (T.pack "\n")
+                (mconcat (L.fold (transduce newline L.list) (map T.pack [""])))
+        ],
+        testGroup "words" 
+        [ 
+            testGroup "quickcheck" 
+            [ 
+                testProperty "quickcheck1" (\chunks -> -- list of words 
+                    let tchunks = fmap getWord chunks 
+                    in
+                    TL.words (TL.fromChunks tchunks)
+                    ==
+                    (fmap TL.fromChunks (L.fold (folds words L.list L.list) tchunks)))
+            ]
+        ],
+        testGroup "paragraphs" 
+        [
+            testCase "paragraphs01"
+                (mapM_
+                    (\(x,y) -> assertEqual "" (ignoreLastNewline x) (ignoreLastNewline (paragraphsUnderTest y))) 
+                    (splittedParagraphs paragraph01 [1..7])),
+            testCaseEq "newlineAtEnd"
+                (map T.pack ["aa\n"]) 
+                (paragraphsUnderTest (map T.pack ["a","a","\n"])),
+            testCaseEq "noNewlineAtEnd"
+                (map T.pack ["aa"]) 
+                (paragraphsUnderTest (map T.pack ["a","a"])),
+            testGroup "quickcheck" 
+            [ 
+                testProperty "quickcheck1" (\(TextChunksA chunks) ->
+                        ignoreLastNewline (paragraphsUnderTest chunks)
+                        ==
+                        ignoreLastNewline (paragraphsBaseline (mconcat chunks)))
+            ]
+        ],
+        testGroup "sections"
+        [
+            testCaseEq "no separators at all"
+                (map T.pack ["aaabbcc"])
+                (sectionsUnderTest (map T.pack []) (map T.pack ["a","aa","bbc","c"])),
+            testCaseEq "incomplete separator"
+                (map T.pack ["123#_","aa","bb#"])
+                (sectionsUnderTest (map T.pack ["1234","#"]) (map T.pack ["1","23","#_1234aa#b","b#"])),
+            testCaseEq "small chunks"
+                (map T.pack ["0","01","aa","a#bb","c"])
+                (sectionsUnderTest (map T.pack ["_","_","##","##","##"]) (map T.pack ["0","_","0","1_","a","a","#","#a","#","b","b#","#","c"])),
+            testCaseEq "big chunk with multiple seps"
+                (map T.pack ["1x","aa","bb","cc1x","dd"])
+                (sectionsUnderTest (map T.pack (cycle ["12"])) (map T.pack ["1","x12aa12bb12cc1","x1","2dd"]))
+        ]
+    ]
+