From 2cc253ed8f10b7f132f128cb91a503ffbe5ce251 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 10 Jun 2024 15:49:51 +0200
Subject: [PATCH 01/32] Fix naming in mapOutput and toRecursive

---
 automaton/src/Data/Stream/Except.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/automaton/src/Data/Stream/Except.hs b/automaton/src/Data/Stream/Except.hs
index d90828d8..6a92b6be 100644
--- a/automaton/src/Data/Stream/Except.hs
+++ b/automaton/src/Data/Stream/Except.hs
@@ -36,11 +36,11 @@ data StreamExcept a m e
 
 -- | Apply a function to the output of the stream
 mapOutput :: (Functor m) => (a -> b) -> StreamExcept a m e -> StreamExcept b m e
-mapOutput f (RecursiveExcept final) = RecursiveExcept $ f <$> final
-mapOutput f (CoalgebraicExcept initial) = CoalgebraicExcept $ f <$> initial
+mapOutput f (RecursiveExcept recursive) = RecursiveExcept $ f <$> recursive
+mapOutput f (CoalgebraicExcept coalgebraic) = CoalgebraicExcept $ f <$> coalgebraic
 
 toRecursive :: (Functor m) => StreamExcept a m e -> Recursive (ExceptT e m) a
-toRecursive (RecursiveExcept coalgebraic) = coalgebraic
+toRecursive (RecursiveExcept recursive) = recursive
 toRecursive (CoalgebraicExcept coalgebraic) = StreamOptimized.toRecursive coalgebraic
 
 runStreamExcept :: StreamExcept a m e -> OptimizedStreamT (ExceptT e m) a

From b784bd9ff596c9d99f6863c8840183a3bfd8db14 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Wed, 26 Jun 2024 20:12:15 +0200
Subject: [PATCH 02/32] Add stepInstant

---
 automaton/src/Data/Stream/Except.hs | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/automaton/src/Data/Stream/Except.hs b/automaton/src/Data/Stream/Except.hs
index 6a92b6be..a29bd190 100644
--- a/automaton/src/Data/Stream/Except.hs
+++ b/automaton/src/Data/Stream/Except.hs
@@ -1,6 +1,7 @@
 module Data.Stream.Except where
 
 -- base
+import Control.Category ((>>>))
 import Control.Monad (ap)
 import Data.Void
 
@@ -20,6 +21,7 @@ import Data.Stream.Optimized (OptimizedStreamT, applyExcept, constM, selectExcep
 import Data.Stream.Optimized qualified as StreamOptimized
 import Data.Stream.Recursive (Recursive (..))
 import Data.Stream.Recursive.Except
+import Data.Stream.Result
 
 {- | A stream that can terminate with an exception.
 
@@ -47,6 +49,20 @@ runStreamExcept :: StreamExcept a m e -> OptimizedStreamT (ExceptT e m) a
 runStreamExcept (RecursiveExcept coalgebraic) = StreamOptimized.fromRecursive coalgebraic
 runStreamExcept (CoalgebraicExcept coalgebraic) = coalgebraic
 
+-- | Try to step the 'StreamExcept' for one value of the stream
+stepInstant :: (Functor m) => StreamExcept a m e -> m (Either e (Result (StreamExcept a m e) a))
+stepInstant (RecursiveExcept recursive) =
+  recursive
+    & getRecursive
+    & runExceptT
+    <&> fmap (mapResultState RecursiveExcept)
+stepInstant (CoalgebraicExcept coalgebraic) =
+  coalgebraic
+    & StreamOptimized.stepOptimizedStream
+    & runExceptT
+    <&> fmap (mapResultState InitialExcept)
+
+-- FIXME This should work with Functor m and custom hoists
 instance (Monad m) => Functor (StreamExcept a m) where
   fmap f (RecursiveExcept fe) = RecursiveExcept $ hoist (withExceptT f) fe
   fmap f (CoalgebraicExcept ae) = CoalgebraicExcept $ hoist (withExceptT f) ae

From d698740aae9c105cfe92db519be5bb3cf093659a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 30 Dec 2024 12:22:07 +0100
Subject: [PATCH 03/32] Fix naming in runStreamExcept

---
 automaton/src/Data/Stream/Except.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/automaton/src/Data/Stream/Except.hs b/automaton/src/Data/Stream/Except.hs
index a29bd190..7dec1c97 100644
--- a/automaton/src/Data/Stream/Except.hs
+++ b/automaton/src/Data/Stream/Except.hs
@@ -46,7 +46,7 @@ toRecursive (RecursiveExcept recursive) = recursive
 toRecursive (CoalgebraicExcept coalgebraic) = StreamOptimized.toRecursive coalgebraic
 
 runStreamExcept :: StreamExcept a m e -> OptimizedStreamT (ExceptT e m) a
-runStreamExcept (RecursiveExcept coalgebraic) = StreamOptimized.fromRecursive coalgebraic
+runStreamExcept (RecursiveExcept recursive) = StreamOptimized.fromRecursive recursive
 runStreamExcept (CoalgebraicExcept coalgebraic) = coalgebraic
 
 -- | Try to step the 'StreamExcept' for one value of the stream

From 343264c6358cfc05b9d21ae3cc98ef4001b6b9f4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 30 Dec 2024 12:20:57 +0100
Subject: [PATCH 04/32] Add Foldable and Traversable instances

---
 automaton/src/Data/Stream.hs           |  9 +++++++++
 automaton/src/Data/Stream/Except.hs    | 19 +++++++++++++++++++
 automaton/src/Data/Stream/Optimized.hs |  4 +++-
 automaton/src/Data/Stream/Recursive.hs |  8 ++++++++
 4 files changed, 39 insertions(+), 1 deletion(-)

diff --git a/automaton/src/Data/Stream.hs b/automaton/src/Data/Stream.hs
index 822e8d8d..2c2862e8 100644
--- a/automaton/src/Data/Stream.hs
+++ b/automaton/src/Data/Stream.hs
@@ -11,6 +11,7 @@ module Data.Stream where
 import Control.Applicative (Alternative (..), Applicative (..), liftA2)
 import Control.Monad ((<$!>))
 import Data.Bifunctor (bimap)
+import Data.Function ((&))
 import Data.Monoid (Ap (..))
 import Prelude hiding (Applicative (..))
 
@@ -116,6 +117,14 @@ instance (Applicative m) => Applicative (StreamT m) where
     StreamT (JointState stateF0 stateA0) (\(JointState stateF stateA) -> apResult <$> stepF stateF <*> stepA stateA)
   {-# INLINE (<*>) #-}
 
+instance (Foldable m) => Foldable (StreamT m) where
+  foldMap f StreamT {state, step} = go state
+    where
+      go s = step s & foldMap (\(Result s' a) -> f a <> go s')
+
+instance (Traversable m, Functor m) => Traversable (StreamT m) where
+  traverse f = fmap fromRecursive . traverse f . toRecursive
+
 deriving via Ap (StreamT m) a instance (Applicative m, Num a) => Num (StreamT m a)
 
 instance (Applicative m, Fractional a) => Fractional (StreamT m a) where
diff --git a/automaton/src/Data/Stream/Except.hs b/automaton/src/Data/Stream/Except.hs
index 7dec1c97..0d2aabb4 100644
--- a/automaton/src/Data/Stream/Except.hs
+++ b/automaton/src/Data/Stream/Except.hs
@@ -3,6 +3,9 @@ module Data.Stream.Except where
 -- base
 import Control.Category ((>>>))
 import Control.Monad (ap)
+import Data.Bifunctor (bimap)
+import Data.Function ((&))
+import Data.Functor ((<&>))
 import Data.Void
 
 -- transformers
@@ -62,6 +65,22 @@ stepInstant (CoalgebraicExcept coalgebraic) =
     & runExceptT
     <&> fmap (mapResultState InitialExcept)
 
+-- | Run all steps of the stream, discarding all output, until the exception is reached.
+instance (Functor m, Foldable m) => Foldable (StreamExcept a m) where
+  foldMap f = stepInstant >>> foldMap (either f $ resultState >>> foldMap f)
+
+instance (Traversable m) => Traversable (StreamExcept a m) where
+  traverse f streamExcept = traverseFinal (toFinal streamExcept) & fmap (Final >>> FinalExcept)
+    where
+      traverseFinal =
+        getFinal
+          >>> runExceptT
+          >>> fmap ((bimap f $ mapResultState traverseFinal >>> (\Result {resultState, output} -> (Result <$> resultState) <&> ($ output))) >>> bitraverseEither)
+          >>> traverse id
+          >>> fmap (ExceptT >>> fmap (mapResultState Final))
+      bitraverseEither :: (Functor f) => Either (f a) (f b) -> f (Either a b)
+      bitraverseEither = either (fmap Left) (fmap Right)
+
 -- FIXME This should work with Functor m and custom hoists
 instance (Monad m) => Functor (StreamExcept a m) where
   fmap f (RecursiveExcept fe) = RecursiveExcept $ hoist (withExceptT f) fe
diff --git a/automaton/src/Data/Stream/Optimized.hs b/automaton/src/Data/Stream/Optimized.hs
index 9f00ab42..78cf0d58 100644
--- a/automaton/src/Data/Stream/Optimized.hs
+++ b/automaton/src/Data/Stream/Optimized.hs
@@ -1,4 +1,6 @@
+{-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -51,7 +53,7 @@ data OptimizedStreamT m a
     Stateful (StreamT m a)
   | -- | A stateless stream is simply an action in a monad which is performed repetitively.
     Stateless (m a)
-  deriving (Functor)
+  deriving (Functor, Foldable, Traversable)
 
 {- | Remove the optimization layer.
 
diff --git a/automaton/src/Data/Stream/Recursive.hs b/automaton/src/Data/Stream/Recursive.hs
index 89fe476e..e1c7bd55 100644
--- a/automaton/src/Data/Stream/Recursive.hs
+++ b/automaton/src/Data/Stream/Recursive.hs
@@ -61,3 +61,11 @@ instance (Alternative m) => Alternative (Recursive m) where
   empty = constM empty
 
   Recursive ma1 <|> Recursive ma2 = Recursive $ ma1 <|> ma2
+
+instance (Foldable m) => Foldable (Recursive m) where
+  foldMap f Recursive {getRecursive} = foldMap (\(Result Recursive a) -> f a <> foldMap f Recursive) getRecursive
+
+instance (Traversable m) => Traversable (Recursive m) where
+  traverse f = go
+    where
+      go Recursive {getRecursive} = (getRecursive & traverse (\(Result cont a) -> flip Result <$> f a <*> go cont)) <&> Recursive

From 7d32c7d8f875fa8509728e753115996f69b738fc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Wed, 26 Jun 2024 20:12:47 +0200
Subject: [PATCH 05/32] Add mmap

---
 automaton/src/Data/Stream.hs           | 12 ++++++++++++
 automaton/src/Data/Stream/Optimized.hs |  6 ++++++
 automaton/src/Data/Stream/Recursive.hs |  8 ++++++++
 3 files changed, 26 insertions(+)

diff --git a/automaton/src/Data/Stream.hs b/automaton/src/Data/Stream.hs
index 2c2862e8..e0171fdc 100644
--- a/automaton/src/Data/Stream.hs
+++ b/automaton/src/Data/Stream.hs
@@ -443,3 +443,15 @@ loop at runtime due to the coalgebraic encoding of the state.
 fixA :: (Applicative m) => StreamT m (a -> a) -> StreamT m a
 fixA StreamT {state, step} = fixStream (JointState state) $
   \stepA (JointState s ss) -> apResult <$> step s <*> stepA ss
+
+-- | Similar to 'fmap', but the function is allowed to perform a side effect in a monad @m@.
+mmap :: (Monad m) => (a -> m b) -> StreamT m a -> StreamT m b
+mmap f StreamT {state, step} =
+  StreamT
+    { state
+    , step = \s -> do
+        Result s' a <- step s
+        b <- f a
+        return $ Result s' b
+    }
+{-# INLINE mmap #-}
diff --git a/automaton/src/Data/Stream/Optimized.hs b/automaton/src/Data/Stream/Optimized.hs
index 78cf0d58..566d1e9f 100644
--- a/automaton/src/Data/Stream/Optimized.hs
+++ b/automaton/src/Data/Stream/Optimized.hs
@@ -222,3 +222,9 @@ applyExcept streamF streamA = Stateful $ StreamT.applyExcept (toStreamT streamF)
 selectExcept :: (Monad m) => OptimizedStreamT (ExceptT (Either e1 e2) m) a -> OptimizedStreamT (ExceptT (e1 -> e2) m) a -> OptimizedStreamT (ExceptT e2 m) a
 selectExcept streamE streamF = Stateful $ StreamT.selectExcept (toStreamT streamE) (toStreamT streamF)
 {-# INLINE selectExcept #-}
+
+-- | Similar to 'fmap', but the function is allowed to perform a side effect in a monad @m@.
+mmap :: (Monad m) => (a -> m b) -> OptimizedStreamT m a -> OptimizedStreamT m b
+mmap f (Stateful stream) = Stateful $ StreamT.mmap f stream
+mmap f (Stateless g) = Stateless $ g >>= f
+{-# INLINE mmap #-}
diff --git a/automaton/src/Data/Stream/Recursive.hs b/automaton/src/Data/Stream/Recursive.hs
index e1c7bd55..2aa8782f 100644
--- a/automaton/src/Data/Stream/Recursive.hs
+++ b/automaton/src/Data/Stream/Recursive.hs
@@ -69,3 +69,11 @@ instance (Traversable m) => Traversable (Recursive m) where
   traverse f = go
     where
       go Recursive {getRecursive} = (getRecursive & traverse (\(Result cont a) -> flip Result <$> f a <*> go cont)) <&> Recursive
+
+-- | Similar to 'fmap', but the function is allowed to perform a side effect in a monad @m@.
+mmap :: (Monad m) => (a -> m b) -> Recursive m a -> Recursive m b
+mmap f recursive = Recursive $ do
+  Result recursive' a <- getRecursive recursive
+  b <- f a
+  return $ Result (mmap f recursive') b
+{-# INLINE mmap #-}

From c153f86cb8050106c3fb312109edbb0c3182fe4f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Tue, 25 Jun 2024 14:18:15 +0200
Subject: [PATCH 06/32] Move toRecursive and fromRecursive

---
 automaton/src/Data/Stream.hs           | 21 +++++++++++++++++++++
 automaton/src/Data/Stream/Optimized.hs |  5 ++---
 automaton/src/Data/Stream/Recursive.hs | 23 +----------------------
 3 files changed, 24 insertions(+), 25 deletions(-)

diff --git a/automaton/src/Data/Stream.hs b/automaton/src/Data/Stream.hs
index e0171fdc..78bd66d7 100644
--- a/automaton/src/Data/Stream.hs
+++ b/automaton/src/Data/Stream.hs
@@ -36,6 +36,7 @@ import Data.Align
 
 -- automaton
 import Data.Stream.Internal
+import Data.Stream.Recursive (Recursive (..))
 import Data.Stream.Result
 
 -- * Creating streams
@@ -104,6 +105,26 @@ constM :: (Functor m) => m a -> StreamT m a
 constM ma = StreamT () $ const $ Result () <$> ma
 {-# INLINE constM #-}
 
+{- | Translate a coalgebraically encoded stream into a recursive one.
+
+This is usually a performance penalty.
+-}
+toRecursive :: (Functor m) => StreamT m a -> Recursive m a
+toRecursive automaton = Recursive $ mapResultState toRecursive <$> stepStream automaton
+{-# INLINE toRecursive #-}
+
+{- | Translate a recursive stream into a coalgebraically encoded one.
+
+The internal state is the stream itself.
+-}
+fromRecursive :: Recursive m a -> StreamT m a
+fromRecursive coalgebraic =
+  StreamT
+    { state = coalgebraic
+    , step = getRecursive
+    }
+{-# INLINE fromRecursive #-}
+
 instance (Functor m) => Functor (StreamT m) where
   fmap f StreamT {state, step} = StreamT state $! fmap (fmap f) <$> step
   {-# INLINE fmap #-}
diff --git a/automaton/src/Data/Stream/Optimized.hs b/automaton/src/Data/Stream/Optimized.hs
index 566d1e9f..03273781 100644
--- a/automaton/src/Data/Stream/Optimized.hs
+++ b/automaton/src/Data/Stream/Optimized.hs
@@ -37,7 +37,6 @@ import Data.Semialign (Align (..), Semialign (..))
 import Data.Stream hiding (hoist')
 import Data.Stream qualified as StreamT
 import Data.Stream.Recursive (Recursive (..))
-import Data.Stream.Recursive qualified as Recursive (fromRecursive, toRecursive)
 import Data.Stream.Result
 
 {- | An optimized version of 'StreamT' which has an extra constructor for stateless streams.
@@ -190,7 +189,7 @@ stepOptimizedStream oa@(Stateless m) = Result oa <$> m
 This will typically be a performance penalty.
 -}
 toRecursive :: (Functor m) => OptimizedStreamT m a -> Recursive m a
-toRecursive (Stateful stream) = Recursive.toRecursive stream
+toRecursive (Stateful stream) = StreamT.toRecursive stream
 toRecursive (Stateless f) = go
   where
     go = Recursive $ Result go <$> f
@@ -200,7 +199,7 @@ toRecursive (Stateless f) = go
   The internal state is the stream itself.
 -}
 fromRecursive :: Recursive m a -> OptimizedStreamT m a
-fromRecursive = Stateful . Recursive.fromRecursive
+fromRecursive = Stateful . StreamT.fromRecursive
 {-# INLINE fromRecursive #-}
 
 -- | See 'Data.Stream.concatS'.
diff --git a/automaton/src/Data/Stream/Recursive.hs b/automaton/src/Data/Stream/Recursive.hs
index 2aa8782f..36497ae1 100644
--- a/automaton/src/Data/Stream/Recursive.hs
+++ b/automaton/src/Data/Stream/Recursive.hs
@@ -7,7 +7,6 @@ import Control.Applicative (Alternative (..))
 import Control.Monad.Morph (MFunctor (..))
 
 -- automaton
-import Data.Stream (StreamT (..), stepStream)
 import Data.Stream.Result
 
 {- | A stream transformer in recursive encoding.
@@ -16,26 +15,6 @@ One step of the stream transformer performs a monadic action and results in an o
 -}
 newtype Recursive m a = Recursive {getRecursive :: m (Result (Recursive m a) a)}
 
-{- | Translate a coalgebraically encoded stream into a recursive one.
-
-This is usually a performance penalty.
--}
-toRecursive :: (Functor m) => StreamT m a -> Recursive m a
-toRecursive automaton = Recursive $ mapResultState toRecursive <$> stepStream automaton
-{-# INLINE toRecursive #-}
-
-{- | Translate a recursive stream into a coalgebraically encoded one.
-
-The internal state is the stream itself.
--}
-fromRecursive :: Recursive m a -> StreamT m a
-fromRecursive coalgebraic =
-  StreamT
-    { state = coalgebraic
-    , step = getRecursive
-    }
-{-# INLINE fromRecursive #-}
-
 instance MFunctor Recursive where
   hoist morph = go
     where
@@ -63,7 +42,7 @@ instance (Alternative m) => Alternative (Recursive m) where
   Recursive ma1 <|> Recursive ma2 = Recursive $ ma1 <|> ma2
 
 instance (Foldable m) => Foldable (Recursive m) where
-  foldMap f Recursive {getRecursive} = foldMap (\(Result Recursive a) -> f a <> foldMap f Recursive) getRecursive
+  foldMap f Recursive {getRecursive} = foldMap (\(Result recursive a) -> f a <> foldMap f recursive) getRecursive
 
 instance (Traversable m) => Traversable (Recursive m) where
   traverse f = go

From 2549fba23dfd13bb5f757712874d8e7548a9b182 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 30 Dec 2024 13:48:44 +0100
Subject: [PATCH 07/32] Simplify type signature of handleAutomaton

---
 automaton/src/Data/Automaton.hs        | 7 +++++--
 automaton/src/Data/Stream/Optimized.hs | 2 +-
 2 files changed, 6 insertions(+), 3 deletions(-)

diff --git a/automaton/src/Data/Automaton.hs b/automaton/src/Data/Automaton.hs
index 2d0a5e30..accf033c 100644
--- a/automaton/src/Data/Automaton.hs
+++ b/automaton/src/Data/Automaton.hs
@@ -453,8 +453,11 @@ parallely Automaton {getAutomaton = Stateless f} = Automaton $ Stateless $ Reade
 handleAutomaton_ :: (Monad m) => (forall m. (Monad m) => StreamT m a -> StreamT m b) -> Automaton m i a -> Automaton m i b
 handleAutomaton_ f = Automaton . StreamOptimized.withOptimized f . getAutomaton
 
--- | Given a transformation of streams, apply it to an automaton. The input can be accessed through the 'ReaderT' effect.
-handleAutomaton :: (Monad m) => (StreamT (ReaderT a m) b -> StreamT (ReaderT c n) d) -> Automaton m a b -> Automaton n c d
+{- | Given a transformation of streams, apply it to an automaton. The input can be accessed through the 'ReaderT' effect.
+
+In contrast to 'handleAutomaton_', the functor type can change.
+-}
+handleAutomaton :: (Functor m) => (StreamT (ReaderT a m) b -> StreamT (ReaderT c n) d) -> Automaton m a b -> Automaton n c d
 handleAutomaton f = Automaton . StreamOptimized.handleOptimized f . getAutomaton
 
 {- | Buffer the output of an automaton. See 'Data.Stream.concatS'.
diff --git a/automaton/src/Data/Stream/Optimized.hs b/automaton/src/Data/Stream/Optimized.hs
index 03273781..028ae58a 100644
--- a/automaton/src/Data/Stream/Optimized.hs
+++ b/automaton/src/Data/Stream/Optimized.hs
@@ -153,7 +153,7 @@ withOptimized f stream = Stateful $ f $ toStreamT stream
 
 {- | Map a morphism of streams to optimized streams.
 
-In contrast to 'withOptimized', the monad type is allowed to change.
+In contrast to 'withOptimized', the functor type is allowed to change.
 -}
 handleOptimized :: (Functor m) => (StreamT m a -> StreamT n b) -> OptimizedStreamT m a -> OptimizedStreamT n b
 handleOptimized f stream = Stateful $ f $ toStreamT stream

From b0fb98db02b32616b3bee099cbfb7c33c34370d0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Tue, 25 Jun 2024 14:18:55 +0200
Subject: [PATCH 08/32] parallely and applying

---
 automaton/automaton.cabal       |  2 +
 automaton/src/Data/Automaton.hs | 96 ++++++++++++++++++++++++++++-----
 automaton/src/Data/Stream.hs    |  2 +-
 automaton/test/Automaton.hs     | 12 ++++-
 4 files changed, 98 insertions(+), 14 deletions(-)

diff --git a/automaton/automaton.cabal b/automaton/automaton.cabal
index bdb4781f..8e282a01 100644
--- a/automaton/automaton.cabal
+++ b/automaton/automaton.cabal
@@ -38,6 +38,7 @@ common opts
     simple-affine-space ^>=0.2,
     these >=1.1 && <=1.3,
     transformers >=0.5,
+    witherable ^>=0.4,
 
   if flag(dev)
     ghc-options: -Werror
@@ -103,6 +104,7 @@ test-suite automaton-test
     tasty >=1.4 && <1.6,
     tasty-hunit ^>=0.10,
     tasty-quickcheck >=0.10 && <0.12,
+    containers >=0.5,
 
 executable UserSawtooth
   import: opts
diff --git a/automaton/src/Data/Automaton.hs b/automaton/src/Data/Automaton.hs
index accf033c..cd712330 100644
--- a/automaton/src/Data/Automaton.hs
+++ b/automaton/src/Data/Automaton.hs
@@ -44,6 +44,12 @@ import Data.VectorSpace (VectorSpace (..))
 -- align
 import Data.Semialign (Align (..), Semialign (..))
 
+-- these
+import Data.These (these)
+
+-- witherable
+import Witherable (Filterable (..))
+
 -- automaton
 import Data.Stream (StreamT (..), fixStream)
 import Data.Stream.Internal (JointState (..))
@@ -80,8 +86,8 @@ automaton2 :: Automaton m b c
 sequentially :: Automaton m a c
 sequentially = automaton1 >>> automaton2
 
-parallely :: Automaton m (a, b) (b, c)
-parallely = automaton1 *** automaton2
+inParallel :: Automaton m (a, b) (b, c)
+inParallel = automaton1 *** automaton2
 @
 In sequential composition, the output of the first automaton is passed as input to the second one.
 In parallel composition, both automata receive input simulataneously and process it independently.
@@ -432,22 +438,88 @@ traverseS = traverse'
 traverseS_ :: (Monad m, Traversable f) => Automaton m a b -> Automaton m (f a) ()
 traverseS_ automaton = traverse' automaton >>> arr (const ())
 
-{- | Launch arbitrarily many copies of the automaton in parallel.
+-- TODO But should we use parallelism?
+-- https://hackage.haskell.org/package/parallel-3.1.0.1/docs/Control-Parallel-Strategies.html#v:parTraversable
+
+{- | Launch arbitrarily many copies of the automaton in parallel, according to the shape of the input data.
+
+* The copies of the automaton are launched on demand as the shape of the input grows.
+* The automaton copy at a certain position will always receive the input at that position (if it is supplied).
+* If the input data is smaller than the automaton copies, the uncovered automata will not be stepped.
+
+The behaviour for some typical example types:
 
-* The copies of the automaton are launched on demand as the input lists grow.
-* The n-th copy will always receive the n-th input.
-* If the input list has length n, the n+1-th automaton copy will not be stepped.
+* Lists: The copies of the automaton are launched on demand as the input lists grow
+  The n-th copy will always receive the n-th input.
+  If the input list has length n, the n+1-th automaton copy will not be stepped.
+* 'Maybe': As soon as a 'Just' is received, an automaton is started. It is stepped only when more 'Just' values arrive.
+* 'Map': Whenever an input for a new key arrives, a new automaton is started.
 
-Caution: Uses memory of the order of the largest list that was ever input during runtime.
+Caution: Uses memory of the order of the largest shape that was ever input during runtime.
+
+Note: "in parallel" refers purely the data model, it does not mean that multiple cores are used for the computations.
 -}
-parallely :: (Applicative m) => Automaton m a b -> Automaton m [a] [b]
+parallely :: (Applicative m, Traversable t, Align t, Filterable t) => Automaton m a b -> Automaton m (t a) (t b)
 parallely Automaton {getAutomaton = Stateful stream} = Automaton $ Stateful $ parallely' stream
   where
-    parallely' :: (Applicative m) => StreamT (ReaderT a m) b -> StreamT (ReaderT [a] m) [b]
-    parallely' StreamT {state, step} = fixStream (JointState state) $ \fixstep jointState@(JointState s fixstate) -> ReaderT $ \case
-      [] -> pure $! Result jointState []
-      (a : as) -> apResult . fmap (:) <$> runReaderT (step s) a <*> runReaderT (fixstep fixstate) as
+    parallely' :: (Applicative m, Traversable t, Align t, Filterable t) => StreamT (ReaderT a m) b -> StreamT (ReaderT (t a) m) (t b)
+    parallely' StreamT {state, step} =
+      StreamT
+        { state = nil
+        , step = \s -> ReaderT $ \as ->
+            -- Analyse at which positions there is state or input
+            align s as
+              & traverse
+                ( these
+                    -- There is state at this position, but no input, don't do anything
+                    (\s -> pure $ Result s Nothing)
+                    -- There is no state yet at this position, but input. Perform the step, initialising with the original initial state
+                    (fmap (fmap Just) . runReaderT (step state))
+                    -- There is already state, and there is input. Perform the step normally
+                    (\s a -> fmap Just <$> runReaderT (step s) a)
+                )
+              <&> ( \sas ->
+                      Result
+                        -- Keep all the resulting states
+                        (resultState <$> sas)
+                        -- Wither the output shape by removing all positions where no step has been performed
+                        (Witherable.mapMaybe output sas)
+                  )
+        }
 parallely Automaton {getAutomaton = Stateless f} = Automaton $ Stateless $ ReaderT $ traverse $ runReaderT f
+{-# INLINE parallely #-}
+
+{- | Run multiple copies of the same 'Automaton', applying new input shapes to an accumulated one.
+
+* The state is initialized as 'pure'
+* As more input in an @f@ shape arrives, it is applied as an effect in the state using the 'Applicative' instance of @f@
+
+Caution: The state grows depending on how @'Applicative' f@ is implemented.
+For example, for lists the size of the state is proportional to the /product/ of all inputs that have arrived.
+I.e. it grows exponentially for constantly bigger-than-1 sized lists, and drops to 0 once an empty list is added.
+
+The behaviour for some typical example types:
+
+* Lists: The input lists are interpreted as nondeterministic choices, and for every possible combination of choices, one automaton is run, and all output lists concatenated.
+* 'Maybe': The automaton is stepped normally on 'Just' values, and stopped on 'Nothing', never outputting any other value than 'Nothing'.
+* 'Either': Like 'Maybe', but with an exception value.
+* 'ZipList': The output is the size of the /smallest/ list ever input, and the state is shrunk every time the input is smaller than before.
+-}
+
+-- FIXME unit test all of these
+applying :: (Applicative m, Traversable f, Applicative f) => Automaton m a b -> Automaton m (f a) (f b)
+applying = handleAutomaton applying'
+  where
+    applying' :: (Applicative m, Traversable f, Applicative f) => StreamT (ReaderT a m) b -> StreamT (ReaderT (f a) m) (f b)
+    applying' StreamT {state, step} =
+      StreamT
+        { state = pure state
+        , step = \s -> ReaderT $ \as ->
+            (runReaderT . step <$> s <*> as)
+              & sequenceA
+              & fmap unzipResult
+        }
+{-# INLINE applying #-}
 
 -- | Given a transformation of streams, apply it to an automaton, without changing the input.
 handleAutomaton_ :: (Monad m) => (forall m. (Monad m) => StreamT m a -> StreamT m b) -> Automaton m i a -> Automaton m i b
diff --git a/automaton/src/Data/Stream.hs b/automaton/src/Data/Stream.hs
index 78bd66d7..32c17bfd 100644
--- a/automaton/src/Data/Stream.hs
+++ b/automaton/src/Data/Stream.hs
@@ -75,7 +75,7 @@ An stream defined thusly will typically hang and/or leak memory, trying to build
 
 It is nevertheless possible to define streams recursively, but one needs to first identify the recursive definition of its /state type/.
 Then for the greatest generality, 'fixStream' and 'fixStream'' can be used, and some special cases are covered by functions
-such as 'fixA', 'Data.Automaton.parallely', 'many' and 'some'.
+such as 'fixA', 'many' and 'some'.
 -}
 data StreamT m a = forall s.
   StreamT
diff --git a/automaton/test/Automaton.hs b/automaton/test/Automaton.hs
index 9f211437..812863b3 100644
--- a/automaton/test/Automaton.hs
+++ b/automaton/test/Automaton.hs
@@ -14,6 +14,9 @@ import Data.Maybe (maybeToList)
 -- transformers
 import Control.Monad.State.Strict (StateT (..))
 
+-- containers
+import Data.Map.Strict qualified as M
+
 -- selective
 import Control.Selective ((<*?))
 
@@ -58,7 +61,14 @@ tests =
         ]
     , testGroup
         "parallely"
-        [ testCase "Outputs separate sums" $ runIdentity (embed (parallely sumN) [[], [], [1, 2], [10, 20], [100], [], [1000, 200]]) @?= [[], [], [1, 2], [11, 22], [111], [], [1111, 222]]
+        [ testCase "Outputs separate sums (lists)" $
+            runIdentity
+              (embed (parallely sumN) [[], [], [1, 2], [10, 20], [100], [], [1000, 200]])
+              @?= [[], [], [1, 2], [11, 22], [111], [], [1111, 222]]
+        , testCase "Outputs separate sums (maps)" $
+            runIdentity
+              (embed (parallely sumN) (M.fromAscList <$> [[], [], [(1, 1)], [(2, 2)], [(1, 10)], [(1, 100), (2, 20)]]))
+              @?= (M.fromAscList <$> [[], [], [(1, 1)], [(2, 2)], [(1, 11)], [(1, 111), (2, 22)]])
         ]
     , testGroup
         "Selective"

From 23b4c065e1ece95d978df377047d512c8c3e3c13 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Wed, 26 Jun 2024 20:05:33 +0200
Subject: [PATCH 09/32] Avoid mtl dependency where possible

---
 automaton/test/Automaton.hs             | 2 +-
 automaton/test/Automaton/Except.hs      | 2 +-
 automaton/test/Automaton/Trans/Accum.hs | 2 +-
 automaton/test/Stream.hs                | 2 +-
 4 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/automaton/test/Automaton.hs b/automaton/test/Automaton.hs
index 812863b3..3c862ac3 100644
--- a/automaton/test/Automaton.hs
+++ b/automaton/test/Automaton.hs
@@ -12,7 +12,7 @@ import Data.List (uncons)
 import Data.Maybe (maybeToList)
 
 -- transformers
-import Control.Monad.State.Strict (StateT (..))
+import Control.Monad.Trans.State.Strict (StateT (..))
 
 -- containers
 import Data.Map.Strict qualified as M
diff --git a/automaton/test/Automaton/Except.hs b/automaton/test/Automaton/Except.hs
index 9014462e..b4f1fc1d 100644
--- a/automaton/test/Automaton/Except.hs
+++ b/automaton/test/Automaton/Except.hs
@@ -1,7 +1,7 @@
 module Automaton.Except where
 
 -- base
-import Control.Monad.Identity (Identity (runIdentity))
+import Data.Functor.Identity (Identity (runIdentity))
 
 -- tasty
 import Test.Tasty (testGroup)
diff --git a/automaton/test/Automaton/Trans/Accum.hs b/automaton/test/Automaton/Trans/Accum.hs
index fd7a5f46..81fb09be 100644
--- a/automaton/test/Automaton/Trans/Accum.hs
+++ b/automaton/test/Automaton/Trans/Accum.hs
@@ -1,7 +1,7 @@
 module Automaton.Trans.Accum where
 
 -- base
-import Control.Monad.Identity (Identity (runIdentity))
+import Data.Functor.Identity (Identity (runIdentity))
 import Data.Monoid (Sum (..))
 
 -- transformers
diff --git a/automaton/test/Stream.hs b/automaton/test/Stream.hs
index 860acf14..182e711c 100644
--- a/automaton/test/Stream.hs
+++ b/automaton/test/Stream.hs
@@ -1,7 +1,7 @@
 module Stream where
 
 -- base
-import Control.Monad.Identity (Identity (..))
+import Data.Functor.Identity (Identity (..))
 
 -- selective
 import Control.Selective

From 8f5ec758f4ce50981f523d6d0dea3a9aa708c4f8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 30 Dec 2024 18:43:52 +0100
Subject: [PATCH 10/32] Add arr'

---
 automaton/src/Data/Automaton.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/automaton/src/Data/Automaton.hs b/automaton/src/Data/Automaton.hs
index cd712330..19135ed9 100644
--- a/automaton/src/Data/Automaton.hs
+++ b/automaton/src/Data/Automaton.hs
@@ -269,6 +269,10 @@ instance (Monad m) => ArrowChoice (Automaton m) where
       untag (Right y) = y
   {-# INLINE (|||) #-}
 
+-- | Like 'arr', but requires only 'Applicative'
+arr' :: (Applicative m) => (a -> b) -> Automaton m a b
+arr' f = Automaton $! Stateless $! ReaderT $ pure . f
+
 -- | Caution, this can make your program hang. Try to use 'feedback' or 'unfold' where possible, or combine 'loop' with 'delay'.
 instance (MonadFix m) => ArrowLoop (Automaton m) where
   loop (Automaton (Stateless ma)) = Automaton $! Stateless $! ReaderT (\b -> fst <$> mfix ((. snd) $ ($ b) $ curry $ runReaderT ma))

From 88346f0161f3adffeca00877775ff8ac7eefdf50 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 30 Dec 2024 18:44:11 +0100
Subject: [PATCH 11/32] Relax constraints for Strong and Choice

---
 automaton/src/Data/Automaton.hs | 80 +++++++++++++++++----------------
 1 file changed, 42 insertions(+), 38 deletions(-)

diff --git a/automaton/src/Data/Automaton.hs b/automaton/src/Data/Automaton.hs
index 19135ed9..bc502f76 100644
--- a/automaton/src/Data/Automaton.hs
+++ b/automaton/src/Data/Automaton.hs
@@ -56,6 +56,7 @@ import Data.Stream.Internal (JointState (..))
 import Data.Stream.Optimized (
   OptimizedStreamT (..),
   concatS,
+  hoist',
   stepOptimizedStream,
  )
 import Data.Stream.Optimized qualified as StreamOptimized
@@ -185,19 +186,7 @@ instance (Monad m) => Arrow (Automaton m) where
   arr f = Automaton $! Stateless $! asks f
   {-# INLINE arr #-}
 
-  first (Automaton (Stateful StreamT {state, step})) =
-    Automaton $!
-      Stateful $!
-        StreamT
-          { state
-          , step = \s ->
-              ReaderT
-                ( \(b, d) ->
-                    fmap (,d)
-                      <$> runReaderT (step s) b
-                )
-          }
-  first (Automaton (Stateless m)) = Automaton $ Stateless $ ReaderT $ \(b, d) -> (,d) <$> runReaderT m b
+  first = first'
   {-# INLINE first #-}
 
 instance (Monad m) => ArrowChoice (Automaton m) where
@@ -243,24 +232,10 @@ instance (Monad m) => ArrowChoice (Automaton m) where
             (runReaderT . fmap Right $ mR)
   {-# INLINE (+++) #-}
 
-  left (Automaton (Stateful (StreamT {state, step}))) =
-    Automaton $!
-      Stateful $!
-        StreamT
-          { state
-          , step = \s -> ReaderT $ either (fmap (fmap Left) . runReaderT (step s)) (pure . Result s . Right)
-          }
-  left (Automaton (Stateless ma)) = Automaton $! Stateless $! ReaderT $! either (fmap Left . runReaderT ma) (pure . Right)
+  left = left'
   {-# INLINE left #-}
 
-  right (Automaton (Stateful (StreamT {state, step}))) =
-    Automaton $!
-      Stateful $!
-        StreamT
-          { state
-          , step = \s -> ReaderT $ either (pure . Result s . Left) (fmap (fmap Right) . runReaderT (step s))
-          }
-  right (Automaton (Stateless ma)) = Automaton $! Stateless $! ReaderT $! either (pure . Left) (fmap Right . runReaderT ma)
+  right = right'
   {-# INLINE right #-}
 
   f ||| g = f +++ g >>> arr untag
@@ -395,18 +370,47 @@ withAutomaton :: (Functor m1, Functor m2) => (forall s. (a1 -> m1 (Result s b1))
 withAutomaton f = Automaton . StreamOptimized.mapOptimizedStreamT (ReaderT . f . runReaderT) . getAutomaton
 {-# INLINE withAutomaton #-}
 
-instance (Monad m) => Profunctor (Automaton m) where
-  dimap f g Automaton {getAutomaton} = Automaton $ g <$> hoist (withReaderT f) getAutomaton
-  lmap f Automaton {getAutomaton} = Automaton $ hoist (withReaderT f) getAutomaton
+instance (Functor m) => Profunctor (Automaton m) where
+  dimap f g Automaton {getAutomaton} = Automaton $ g <$> hoist' (withReaderT f) getAutomaton
+  lmap f Automaton {getAutomaton} = Automaton $ hoist' (withReaderT f) getAutomaton
   rmap = fmap
 
-instance (Monad m) => Choice (Automaton m) where
-  right' = right
-  left' = left
+instance (Applicative m) => Choice (Automaton m) where
+  right' (Automaton (Stateful (StreamT {state, step}))) =
+    Automaton $!
+      Stateful $!
+        StreamT
+          { state
+          , step = \s -> ReaderT $ either (pure . Result s . Left) (fmap (fmap Right) . runReaderT (step s))
+          }
+  right' (Automaton (Stateless ma)) = Automaton $! Stateless $! ReaderT $! either (pure . Left) (fmap Right . runReaderT ma)
+  {-# INLINE right' #-}
+
+  left' (Automaton (Stateful (StreamT {state, step}))) =
+    Automaton $!
+      Stateful $!
+        StreamT
+          { state
+          , step = \s -> ReaderT $ either (fmap (fmap Left) . runReaderT (step s)) (pure . Result s . Right)
+          }
+  left' (Automaton (Stateless ma)) = Automaton $! Stateless $! ReaderT $! either (fmap Left . runReaderT ma) (pure . Right)
+  {-# INLINE left' #-}
 
-instance (Monad m) => Strong (Automaton m) where
-  second' = second
-  first' = first
+instance (Applicative m) => Strong (Automaton m) where
+  first' (Automaton (Stateful StreamT {state, step})) =
+    Automaton $!
+      Stateful $!
+        StreamT
+          { state
+          , step = \s ->
+              ReaderT
+                ( \(b, d) ->
+                    fmap (,d)
+                      <$> runReaderT (step s) b
+                )
+          }
+  first' (Automaton (Stateless m)) = Automaton $ Stateless $ ReaderT $ \(b, d) -> (,d) <$> runReaderT m b
+  {-# INLINE first' #-}
 
 -- | Step an automaton several steps at once, depending on how long the input is.
 instance (Monad m) => Traversing (Automaton m) where

From 85ada3a03a9f8d271b3fedd0ffba3908333da196 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 30 Dec 2024 19:57:56 +0100
Subject: [PATCH 12/32] Add Filterable, Witherable instances and catMaybeS

---
 automaton/src/Data/Automaton.hs        | 10 ++++++++++
 automaton/src/Data/Stream.hs           | 26 ++++++++++++++++++++++++++
 automaton/src/Data/Stream/Optimized.hs |  9 +++++++++
 rhine/src/FRP/Rhine/Clock/Select.hs    | 10 ++--------
 4 files changed, 47 insertions(+), 8 deletions(-)

diff --git a/automaton/src/Data/Automaton.hs b/automaton/src/Data/Automaton.hs
index bc502f76..964702bd 100644
--- a/automaton/src/Data/Automaton.hs
+++ b/automaton/src/Data/Automaton.hs
@@ -55,6 +55,7 @@ import Data.Stream (StreamT (..), fixStream)
 import Data.Stream.Internal (JointState (..))
 import Data.Stream.Optimized (
   OptimizedStreamT (..),
+  catMaybeS,
   concatS,
   hoist',
   stepOptimizedStream,
@@ -540,6 +541,15 @@ In contrast to 'handleAutomaton_', the functor type can change.
 handleAutomaton :: (Functor m) => (StreamT (ReaderT a m) b -> StreamT (ReaderT c n) d) -> Automaton m a b -> Automaton n c d
 handleAutomaton f = Automaton . StreamOptimized.handleOptimized f . getAutomaton
 
+{- | Drop 'Nothing' values from the output, retrying an input value until the automaton outputs a 'Just'.
+
+See 'Data.Stream.catMaybeS'.
+
+Caution: If @automaton@ outputs 'Nothing' forever, then @'catMaybeS' automaton@ will loop and never produce output.
+-}
+catMaybeS :: (Monad m) => Automaton m a (Maybe b) -> Automaton m a b
+catMaybeS = Automaton . Data.Stream.Optimized.catMaybeS . getAutomaton
+
 {- | Buffer the output of an automaton. See 'Data.Stream.concatS'.
 
 The input for the automaton is not buffered.
diff --git a/automaton/src/Data/Stream.hs b/automaton/src/Data/Stream.hs
index 32c17bfd..9e69b835 100644
--- a/automaton/src/Data/Stream.hs
+++ b/automaton/src/Data/Stream.hs
@@ -34,6 +34,9 @@ import Data.These (These (..))
 -- semialign
 import Data.Align
 
+-- witherable
+import Witherable (Filterable (..), Witherable)
+
 -- automaton
 import Data.Stream.Internal
 import Data.Stream.Recursive (Recursive (..))
@@ -257,6 +260,29 @@ withStreamT :: (Functor m, Functor n) => (forall s. m (Result s a) -> n (Result
 withStreamT f StreamT {state, step} = StreamT state $ fmap f step
 {-# INLINE withStreamT #-}
 
+instance (Monad m) => Filterable (StreamT m) where
+  mapMaybe f StreamT {state, step} = StreamT {state, step = go}
+    where
+      go s = do
+        Result s' a <- step s
+        case f a of
+          Nothing -> go s'
+          Just b -> return $ Result s' b
+
+instance (Traversable m, Monad m) => Witherable (StreamT m)
+
+{- | Drop all 'Nothing' values from the output.
+
+Results in a stream that doesn't tick as often as the original stream.
+
+If the original stream outputs 'Nothing',
+it is retried until it produces data.
+
+Also see 'Filterable' and 'Witherable'.
+-}
+catMaybeS :: (Monad m) => StreamT m (Maybe a) -> StreamT m a
+catMaybeS = catMaybes
+
 {- | Buffer the output of a stream, returning one value at a time.
 
 This function lets a stream control the speed at which it produces data,
diff --git a/automaton/src/Data/Stream/Optimized.hs b/automaton/src/Data/Stream/Optimized.hs
index 028ae58a..1157aed7 100644
--- a/automaton/src/Data/Stream/Optimized.hs
+++ b/automaton/src/Data/Stream/Optimized.hs
@@ -202,6 +202,15 @@ fromRecursive :: Recursive m a -> OptimizedStreamT m a
 fromRecursive = Stateful . StreamT.fromRecursive
 {-# INLINE fromRecursive #-}
 
+-- | See 'Data.Stream.catMaybeS'.
+catMaybeS :: Monad m => OptimizedStreamT m (Maybe a) -> OptimizedStreamT m a
+catMaybeS (Stateful stream) = Stateful $ StreamT.catMaybeS stream
+catMaybeS (Stateless f) = Stateless g
+  where
+    g = do
+      aMaybe <- f
+      maybe g return aMaybe
+
 -- | See 'Data.Stream.concatS'.
 concatS :: (Monad m) => OptimizedStreamT m [a] -> OptimizedStreamT m a
 concatS stream = Stateful $ StreamT.concatS $ toStreamT stream
diff --git a/rhine/src/FRP/Rhine/Clock/Select.hs b/rhine/src/FRP/Rhine/Clock/Select.hs
index 1aba8330..d4037da5 100644
--- a/rhine/src/FRP/Rhine/Clock/Select.hs
+++ b/rhine/src/FRP/Rhine/Clock/Select.hs
@@ -19,7 +19,7 @@ import Control.Arrow
 import Data.Maybe (maybeToList)
 
 -- automaton
-import Data.Automaton (Automaton, concatS)
+import Data.Automaton (Automaton, catMaybeS)
 
 -- rhine
 import FRP.Rhine.Clock
@@ -60,16 +60,10 @@ instance (Monad m, Clock m cl) => Clock m (SelectClock cl a) where
   initClock SelectClock {..} = do
     (runningClock, initialTime) <- initClock mainClock
     let
-      runningSelectClock = filterS $ proc _ -> do
+      runningSelectClock = catMaybeS $ proc _ -> do
         (time, tag) <- runningClock -< ()
         returnA -< (time,) <$> select tag
     return (runningSelectClock, initialTime)
   {-# INLINE initClock #-}
 
 instance GetClockProxy (SelectClock cl a)
-
-{- | Helper function that runs an 'Automaton' with 'Maybe' output
-   until it returns a value.
--}
-filterS :: (Monad m) => Automaton m () (Maybe b) -> Automaton m () b
-filterS = concatS . (>>> arr maybeToList)

From 93345c766169e0ef73b944aba184e76113d012d3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 30 Dec 2024 19:58:20 +0100
Subject: [PATCH 13/32] WIP FilterAutomaton

---
 automaton/automaton.cabal                  |  4 +
 automaton/src/Data/Automaton/Filter.hs     | 49 ++++++++++++
 automaton/src/Data/Automaton/Traversing.hs | 88 ++++++++++++++++++++++
 automaton/test/Automaton/Traversing.hs     | 17 +++++
 4 files changed, 158 insertions(+)
 create mode 100644 automaton/src/Data/Automaton/Filter.hs
 create mode 100644 automaton/src/Data/Automaton/Traversing.hs
 create mode 100644 automaton/test/Automaton/Traversing.hs

diff --git a/automaton/automaton.cabal b/automaton/automaton.cabal
index 8e282a01..48473b9e 100644
--- a/automaton/automaton.cabal
+++ b/automaton/automaton.cabal
@@ -48,6 +48,7 @@ common opts
   default-extensions:
     Arrows
     DataKinds
+    DeriveFunctor
     FlexibleContexts
     FlexibleInstances
     ImportQualifiedPost
@@ -65,6 +66,7 @@ library
   import: opts
   exposed-modules:
     Data.Automaton
+    Data.Automaton.Filter
     Data.Automaton.Recursive
     Data.Automaton.Trans.Accum
     Data.Automaton.Trans.Except
@@ -74,6 +76,7 @@ library
     Data.Automaton.Trans.Reader
     Data.Automaton.Trans.State
     Data.Automaton.Trans.Writer
+    Data.Automaton.Traversing
     Data.Stream
     Data.Stream.Except
     Data.Stream.Internal
@@ -96,6 +99,7 @@ test-suite automaton-test
     Automaton
     Automaton.Except
     Automaton.Trans.Accum
+    Automaton.Traversing
     Stream
 
   build-depends:
diff --git a/automaton/src/Data/Automaton/Filter.hs b/automaton/src/Data/Automaton/Filter.hs
new file mode 100644
index 00000000..9ad50f1c
--- /dev/null
+++ b/automaton/src/Data/Automaton/Filter.hs
@@ -0,0 +1,49 @@
+module Data.Automaton.Filter where
+
+-- base
+import Control.Monad (guard)
+import Prelude hiding (id, (.))
+
+-- witherable
+import Witherable (Filterable (..))
+
+-- automaton
+
+import Data.Automaton
+import Data.Automaton.Traversing
+
+-- * 'FilterAutomaton'
+
+{- | An automaton that can not only process, but also filter data.
+
+When several filter automata are composed, only that data is output which passes through all filters.
+
+For example:
+@
+evens = runFilterAutomaton $ liftFilter count >>> filterS even
+@
+This automaton will perform a step for every number, but output @Nothing, Just 2, Nothing, Just 4, ...@.
+
+To arrive at a stream that does not output the 'Nothing' values, see 'Data.Automaton.catMaybeS'.
+-}
+type FilterAutomaton m = TraversingAutomaton m Maybe
+
+instance (Functor m) => Filterable (FilterAutomaton m a) where
+  mapMaybe = rmapT
+
+liftFilter :: (Applicative m) => Automaton m a b -> FilterAutomaton m a b
+liftFilter = liftTraversing
+
+-- | In general, create a 'FilterAutomaton' from an automaton that only optionally outputs values.
+filterAutomaton :: Automaton m a (Maybe b) -> FilterAutomaton m a b
+filterAutomaton = TraversingAutomaton
+
+-- | Once all filters are composed, retrieve the underlying automaton.
+runFilterAutomaton :: FilterAutomaton m a b -> Automaton m a (Maybe b)
+runFilterAutomaton = getTraversingAutomaton
+
+filterS :: (Applicative m) => (a -> Bool) -> FilterAutomaton m a a
+filterS f = arrFilter $ \a -> guard (f a) >> pure a
+
+arrFilter :: (Applicative m) => (a -> Maybe b) -> FilterAutomaton m a b
+arrFilter = arrT
diff --git a/automaton/src/Data/Automaton/Traversing.hs b/automaton/src/Data/Automaton/Traversing.hs
new file mode 100644
index 00000000..f1687c6f
--- /dev/null
+++ b/automaton/src/Data/Automaton/Traversing.hs
@@ -0,0 +1,88 @@
+module Data.Automaton.Traversing where
+
+-- base
+import Control.Applicative (Alternative (..))
+import Control.Arrow
+import Control.Category (Category (..))
+import Control.Monad (MonadPlus, join)
+import Data.Functor ((<&>))
+import Data.Functor.Compose (Compose (..))
+import Prelude hiding (id, (.))
+
+-- profunctors
+import Data.Profunctor (Profunctor (..))
+import Data.Profunctor.Traversing (Traversing (..))
+
+-- automaton
+import Data.Automaton
+
+-- FIXME some basic unit tests
+
+{- | An 'Automaton' with a 'Traversable' output shape @f@.
+
+When two such traversing automata are composed, the second one automatically traverses all the output of the first one, and joins it together.
+
+A typical application is filtering a stream.
+For this, see the specialisation 'FilterAutomaton'.
+
+For some example types of @f@, a composition @ta1 >>> ta2@ has the following behaviour:
+
+* Lists: For every list element in the output of @ta1@, one step of @ta2@ is performed, and all results are concatenated.
+  Useful for exploration algorithms.
+* 'NonEmpty': Like lists.
+* 'Maybe': @ta2@ is only stepped when @ta1@ produces 'Just' (and the composition is only 'Just' when @ta2@ also produces a 'Just'). See 'FilterAutomaton' for details.
+* 'Either': Like 'Maybe', but also produce the 'Left' value of the earliest automaton.
+
+@f@ usually has to be an instance of both 'Traversable' and 'Monad' for this type to be useful.
+-}
+newtype TraversingAutomaton m f a b = TraversingAutomaton {getTraversingAutomaton :: Automaton m a (f b)}
+  deriving (Functor)
+  deriving (Applicative) via (Compose (Automaton m a) f)
+  deriving (Alternative) via (Compose (Automaton m a) f)
+
+instance (Functor m, Functor f) => Profunctor (TraversingAutomaton m f) where
+  dimap f g (TraversingAutomaton automaton) = TraversingAutomaton $ dimap f (fmap g) automaton
+
+instance (Monad m, Traversable f, Monad f) => Category (TraversingAutomaton m f) where
+  id = TraversingAutomaton $ arr return
+  TraversingAutomaton g . TraversingAutomaton f = TraversingAutomaton $ join <$> traverse' g . f
+
+instance (Monad m, Traversable f, Monad f) => Arrow (TraversingAutomaton m f) where
+  arr f = TraversingAutomaton $ arr $ f >>> pure
+  first (TraversingAutomaton automaton) = TraversingAutomaton $ first automaton >>> arr (\(fc, d) -> (,d) <$> fc)
+
+instance (Traversable f, Monad m, Monad f) => ArrowChoice (TraversingAutomaton m f) where
+  TraversingAutomaton automaton1 +++ TraversingAutomaton automaton2 = TraversingAutomaton $ automaton1 +++ automaton2 <&> either (fmap Left) (fmap Right)
+
+instance (Traversable f, Monad m, MonadPlus m, Monad f) => ArrowZero (TraversingAutomaton m f) where
+  zeroArrow = empty
+
+instance (Traversable f, Monad m, MonadPlus m, Monad f) => ArrowPlus (TraversingAutomaton m f) where
+  (<+>) = (<|>)
+
+-- | Lift a pure function with output shape @f@.
+arrT :: (Applicative m) => (a -> f b) -> TraversingAutomaton m f a b
+arrT = TraversingAutomaton . arr'
+
+-- | Lift an automaton that always returns a single value.
+liftTraversing :: (Applicative m, Applicative f) => Automaton m a b -> TraversingAutomaton m f a b
+liftTraversing = TraversingAutomaton . fmap pure
+
+-- | Compose on the left with an automaton that always returns a single value.
+lmapS :: (Traversable f, Monad m) => Automaton m a b -> TraversingAutomaton m f b c -> TraversingAutomaton m f a c
+lmapS ab (TraversingAutomaton bc) = TraversingAutomaton $ ab >>> bc
+
+-- | Compose on the right with an automaton that always returns a single value.
+rmapS :: (Traversable f, Monad m) => TraversingAutomaton m f a b -> Automaton m b c -> TraversingAutomaton m f a c
+rmapS (TraversingAutomaton ab) bc = TraversingAutomaton $ ab >>> traverseS bc
+
+{- | Compose on the left with a pure function with output shape @f@.
+
+Note: In contrast to 'rmapT', the automaton has to traverse all values of @f b@, requiring the @'Monad' m@ instance.
+-}
+lmapT :: (Monad f, Monad m, Traversable f) => (a -> f b) -> TraversingAutomaton m f b c -> TraversingAutomaton m f a c
+lmapT f (TraversingAutomaton automaton) = TraversingAutomaton $ dimap f join $ traverseS automaton
+
+-- | Compose on the right with a pure function with output shape @f@.
+rmapT :: (Functor m, Monad f) => (b -> f c) -> TraversingAutomaton m f a b -> TraversingAutomaton m f a c
+rmapT f (TraversingAutomaton automaton) = TraversingAutomaton $ (>>= f) <$> automaton
diff --git a/automaton/test/Automaton/Traversing.hs b/automaton/test/Automaton/Traversing.hs
new file mode 100644
index 00000000..df2398e4
--- /dev/null
+++ b/automaton/test/Automaton/Traversing.hs
@@ -0,0 +1,17 @@
+module Automaton.Traversing where
+
+-- base
+import Data.Functor.Identity (Identity (runIdentity))
+
+-- tasty
+import Test.Tasty (testGroup)
+
+-- tasty-hunit
+import Test.Tasty.HUnit (testCase, (@?=))
+
+-- automaton
+import Data.Automaton (embed)
+import Data.Automaton.Trans.Except (safe, safely, step)
+
+tests = testGroup "Traversing" [
+  testCase "step" $ runIdentity (embed (safely $ step (\a -> return (a, ())) >> safe 0) [1, 1, 1]) @?= [1, 0, 0]]

From 857b38151c5d54522e91d1edc395796c62fdc6ca Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Wed, 26 Jun 2024 20:10:25 +0200
Subject: [PATCH 14/32] FIXUP (should drop itself) fix some warnings

---
 automaton/src/Data/Automaton.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/automaton/src/Data/Automaton.hs b/automaton/src/Data/Automaton.hs
index 964702bd..db4fad0f 100644
--- a/automaton/src/Data/Automaton.hs
+++ b/automaton/src/Data/Automaton.hs
@@ -3,7 +3,6 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE InstanceSigs #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -51,7 +50,7 @@ import Data.These (these)
 import Witherable (Filterable (..))
 
 -- automaton
-import Data.Stream (StreamT (..), fixStream)
+import Data.Stream (StreamT (..))
 import Data.Stream.Internal (JointState (..))
 import Data.Stream.Optimized (
   OptimizedStreamT (..),

From 96fc2c69d4bc5339a7fa368e4c81be09bb5d0601 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Wed, 26 Jun 2024 20:12:55 +0200
Subject: [PATCH 15/32] Add unzipResult

---
 automaton/src/Data/Stream/Result.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/automaton/src/Data/Stream/Result.hs b/automaton/src/Data/Stream/Result.hs
index cb9461f6..9d5616da 100644
--- a/automaton/src/Data/Stream/Result.hs
+++ b/automaton/src/Data/Stream/Result.hs
@@ -42,3 +42,7 @@ instance (Monad m) => Applicative (ResultStateT s m) where
     Result s' f <- mf s
     Result s'' a <- ma s'
     pure (Result s'' (f a))
+
+-- | Like 'unzip'.
+unzipResult :: (Functor f) => f (Result s a) -> Result (f s) (f a)
+unzipResult results = Result (resultState <$> results) (output <$> results)

From 48ea06cce148aa142ccb13b4855ea1b1ca6fcc99 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Wed, 26 Jun 2024 20:13:42 +0200
Subject: [PATCH 16/32] Fix import

---
 rhine/src/FRP/Rhine/Clock/Except.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/rhine/src/FRP/Rhine/Clock/Except.hs b/rhine/src/FRP/Rhine/Clock/Except.hs
index 2f3dab77..332bf6ff 100644
--- a/rhine/src/FRP/Rhine/Clock/Except.hs
+++ b/rhine/src/FRP/Rhine/Clock/Except.hs
@@ -5,6 +5,7 @@ import Control.Arrow
 import Control.Exception
 import Control.Exception qualified as Exception
 import Control.Monad ((<=<))
+import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.Functor ((<&>))
 import Data.Void
 
@@ -13,7 +14,6 @@ import Data.Time (UTCTime, getCurrentTime)
 
 -- mtl
 import Control.Monad.Error.Class
-import Control.Monad.IO.Class (MonadIO, liftIO)
 
 -- time-domain
 import Data.TimeDomain (TimeDomain)

From 9167495070d1702c57f9c41868e7386915b6c354 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Sat, 28 Dec 2024 13:47:54 +0100
Subject: [PATCH 17/32] Add hoist' variants without monad constraint

---
 automaton/src/Data/Stream/Except.hs    | 10 +++++-----
 automaton/src/Data/Stream/Recursive.hs | 11 ++++++++---
 2 files changed, 13 insertions(+), 8 deletions(-)

diff --git a/automaton/src/Data/Stream/Except.hs b/automaton/src/Data/Stream/Except.hs
index 0d2aabb4..5f0c9676 100644
--- a/automaton/src/Data/Stream/Except.hs
+++ b/automaton/src/Data/Stream/Except.hs
@@ -20,9 +20,10 @@ import Control.Selective
 
 -- automaton
 import Data.Stream (foreverExcept)
-import Data.Stream.Optimized (OptimizedStreamT, applyExcept, constM, selectExcept)
+import Data.Stream.Optimized as OptimizedStreamT (OptimizedStreamT, applyExcept, constM, hoist', selectExcept)
 import Data.Stream.Optimized qualified as StreamOptimized
 import Data.Stream.Recursive (Recursive (..))
+import Data.Stream.Recursive as Recursive (Recursive (..), hoist')
 import Data.Stream.Recursive.Except
 import Data.Stream.Result
 
@@ -81,10 +82,9 @@ instance (Traversable m) => Traversable (StreamExcept a m) where
       bitraverseEither :: (Functor f) => Either (f a) (f b) -> f (Either a b)
       bitraverseEither = either (fmap Left) (fmap Right)
 
--- FIXME This should work with Functor m and custom hoists
-instance (Monad m) => Functor (StreamExcept a m) where
-  fmap f (RecursiveExcept fe) = RecursiveExcept $ hoist (withExceptT f) fe
-  fmap f (CoalgebraicExcept ae) = CoalgebraicExcept $ hoist (withExceptT f) ae
+instance (Functor m) => Functor (StreamExcept a m) where
+  fmap f (RecursiveExcept fe) = RecursiveExcept $ Recursive.hoist' (withExceptT f) fe
+  fmap f (CoalgebraicExcept ae) = CoalgebraicExcept $ OptimizedStreamT.hoist' (withExceptT f) ae
 
 instance (Monad m) => Applicative (StreamExcept a m) where
   pure = CoalgebraicExcept . constM . throwE
diff --git a/automaton/src/Data/Stream/Recursive.hs b/automaton/src/Data/Stream/Recursive.hs
index 36497ae1..d8b3f04c 100644
--- a/automaton/src/Data/Stream/Recursive.hs
+++ b/automaton/src/Data/Stream/Recursive.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE RankNTypes #-}
+
 module Data.Stream.Recursive where
 
 -- base
@@ -16,9 +18,12 @@ One step of the stream transformer performs a monadic action and results in an o
 newtype Recursive m a = Recursive {getRecursive :: m (Result (Recursive m a) a)}
 
 instance MFunctor Recursive where
-  hoist morph = go
-    where
-      go Recursive {getRecursive} = Recursive $ morph $ mapResultState go <$> getRecursive
+  hoist = hoist'
+
+hoist' :: (Functor f) => (forall x. f x -> g x) -> Recursive f a -> Recursive g a
+hoist' morph = go
+  where
+    go Recursive {getRecursive} = Recursive $ morph $ mapResultState go <$> getRecursive
 
 instance (Functor m) => Functor (Recursive m) where
   fmap f Recursive {getRecursive} = Recursive $ fmap f . mapResultState (fmap f) <$> getRecursive

From 0820f0c6d686b7c952cfa432f58e8a5b061c5068 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?=
 <Manuel Bärenz programming@manuelbaerenz.de>
Date: Thu, 26 Sep 2024 17:17:27 +0200
Subject: [PATCH 18/32] Fix import

---
 automaton/src/Data/Stream/Recursive.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/automaton/src/Data/Stream/Recursive.hs b/automaton/src/Data/Stream/Recursive.hs
index d8b3f04c..0f12684d 100644
--- a/automaton/src/Data/Stream/Recursive.hs
+++ b/automaton/src/Data/Stream/Recursive.hs
@@ -4,6 +4,8 @@ module Data.Stream.Recursive where
 
 -- base
 import Control.Applicative (Alternative (..))
+import Data.Function ((&))
+import Data.Functor ((<&>))
 
 -- mmorph
 import Control.Monad.Morph (MFunctor (..))

From a51f71afebf2f04055578015402529053c7cc92d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 30 Dec 2024 12:27:45 +0100
Subject: [PATCH 19/32] Fix naming & hlint

---
 automaton/src/Data/Stream/Except.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/automaton/src/Data/Stream/Except.hs b/automaton/src/Data/Stream/Except.hs
index 5f0c9676..5d7863c5 100644
--- a/automaton/src/Data/Stream/Except.hs
+++ b/automaton/src/Data/Stream/Except.hs
@@ -64,21 +64,21 @@ stepInstant (CoalgebraicExcept coalgebraic) =
   coalgebraic
     & StreamOptimized.stepOptimizedStream
     & runExceptT
-    <&> fmap (mapResultState InitialExcept)
+    <&> fmap (mapResultState CoalgebraicExcept)
 
 -- | Run all steps of the stream, discarding all output, until the exception is reached.
 instance (Functor m, Foldable m) => Foldable (StreamExcept a m) where
   foldMap f = stepInstant >>> foldMap (either f $ resultState >>> foldMap f)
 
 instance (Traversable m) => Traversable (StreamExcept a m) where
-  traverse f streamExcept = traverseFinal (toFinal streamExcept) & fmap (Final >>> FinalExcept)
+  traverse f streamExcept = traverseRecursive (toRecursive streamExcept) & fmap (Recursive >>> RecursiveExcept)
     where
-      traverseFinal =
-        getFinal
+      traverseRecursive =
+        getRecursive
           >>> runExceptT
-          >>> fmap ((bimap f $ mapResultState traverseFinal >>> (\Result {resultState, output} -> (Result <$> resultState) <&> ($ output))) >>> bitraverseEither)
-          >>> traverse id
-          >>> fmap (ExceptT >>> fmap (mapResultState Final))
+          >>> fmap (bimap f (mapResultState traverseRecursive >>> (\Result {resultState, output} -> (Result <$> resultState) <&> ($ output))) >>> bitraverseEither)
+          >>> sequenceA
+          >>> fmap (ExceptT >>> fmap (mapResultState Recursive))
       bitraverseEither :: (Functor f) => Either (f a) (f b) -> f (Either a b)
       bitraverseEither = either (fmap Left) (fmap Right)
 

From b0a7f185d811f4783ac20baa5be3f58013b7e806 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Sat, 28 Sep 2024 10:53:29 +0200
Subject: [PATCH 20/32] Fix haddock

---
 automaton/src/Data/Stream.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/automaton/src/Data/Stream.hs b/automaton/src/Data/Stream.hs
index 9e69b835..dd071661 100644
--- a/automaton/src/Data/Stream.hs
+++ b/automaton/src/Data/Stream.hs
@@ -482,7 +482,7 @@ fixStream' transformState transformStep =
   where
     step fix@(Fix {getFix}) = mapResultState Fix <$> transformStep fix step getFix
 
-{- | The solution to the equation @'fixA stream = stream <*> 'fixA' stream@.
+{- | The solution to the equation @'fixA' stream = stream <*> 'fixA' stream@.
 
 Such a fix point operator needs to be used instead of the above direct definition because recursive definitions of streams
 loop at runtime due to the coalgebraic encoding of the state.

From 014bd22e029b9a717d268146669e3bb383cdb31b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 30 Dec 2024 12:40:57 +0100
Subject: [PATCH 21/32] WIP Handling composed functors, runListS

---
 automaton/src/Data/Stream.hs | 43 ++++++++++++++++++++++++++++++++++--
 1 file changed, 41 insertions(+), 2 deletions(-)

diff --git a/automaton/src/Data/Stream.hs b/automaton/src/Data/Stream.hs
index dd071661..d7205b61 100644
--- a/automaton/src/Data/Stream.hs
+++ b/automaton/src/Data/Stream.hs
@@ -9,15 +9,16 @@ module Data.Stream where
 
 -- base
 import Control.Applicative (Alternative (..), Applicative (..), liftA2)
-import Control.Monad ((<$!>))
+import Control.Monad (forM, (<$!>))
 import Data.Bifunctor (bimap)
 import Data.Function ((&))
+import Data.Functor.Compose (Compose (..))
 import Data.Monoid (Ap (..))
 import Prelude hiding (Applicative (..))
 
 -- transformers
 import Control.Monad.Trans.Class
-import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE, withExceptT)
+import Control.Monad.Trans.Except (ExceptT (..), runExceptT, throwE, withExceptT)
 
 -- mmorph
 import Control.Monad.Morph (MFunctor (hoist))
@@ -491,6 +492,44 @@ fixA :: (Applicative m) => StreamT m (a -> a) -> StreamT m a
 fixA StreamT {state, step} = fixStream (JointState state) $
   \stepA (JointState s ss) -> apResult <$> step s <*> stepA ss
 
+-- FIXME Generalisation in []
+runListS :: (Monad m) => StreamT (Compose m []) a -> StreamT m [a]
+runListS StreamT {state, step} =
+  StreamT
+    { state = [state]
+    , step = \states -> do
+        results <- forM states $ getCompose . step
+        let flatResults = concat results
+        return $ Result (resultState <$> flatResults) (output <$> flatResults)
+    }
+
+-- FIXME maybe rewrite with Iso somehow?
+handleCompose :: (Functor f, Monad m, Monad composed) => (forall s. s -> f s) -> (forall x. composed x -> m (f x)) -> (forall x. m (f x) -> composed x) -> StreamT composed a -> StreamT m (f a)
+handleCompose pure_ uncompose compose StreamT {state, step} =
+  StreamT
+    { state = pure_ state
+    , step = \s -> do
+        results <- uncompose $ do
+          states <- compose $ pure s
+          step states
+        return $! Result (fmap resultState results) (fmap output results)
+    }
+
+-- FIXME all these should go to a separate module
+handleExceptT :: (Monad m) => StreamT (ExceptT e m) a -> StreamT m (Either e a)
+handleExceptT = handleCompose pure runExceptT ExceptT
+
+-- FIXME handleMaybeT
+
+snapshot :: (Functor m) => StreamT m a -> StreamT m (m a)
+snapshot StreamT {state, step} =
+  StreamT
+    { state
+    , step = \s ->
+        let result = step s
+         in flip Result (output <$> result) . resultState <$> result
+    }
+
 -- | Similar to 'fmap', but the function is allowed to perform a side effect in a monad @m@.
 mmap :: (Monad m) => (a -> m b) -> StreamT m a -> StreamT m b
 mmap f StreamT {state, step} =

From 275c41e7b5550750a62fd362d80092fefb88d91b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Sun, 29 Dec 2024 18:18:39 +0100
Subject: [PATCH 22/32] WIP foldStream functions

---
 automaton/src/Data/Stream.hs | 49 ++++++++++++++++++++++++++++--------
 1 file changed, 39 insertions(+), 10 deletions(-)

diff --git a/automaton/src/Data/Stream.hs b/automaton/src/Data/Stream.hs
index d7205b61..4e979376 100644
--- a/automaton/src/Data/Stream.hs
+++ b/automaton/src/Data/Stream.hs
@@ -227,6 +227,43 @@ stepStream :: (Functor m) => StreamT m a -> m (Result (StreamT m a) a)
 stepStream StreamT {state, step} = mapResultState (`StreamT` step) <$> step state
 {-# INLINE stepStream #-}
 
+{- | Build an infinite, lazy structure from the values of the stream.
+
+Since potentially infinitely many values are created by the stream,
+it is not necessary to provide a starting accumulator.
+
+Also, the accumulation cannot be terminated from the accumulation function itself,
+this has to be done by the stream's effect in @m@.
+See 'foldStreamM' for a more general accumulation function which can break depending on the current value.
+
+Example usage:
+@
+streamToList = foldStream (:)
+@
+-}
+foldStream ::
+  (Monad m) =>
+  -- | The accumulation function which prepends a value of the stream to the lazy accumulator.
+  (a -> b -> b) ->
+  StreamT m a ->
+  m b
+foldStream accum StreamT {state, step} = go state
+  where
+    go s = do
+      Result s' a <- step s
+      accum a <$> go s'
+{-# INLINE foldStream #-}
+
+-- | Like 'foldStream', but add an effect in @m@ at every step.
+foldStreamM :: (Monad m) => (a -> b -> m b) -> StreamT m a -> m b
+foldStreamM accum StreamT {state, step} = go state
+  where
+    go s = do
+      Result s' a <- step s
+      b <- go s'
+      accum a b
+{-# INLINE foldStreamM #-}
+
 {- | Run a stream with trivial output.
 
 If the output of a stream does not contain information,
@@ -238,20 +275,12 @@ e.g. 'Maybe' or 'Either' could terminate with a 'Nothing' or 'Left' value,
 or 'IO' can raise an exception.
 -}
 reactimate :: (Monad m) => StreamT m () -> m void
-reactimate StreamT {state, step} = go state
-  where
-    go s = do
-      Result s' () <- step s
-      go s'
+reactimate = foldStream $ const id
 {-# INLINE reactimate #-}
 
 -- | Run a stream, collecting the outputs in a lazy, infinite list.
 streamToList :: (Monad m) => StreamT m a -> m [a]
-streamToList StreamT {state, step} = go state
-  where
-    go s = do
-      Result s' a <- step s
-      (a :) <$> go s'
+streamToList = foldStream (:)
 {-# INLINE streamToList #-}
 
 -- * Modifying streams

From 2db71982348f97e8d3f088b88ae4a8aaf7668075 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Sun, 29 Dec 2024 18:19:31 +0100
Subject: [PATCH 23/32] WIP Apply some hints

---
 automaton/src/Data/Stream/Except.hs    | 1 -
 automaton/src/Data/Stream/Optimized.hs | 2 --
 2 files changed, 3 deletions(-)

diff --git a/automaton/src/Data/Stream/Except.hs b/automaton/src/Data/Stream/Except.hs
index 5d7863c5..9cc2c5be 100644
--- a/automaton/src/Data/Stream/Except.hs
+++ b/automaton/src/Data/Stream/Except.hs
@@ -22,7 +22,6 @@ import Control.Selective
 import Data.Stream (foreverExcept)
 import Data.Stream.Optimized as OptimizedStreamT (OptimizedStreamT, applyExcept, constM, hoist', selectExcept)
 import Data.Stream.Optimized qualified as StreamOptimized
-import Data.Stream.Recursive (Recursive (..))
 import Data.Stream.Recursive as Recursive (Recursive (..), hoist')
 import Data.Stream.Recursive.Except
 import Data.Stream.Result
diff --git a/automaton/src/Data/Stream/Optimized.hs b/automaton/src/Data/Stream/Optimized.hs
index 1157aed7..ad3cce8a 100644
--- a/automaton/src/Data/Stream/Optimized.hs
+++ b/automaton/src/Data/Stream/Optimized.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE RankNTypes #-}

From 8e3f607142ebea3bf3ecf64860f7696af0eaffcb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 30 Dec 2024 09:09:59 +0100
Subject: [PATCH 24/32] Fix haddock

---
 automaton/src/Data/Stream.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/automaton/src/Data/Stream.hs b/automaton/src/Data/Stream.hs
index 4e979376..6f8bf24f 100644
--- a/automaton/src/Data/Stream.hs
+++ b/automaton/src/Data/Stream.hs
@@ -100,7 +100,7 @@ unfold state step =
     , step = pure . step
     }
 
--- | Like 'unfold', but output the current state.
+-- | Like 'unfold', but output the current (updated) state.
 unfold_ :: (Applicative m) => s -> (s -> s) -> StreamT m s
 unfold_ state step = unfold state $ \s -> let s' = step s in Result s' s'
 

From 5d649de485849110bd74cd6c5d366eacd4e53237 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 30 Dec 2024 09:56:44 +0100
Subject: [PATCH 25/32] Add mapException

---
 automaton/src/Data/Stream/Except.hs | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/automaton/src/Data/Stream/Except.hs b/automaton/src/Data/Stream/Except.hs
index 9cc2c5be..7ceabe88 100644
--- a/automaton/src/Data/Stream/Except.hs
+++ b/automaton/src/Data/Stream/Except.hs
@@ -44,6 +44,11 @@ mapOutput :: (Functor m) => (a -> b) -> StreamExcept a m e -> StreamExcept b m e
 mapOutput f (RecursiveExcept recursive) = RecursiveExcept $ f <$> recursive
 mapOutput f (CoalgebraicExcept coalgebraic) = CoalgebraicExcept $ f <$> coalgebraic
 
+-- | Apply a monad morphism to the exception and effect, not changing the output
+mapException :: (Monad m1) => (forall x. ExceptT e1 m1 x -> ExceptT e2 m2 x) -> StreamExcept a m1 e1 -> StreamExcept a m2 e2
+mapException f (RecursiveExcept recursive) = RecursiveExcept $ hoist f recursive
+mapException f (CoalgebraicExcept coalgebraic) = CoalgebraicExcept $ hoist f coalgebraic
+
 toRecursive :: (Functor m) => StreamExcept a m e -> Recursive (ExceptT e m) a
 toRecursive (RecursiveExcept recursive) = recursive
 toRecursive (CoalgebraicExcept coalgebraic) = StreamOptimized.toRecursive coalgebraic
@@ -103,8 +108,7 @@ instance MonadTrans (StreamExcept a) where
   lift = CoalgebraicExcept . constM . ExceptT . fmap Left
 
 instance MFunctor (StreamExcept a) where
-  hoist morph (RecursiveExcept recursive) = RecursiveExcept $ hoist (mapExceptT morph) recursive
-  hoist morph (CoalgebraicExcept coalgebraic) = CoalgebraicExcept $ hoist (mapExceptT morph) coalgebraic
+  hoist morph = mapException (hoist morph)
 
 safely :: (Monad m) => StreamExcept a m Void -> OptimizedStreamT m a
 safely = hoist (fmap (either absurd id) . runExceptT) . runStreamExcept

From 345aee17352c86b3af6ed157843c9cca69fbe0fc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 30 Dec 2024 09:57:12 +0100
Subject: [PATCH 26/32] Implement mtl instances for StreamExcept

---
 automaton/automaton.cabal           |  1 +
 automaton/src/Data/Stream/Except.hs | 32 ++++++++++++++++++++++++++++-
 2 files changed, 32 insertions(+), 1 deletion(-)

diff --git a/automaton/automaton.cabal b/automaton/automaton.cabal
index 48473b9e..dd98592b 100644
--- a/automaton/automaton.cabal
+++ b/automaton/automaton.cabal
@@ -39,6 +39,7 @@ common opts
     these >=1.1 && <=1.3,
     transformers >=0.5,
     witherable ^>=0.4,
+    mtl ^>= 2.3,
 
   if flag(dev)
     ghc-options: -Werror
diff --git a/automaton/src/Data/Stream/Except.hs b/automaton/src/Data/Stream/Except.hs
index 7ceabe88..9fe2be56 100644
--- a/automaton/src/Data/Stream/Except.hs
+++ b/automaton/src/Data/Stream/Except.hs
@@ -1,9 +1,12 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE UndecidableInstances #-}
+
 module Data.Stream.Except where
 
 -- base
 import Control.Category ((>>>))
 import Control.Monad (ap)
-import Data.Bifunctor (bimap)
+import Data.Bifunctor (Bifunctor (first), bimap)
 import Data.Function ((&))
 import Data.Functor ((<&>))
 import Data.Void
@@ -12,6 +15,13 @@ import Data.Void
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.Except
 
+-- mtl
+import Control.Monad.Accum (MonadAccum (..))
+import Control.Monad.RWS.Class (MonadRWS)
+import Control.Monad.Reader.Class (MonadReader (..))
+import Control.Monad.State.Class
+import Control.Monad.Writer.Class
+
 -- mmorph
 import Control.Monad.Morph (MFunctor, hoist)
 
@@ -110,6 +120,26 @@ instance MonadTrans (StreamExcept a) where
 instance MFunctor (StreamExcept a) where
   hoist morph = mapException (hoist morph)
 
+instance (MonadAccum w m) => MonadAccum w (StreamExcept a m) where
+  accum = lift . accum
+
+instance (MonadReader r m) => MonadReader r (StreamExcept a m) where
+  reader = lift . reader
+  local f = hoist $ local f
+
+-- | 'pass' only acts when there is an exception
+instance (MonadWriter w m) => MonadWriter w (StreamExcept a m) where
+  writer = lift . writer
+
+  listen = mapException $ ExceptT . fmap (\(ea, w) -> first (,w) ea) . listen . runExceptT
+
+  pass = mapException $ ExceptT . pass . fmap (either (first Left) (\x -> (Right x, id))) . runExceptT
+
+instance (MonadState s m) => MonadState s (StreamExcept a m) where
+  state = lift . state
+
+instance (MonadRWS r w s m) => MonadRWS r w s (StreamExcept a m)
+
 safely :: (Monad m) => StreamExcept a m Void -> OptimizedStreamT m a
 safely = hoist (fmap (either absurd id) . runExceptT) . runStreamExcept
 

From a0d9afe7664bc50cdac722b6ffa494f804ef1e0a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 30 Dec 2024 10:05:23 +0100
Subject: [PATCH 27/32] Implement mtl instances for AutomatonExcept

---
 automaton/automaton.cabal                    |  1 +
 automaton/src/Data/Automaton/Trans/Except.hs | 19 ++++++++++++++++++-
 2 files changed, 19 insertions(+), 1 deletion(-)

diff --git a/automaton/automaton.cabal b/automaton/automaton.cabal
index dd98592b..fcd01609 100644
--- a/automaton/automaton.cabal
+++ b/automaton/automaton.cabal
@@ -56,6 +56,7 @@ common opts
     MultiParamTypeClasses
     NamedFieldPuns
     NoStarIsType
+    StandaloneDeriving
     TupleSections
     TypeApplications
     TypeFamilies
diff --git a/automaton/src/Data/Automaton/Trans/Except.hs b/automaton/src/Data/Automaton/Trans/Except.hs
index a85b712b..a4ec8a91 100644
--- a/automaton/src/Data/Automaton/Trans/Except.hs
+++ b/automaton/src/Data/Automaton/Trans/Except.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 {- | An 'Automaton' in the 'ExceptT' monad can throw an exception to terminate.
 
@@ -22,10 +23,17 @@ import Control.Arrow (arr, returnA, (<<<), (>>>))
 import Control.Category qualified as Category
 import Data.Void (Void, absurd)
 
+-- mtl
+import Control.Monad.Accum (MonadAccum)
+import Control.Monad.RWS.Class (MonadRWS)
+import Control.Monad.Reader.Class
+import Control.Monad.State.Class
+import Control.Monad.Writer.Class
+
 -- transformers
 import Control.Monad.Trans.Except (ExceptT (..), runExceptT, throwE)
 import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
-import Control.Monad.Trans.Reader
+import Control.Monad.Trans.Reader (ReaderT (ReaderT), mapReaderT)
 
 -- selective
 import Control.Selective (Selective)
@@ -269,6 +277,15 @@ sawtooth = forever $ try $ count >>> throwOnMaybe (\n -> guard (n > 10))
 newtype AutomatonExcept a b m e = AutomatonExcept {getAutomatonExcept :: StreamExcept b (ReaderT a m) e}
   deriving newtype (Functor, Applicative, Selective, Monad)
 
+deriving newtype instance (MonadAccum w m) => MonadAccum w (AutomatonExcept a b m)
+deriving newtype instance (MonadWriter w m) => MonadWriter w (AutomatonExcept a b m)
+deriving newtype instance (MonadState s m) => MonadState s (AutomatonExcept a b m)
+deriving newtype instance (MonadRWS r w s m) => MonadRWS r w s (AutomatonExcept a b m)
+
+instance (MonadReader r m) => MonadReader r (AutomatonExcept a b m) where
+  reader f = AutomatonExcept $ lift $ lift $ reader f
+  local f = hoist $ local f
+
 instance MonadTrans (AutomatonExcept a b) where
   lift = AutomatonExcept . lift . lift
 

From c0e62db5c47ba1d8f059a611fcb8e396b1727f17 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 30 Dec 2024 12:30:07 +0100
Subject: [PATCH 28/32] Haddock toRecursive and runStreamExcept

---
 automaton/src/Data/Stream/Except.hs | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/automaton/src/Data/Stream/Except.hs b/automaton/src/Data/Stream/Except.hs
index 9fe2be56..c48a9b37 100644
--- a/automaton/src/Data/Stream/Except.hs
+++ b/automaton/src/Data/Stream/Except.hs
@@ -59,14 +59,16 @@ mapException :: (Monad m1) => (forall x. ExceptT e1 m1 x -> ExceptT e2 m2 x) ->
 mapException f (RecursiveExcept recursive) = RecursiveExcept $ hoist f recursive
 mapException f (CoalgebraicExcept coalgebraic) = CoalgebraicExcept $ hoist f coalgebraic
 
-toRecursive :: (Functor m) => StreamExcept a m e -> Recursive (ExceptT e m) a
-toRecursive (RecursiveExcept recursive) = recursive
-toRecursive (CoalgebraicExcept coalgebraic) = StreamOptimized.toRecursive coalgebraic
-
+-- | Run a 'StreamExcept' by turning it into a stream that can throw an exception
 runStreamExcept :: StreamExcept a m e -> OptimizedStreamT (ExceptT e m) a
 runStreamExcept (RecursiveExcept recursive) = StreamOptimized.fromRecursive recursive
 runStreamExcept (CoalgebraicExcept coalgebraic) = coalgebraic
 
+-- | Like 'runStreamExcept', but force the (usually less efficient, but more versatile) recursive stream implementation
+toRecursive :: (Functor m) => StreamExcept a m e -> Recursive (ExceptT e m) a
+toRecursive (RecursiveExcept recursive) = recursive
+toRecursive (CoalgebraicExcept coalgebraic) = StreamOptimized.toRecursive coalgebraic
+
 -- | Try to step the 'StreamExcept' for one value of the stream
 stepInstant :: (Functor m) => StreamExcept a m e -> m (Either e (Result (StreamExcept a m e) a))
 stepInstant (RecursiveExcept recursive) =

From 3d4eb18e9fb014818d158daf89e76f7cefcb8a14 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 30 Dec 2024 19:47:19 +0100
Subject: [PATCH 29/32] Derive Monoid for automata

---
 automaton/automaton.cabal       | 4 ++++
 automaton/src/Data/Automaton.hs | 8 +++++++-
 automaton/src/Data/Stream.hs    | 7 ++-----
 3 files changed, 13 insertions(+), 6 deletions(-)

diff --git a/automaton/automaton.cabal b/automaton/automaton.cabal
index fcd01609..e432bc36 100644
--- a/automaton/automaton.cabal
+++ b/automaton/automaton.cabal
@@ -50,12 +50,16 @@ common opts
     Arrows
     DataKinds
     DeriveFunctor
+    DerivingVia
     FlexibleContexts
     FlexibleInstances
+    GADTs
     ImportQualifiedPost
+    LambdaCase
     MultiParamTypeClasses
     NamedFieldPuns
     NoStarIsType
+    RankNTypes
     StandaloneDeriving
     TupleSections
     TypeApplications
diff --git a/automaton/src/Data/Automaton.hs b/automaton/src/Data/Automaton.hs
index db4fad0f..99134737 100644
--- a/automaton/src/Data/Automaton.hs
+++ b/automaton/src/Data/Automaton.hs
@@ -19,7 +19,7 @@ import Data.Function ((&))
 import Data.Functor ((<&>))
 import Data.Functor.Compose (Compose (..))
 import Data.Maybe (fromMaybe)
-import Data.Monoid (Last (..), Sum (..))
+import Data.Monoid (Ap (..), Last (..), Sum (..))
 import Prelude hiding (id, (.))
 
 -- mmorph
@@ -266,6 +266,12 @@ instance (Monad m, Alternative m) => ArrowZero (Automaton m) where
 instance (Monad m, Alternative m) => ArrowPlus (Automaton m) where
   (<+>) = (<|>)
 
+-- instance Semigroup w => Semigroup (Automaton m a w) where
+-- instance Monoid w => Monoid (Automaton m a w) where
+
+deriving via Ap (Automaton m a) w instance (Applicative m, Semigroup w) => Semigroup (Automaton m a w)
+deriving via Ap (Automaton m a) w instance (Applicative m, Monoid w) => Monoid (Automaton m a w)
+
 -- | Consume an input and produce output effectfully, without keeping internal state
 arrM :: (Functor m) => (a -> m b) -> Automaton m a b
 arrM f = Automaton $! StreamOptimized.constM $! ReaderT f
diff --git a/automaton/src/Data/Stream.hs b/automaton/src/Data/Stream.hs
index 6f8bf24f..3189df95 100644
--- a/automaton/src/Data/Stream.hs
+++ b/automaton/src/Data/Stream.hs
@@ -1,8 +1,3 @@
-{-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Data.Stream where
@@ -151,6 +146,8 @@ instance (Traversable m, Functor m) => Traversable (StreamT m) where
   traverse f = fmap fromRecursive . traverse f . toRecursive
 
 deriving via Ap (StreamT m) a instance (Applicative m, Num a) => Num (StreamT m a)
+deriving via Ap (StreamT m) a instance (Applicative m, Semigroup a) => Semigroup (StreamT m a)
+deriving via Ap (StreamT m) a instance (Applicative m, Monoid a) => Monoid (StreamT m a)
 
 instance (Applicative m, Fractional a) => Fractional (StreamT m a) where
   fromRational = pure . fromRational

From e5d0fba05a359325bda9e903d1f7b0663cc1b7c8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 30 Dec 2024 20:01:36 +0100
Subject: [PATCH 30/32] Document Semialign instance

---
 automaton/src/Data/Stream.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/automaton/src/Data/Stream.hs b/automaton/src/Data/Stream.hs
index 3189df95..a7669a75 100644
--- a/automaton/src/Data/Stream.hs
+++ b/automaton/src/Data/Stream.hs
@@ -409,6 +409,7 @@ instance (Selective m) => Selective (StreamT m) where
       eitherResult :: Result s (Either a b) -> Either (Result s a) (Result s b)
       eitherResult (Result s eab) = bimap (Result s) (Result s) eab
 
+-- | Run two streams together without needing @'Applicative' m@ or even @'Monad' m@
 instance (Semialign m) => Semialign (StreamT m) where
   align (StreamT s10 step1) (StreamT s20 step2) =
     StreamT

From 71111a0c17406c39b3b5ab87a6bf45e972ce2caa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 30 Dec 2024 20:01:44 +0100
Subject: [PATCH 31/32] Document concatS

---
 automaton/src/Data/Stream.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/automaton/src/Data/Stream.hs b/automaton/src/Data/Stream.hs
index a7669a75..815e7de9 100644
--- a/automaton/src/Data/Stream.hs
+++ b/automaton/src/Data/Stream.hs
@@ -314,6 +314,9 @@ catMaybeS = catMaybes
 
 This function lets a stream control the speed at which it produces data,
 since it can decide to produce any amount of output at every step.
+
+If the original stream outputs an empty list and the buffer is empty,
+it is retried until it produces data.
 -}
 concatS :: (Monad m) => StreamT m [a] -> StreamT m a
 concatS StreamT {state, step} =

From d350ac864e2a99affe1027fdeb23e4ab4f18d38a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Mon, 6 Jan 2025 19:38:55 +0100
Subject: [PATCH 32/32] WIP split

---
 automaton/src/Data/Automaton.hs | 14 +++++---
 automaton/src/Data/Stream.hs    | 59 +++++++++++++++++++++++++--------
 automaton/test/Stream.hs        | 14 +++++++-
 3 files changed, 69 insertions(+), 18 deletions(-)

diff --git a/automaton/src/Data/Automaton.hs b/automaton/src/Data/Automaton.hs
index 99134737..1cb69001 100644
--- a/automaton/src/Data/Automaton.hs
+++ b/automaton/src/Data/Automaton.hs
@@ -50,13 +50,12 @@ import Data.These (these)
 import Witherable (Filterable (..))
 
 -- automaton
-import Data.Stream (StreamT (..))
+import Data.Stream (StreamT (..), hoist', runTraversableS, snapshotCompose)
 import Data.Stream.Internal (JointState (..))
 import Data.Stream.Optimized (
   OptimizedStreamT (..),
   catMaybeS,
   concatS,
-  hoist',
   stepOptimizedStream,
  )
 import Data.Stream.Optimized qualified as StreamOptimized
@@ -377,8 +376,8 @@ withAutomaton f = Automaton . StreamOptimized.mapOptimizedStreamT (ReaderT . f .
 {-# INLINE withAutomaton #-}
 
 instance (Functor m) => Profunctor (Automaton m) where
-  dimap f g Automaton {getAutomaton} = Automaton $ g <$> hoist' (withReaderT f) getAutomaton
-  lmap f Automaton {getAutomaton} = Automaton $ hoist' (withReaderT f) getAutomaton
+  dimap f g Automaton {getAutomaton} = Automaton $ g <$> StreamOptimized.hoist' (withReaderT f) getAutomaton
+  lmap f Automaton {getAutomaton} = Automaton $ StreamOptimized.hoist' (withReaderT f) getAutomaton
   rmap = fmap
 
 instance (Applicative m) => Choice (Automaton m) where
@@ -452,6 +451,7 @@ traverseS = traverse'
 traverseS_ :: (Monad m, Traversable f) => Automaton m a b -> Automaton m (f a) ()
 traverseS_ automaton = traverse' automaton >>> arr (const ())
 
+-- FIXME It's also conceivable to have Automaton (Compose m t) a b -> Automaton m a (t b)
 -- TODO But should we use parallelism?
 -- https://hackage.haskell.org/package/parallel-3.1.0.1/docs/Control-Parallel-Strategies.html#v:parTraversable
 
@@ -564,6 +564,12 @@ then the next 9 inputs will be ignored.
 concatS :: (Monad m) => Automaton m a [b] -> Automaton m a b
 concatS (Automaton automaton) = Automaton $ Data.Stream.Optimized.concatS automaton
 
+runTraversableS :: (Monad m, Traversable t, Monad t) => Automaton (Compose m t) a b -> Automaton m a (t b)
+runTraversableS = handleAutomaton $ Data.Stream.runTraversableS . Data.Stream.hoist' (Compose . ReaderT . fmap getCompose . runReaderT)
+
+snapshot :: Functor m => Automaton m a b -> Automaton m a (m b)
+snapshot = handleAutomaton $ hoist' (ReaderT . getCompose) . Data.Stream.snapshotCompose . hoist' (Compose . runReaderT)
+
 -- * Examples
 
 -- | Pass through a value unchanged, and perform a side effect depending on it
diff --git a/automaton/src/Data/Stream.hs b/automaton/src/Data/Stream.hs
index 815e7de9..ff5e19b7 100644
--- a/automaton/src/Data/Stream.hs
+++ b/automaton/src/Data/Stream.hs
@@ -4,9 +4,10 @@ module Data.Stream where
 
 -- base
 import Control.Applicative (Alternative (..), Applicative (..), liftA2)
-import Control.Monad (forM, (<$!>))
+import Control.Monad (join, (<$!>))
 import Data.Bifunctor (bimap)
 import Data.Function ((&))
+import Data.Functor ((<&>))
 import Data.Functor.Compose (Compose (..))
 import Data.Monoid (Ap (..))
 import Prelude hiding (Applicative (..))
@@ -34,6 +35,9 @@ import Data.Align
 import Witherable (Filterable (..), Witherable)
 
 -- automaton
+
+import Control.Arrow ((>>>))
+import Control.Monad.Trans.Maybe (MaybeT (..))
 import Data.Stream.Internal
 import Data.Stream.Recursive (Recursive (..))
 import Data.Stream.Result
@@ -524,33 +528,62 @@ fixA StreamT {state, step} = fixStream (JointState state) $
 
 -- FIXME Generalisation in []
 runListS :: (Monad m) => StreamT (Compose m []) a -> StreamT m [a]
-runListS StreamT {state, step} =
+runListS = runTraversableS
+
+runTraversableS :: (Monad m, Traversable t, Monad t) => StreamT (Compose m t) a -> StreamT m (t a)
+runTraversableS StreamT {state, step} =
   StreamT
-    { state = [state]
+    { state = pure state
     , step = \states -> do
-        results <- forM states $ getCompose . step
-        let flatResults = concat results
-        return $ Result (resultState <$> flatResults) (output <$> flatResults)
+        results <- traverse (getCompose . step) states
+        return $ unzipResult $ join results
     }
 
 -- FIXME maybe rewrite with Iso somehow?
-handleCompose :: (Functor f, Monad m, Monad composed) => (forall s. s -> f s) -> (forall x. composed x -> m (f x)) -> (forall x. m (f x) -> composed x) -> StreamT composed a -> StreamT m (f a)
+handleCompose :: (Functor f, Applicative m, Monad composed) => (forall s. s -> f s) -> (forall x. composed x -> m (f x)) -> (forall x. m (f x) -> composed x) -> StreamT composed a -> StreamT m (f a)
 handleCompose pure_ uncompose compose StreamT {state, step} =
   StreamT
     { state = pure_ state
-    , step = \s -> do
-        results <- uncompose $ do
-          states <- compose $ pure s
-          step states
-        return $! Result (fmap resultState results) (fmap output results)
+    , step = \s ->
+        uncompose (compose (pure s) >>= step) <&>
+        (\results -> Result (fmap resultState results) (fmap output results))
     }
 
 -- FIXME all these should go to a separate module
 handleExceptT :: (Monad m) => StreamT (ExceptT e m) a -> StreamT m (Either e a)
 handleExceptT = handleCompose pure runExceptT ExceptT
 
--- FIXME handleMaybeT
+-- handleExceptT' :: (Monad m) => StreamT (ExceptT e m) a -> StreamT m (Either e a)
+-- handleExceptT' = hoist' _ . snapshotCompose . hoist (Compose . runExceptT)
 
+handleMaybeT :: (Monad m) => StreamT (MaybeT m) a -> StreamT m (Maybe a)
+handleMaybeT = handleCompose pure runMaybeT MaybeT
+
+{- | Snapshot part of the side effect that was performed at this step.
+-}
+snapshotCompose :: (Functor m, Functor f) => StreamT (Compose m f) a -> StreamT (Compose m f) (f a)
+snapshotCompose StreamT {state, step} =
+  StreamT
+    { state
+    , step =
+        step
+          >>> getCompose
+          >>> fmap (\result -> flip Result (output <$> result) . resultState <$> result)
+          >>> Compose
+    }
+
+-- snapshotCompose' :: (Monad m, Functor f) => StreamT (Compose m f) a -> StreamT m (f a)
+-- snapshotCompose' StreamT {state, step} =
+--   StreamT
+--     { state = pure state
+--     , step = pure
+--           >>> Compose
+--           >>> _
+--     }
+
+
+{- | Snapshot the side effect that was performed at this step.
+-}
 snapshot :: (Functor m) => StreamT m a -> StreamT m (m a)
 snapshot StreamT {state, step} =
   StreamT
diff --git a/automaton/test/Stream.hs b/automaton/test/Stream.hs
index 182e711c..6ac3aad5 100644
--- a/automaton/test/Stream.hs
+++ b/automaton/test/Stream.hs
@@ -14,8 +14,13 @@ import Test.Tasty.HUnit (testCase, (@?=))
 
 -- automaton
 import Automaton
-import Data.Stream (streamToList, unfold)
+import Data.Stream (streamToList, unfold, unfold_, mmap, handleExceptT, handleCompose, snapshotCompose, hoist')
 import Data.Stream.Result
+import Control.Monad.Trans.Except (throwE)
+import Control.Monad (when)
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.Functor.Compose (Compose(..))
 
 tests =
   testGroup
@@ -32,4 +37,11 @@ tests =
                 automaton2 = unfold 1 (\n -> Result (n + 2) (* n))
              in take 10 (runIdentity (streamToList (automaton1 <*? automaton2))) @?= [0, 1, 2, 9, 4, 25, 6, 49, 8, 81]
         ]
+    , testCase
+        "handleExceptT" $ let exceptionAfter2 = mmap (\n -> when (n == 2) $ throwE ()) $ unfold_ 0 (+1)
+            in take 5 (runIdentity (streamToList (handleExceptT exceptionAfter2))) @?= [Right (),Left (),Left (),Left (),Left ()]
+    , testCase
+        "snapshotCompose" $ let asManyAsN = hoist' (Compose . Identity) $ mmap (\n -> NonEmpty.fromList [0..n]) $ unfold_ 0 (+1)
+            in take 5 (runIdentity (streamToList (hoist' (fmap NonEmpty.head  . getCompose) (snapshotCompose asManyAsN)))) @?= [0 :| [1],0 :| [1,2],0 :| [1,2,3],0 :| [1,2,3,4],0 :| [1,2,3,4,5]]
+
     ]