automaton 1.4 → 1.5

raw patch · 19 files changed

+359/−190 lines, 19 filesdep ~QuickCheckdep ~basedep ~tasty-quickchecksetup-changednew-component:exe:ForeverSawtoothnew-component:exe:UserSawtoothPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck, base, tasty-quickcheck

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• README.md +13/−12
• Setup.hs +2/−0
• automaton.cabal +23/−9
• examples/ForeverSawtooth.hs +13/−0
• examples/UserSawtooth.hs +18/−0
• src/Data/Automaton.hs +8/−3
• src/Data/Automaton/Final.hs +0/−36
• src/Data/Automaton/Recursive.hs +39/−0
• src/Data/Automaton/Trans/Except.hs +70/−5
• src/Data/Stream.hs +27/−9
• src/Data/Stream/Except.hs +36/−18
• src/Data/Stream/Final.hs +0/−63
• src/Data/Stream/Final/Except.hs +0/−18
• src/Data/Stream/Optimized.hs +15/−14
• src/Data/Stream/Recursive.hs +63/−0
• src/Data/Stream/Recursive/Except.hs +18/−0
• test/Automaton.hs +3/−3
• test/Stream.hs +4/−0

@@ -1,5 +1,12 @@ # Revision history for automaton +## 1.5++* Fixed naming Final vs. Recursive vs. Coalgebraic+* Added `forever` utility for recursion in `AutomatonExcept`+* Generalised `concatS`, added `throwOnMaybe`, added `mapOutput`+* Fixed some docs+ ## 1.4  * Added `Data.Automaton.Trans.Accum`

@@ -1,13 +1,13 @@-# `automaton`: Effectful streams and automata in initial encoding+# `automaton`: Effectful streams and automata as coalgebras -This library defines effectful streams and automata, in initial encoding.+This library defines effectful streams and automata, in coalgebraic encoding. They are useful to define effectful automata, or state machines, transducers, monadic stream functions and similar streaming abstractions. In comparison to most other libraries, they are implemented here with explicit state types, and thus are amenable to GHC optimizations, often resulting in dramatically better performance.  ## What? -The core concept is an effectful stream in initial encoding:+The core concept is an effectful stream in coalgebraic encoding: ```haskell data StreamT m a = forall s.   StreamT@@ -15,18 +15,19 @@   , step :: s -> m (s, a)   } ```-This is an stream because you can repeatedly call `step` on the `state` and produce output values `a`,+This is a stream because you can repeatedly call `step` on the `state` and produce output values `a`, while mutating the internal state. It is effectful because each step performs a side effect in `m`, typically a monad. -The definitions you will most often find in the wild is the "final encoding":+The definition you will most often find in the wild is a direct fixpoint, or recursive datatype: ```haskell data StreamT m a = StreamT (m (StreamT m a, a)) ```-Semantically, there is no big difference between them, and in nearly all cases you can map the initial encoding onto the final one and vice versa.-(For the single edge case, see [the section in `Data.Automaton` about recursive definitions](hackage.haskell.org/package/automaton/docs/Data.Automaton.html).)+Semantically, there is no big difference between them, and in nearly all cases you can map the coalgebraic encoding onto the recursive one and vice versa,+by means of the final coalgebra.+(For the few edge cases, see [the section in `Data.Automaton` about recursive definitions](hackage.haskell.org/package/automaton/docs/Data.Automaton.html).) But when composing streams,-the initial encoding will often be more performant that than the final encoding because GHC can optimise the joint state and step functions of the streams.+the coalgebraic encoding will usually be more performant that than the recursive one because GHC can optimise the joint state and step functions of the streams.  ### How are these automata? @@ -42,9 +43,9 @@ ## Why?  Mostly, performance.-When composing a big automaton out of small ones, the final encoding is not very performant, as mentioned above:+When composing a big automaton out of small ones, the recursive definition is not very performant, as mentioned above: Each step of each component contains a closure, which is basically opaque for the compiler.-In the initial encoding, the step functions of two composed automata are themselves composed, and the compiler can optimize them just like any regular function.+In the coalgebraic encoding, the step functions of two composed automata are themselves composed, and the compiler can optimize them just like any regular function. This often results in massive speedups.  ### But really, why?@@ -61,9 +62,9 @@ (which are essentially effectful state machines) and has inspired the design and API of this package to a great extent. (Feel free to extend this list by other notable libraries.)-But all of these are implemented in the final encoding.+But all of these are implemented recursively. -I am aware of only two fleshed-out implementations of effectful automata in the initial encoding,+I am aware of only two fleshed-out implementations of effectful automata in the coalgebraic encoding, both of which have been a big inspiration for this package:  * [`essence-of-live-coding`](https://hackage.haskell.org/package/essence-of-live-coding) restricts the state type to be serializable, gaining live coding capabilities, but sacrificing on expressivity.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -1,7 +1,7 @@ cabal-version: 3.0 name: automaton-version: 1.4-synopsis: Effectful streams and automata in initial encoding+version: 1.5+synopsis: Effectful streams and automata in coalgebraic encoding description:   Effectful streams have an internal state and a step function.   Varying the effect type, this gives many different useful concepts:@@ -24,12 +24,12 @@ source-repository this   type: git   location: https://github.com/turion/rhine.git-  tag: v1.4+  tag: v1.5  common opts   build-depends:     MonadRandom >=0.5,-    base >=4.14 && <4.20,+    base >=4.16 && <4.21,     mmorph ^>=1.2,     mtl >=2.2 && <2.4,     profunctors ^>=5.6,@@ -64,7 +64,7 @@   import: opts   exposed-modules:     Data.Automaton-    Data.Automaton.Final+    Data.Automaton.Recursive     Data.Automaton.Trans.Accum     Data.Automaton.Trans.Except     Data.Automaton.Trans.Maybe@@ -75,14 +75,14 @@     Data.Automaton.Trans.Writer     Data.Stream     Data.Stream.Except-    Data.Stream.Final     Data.Stream.Internal     Data.Stream.Optimized+    Data.Stream.Recursive     Data.Stream.Result    other-modules:     Data.Automaton.Trans.Except.Internal-    Data.Stream.Final.Except+    Data.Stream.Recursive.Except    hs-source-dirs: src @@ -98,11 +98,25 @@     Stream    build-depends:-    QuickCheck ^>=2.14,+    QuickCheck >=2.14 && <2.16,     automaton,     tasty >=1.4 && <1.6,     tasty-hunit ^>=0.10,-    tasty-quickcheck ^>=0.10,+    tasty-quickcheck >=0.10 && <0.12,++executable UserSawtooth+  import: opts+  hs-source-dirs: examples+  main-is: UserSawtooth.hs+  build-depends:+    automaton++executable ForeverSawtooth+  import: opts+  hs-source-dirs: examples+  main-is: ForeverSawtooth.hs+  build-depends:+    automaton  flag dev   description: Enable warnings as errors. Active on ci.

@@ -0,0 +1,13 @@+-- base+import Control.Arrow ((>>>))+import Control.Monad (guard)++-- automaton+import Data.Automaton+import Data.Automaton.Trans.Except++sawtooth :: Automaton IO a Int+sawtooth = forever $ try $ count >>> throwOnMaybe (\n -> guard (n > 10))++main :: IO ()+main = reactimate $ sawtooth >>> arrM print

@@ -0,0 +1,18 @@+-- base+import Control.Arrow ((>>>))+import Control.Monad (guard)++-- automaton+import Data.Automaton+import Data.Automaton.Trans.Except++userSawtooth :: Int -> Automaton IO a Int+userSawtooth nMax = safely $ do+  try $ count >>> throwOnMaybe (\n -> guard (n > nMax))+  nMax' <- once_ $ do+    putStrLn "Maximum reached, please enter next nMax:"+    readLn+  safe $ userSawtooth nMax'++main :: IO ()+main = reactimate $ userSawtooth 10 >>> arrM print

@@ -57,7 +57,7 @@  -- * Constructing automata -{- | An effectful automaton in initial encoding.+{- | An effectful automaton in coalgebraic encoding.  * @m@: The monad in which the automaton performs side effects. * @a@: The type of inputs the automaton constantly consumes.@@ -451,8 +451,13 @@ handleAutomaton :: (Monad 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'.-concatS :: (Monad m) => Automaton m () [b] -> Automaton m () b+{- | Buffer the output of an automaton. See 'Data.Stream.concatS'.++The input for the automaton is not buffered.+For example, if @'concatS' automaton@ receives one input @a@ and @automaton@ produces 10 @b@s from it,+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  -- * Examples

@@ -1,36 +0,0 @@-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}--module Data.Automaton.Final where---- base-import Control.Applicative (Alternative)-import Control.Arrow-import Control.Category-import Prelude hiding (id, (.))---- transformers-import Control.Monad.Trans.Reader---- automaton-import Data.Automaton-import Data.Stream.Final qualified as StreamFinal-import Data.Stream.Optimized qualified as StreamOptimized---- | Automata in final encoding.-newtype Final m a b = Final {getFinal :: StreamFinal.Final (ReaderT a m) b}-  deriving newtype (Functor, Applicative, Alternative)--instance (Monad m) => Category (Final m) where-  id = toFinal id-  f1 . f2 = toFinal $ fromFinal f1 . fromFinal f2--instance (Monad m) => Arrow (Final m) where-  arr = toFinal . arr-  first = toFinal . first . fromFinal--toFinal :: (Functor m) => Automaton m a b -> Final m a b-toFinal (Automaton automaton) = Final $ StreamOptimized.toFinal automaton--fromFinal :: Final m a b -> Automaton m a b-fromFinal Final {getFinal} = Automaton $ StreamOptimized.fromFinal getFinal

@@ -0,0 +1,39 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Data.Automaton.Recursive where++-- base+import Control.Applicative (Alternative)+import Control.Arrow+import Control.Category+import Prelude hiding (id, (.))++-- transformers+import Control.Monad.Trans.Reader++-- automaton+import Data.Automaton+import Data.Stream.Optimized qualified as StreamOptimized+import Data.Stream.Recursive qualified as StreamRecursive++{- | Automata in direct recursive encoding.++This type is isomorphic to @MSF@ from @dunai@.+-}+newtype Recursive m a b = Recursive {getRecursive :: StreamRecursive.Recursive (ReaderT a m) b}+  deriving newtype (Functor, Applicative, Alternative)++instance (Monad m) => Category (Recursive m) where+  id = toRecursive id+  f1 . f2 = toRecursive $ fromRecursive f1 . fromRecursive f2++instance (Monad m) => Arrow (Recursive m) where+  arr = toRecursive . arr+  first = toRecursive . first . fromRecursive++toRecursive :: (Functor m) => Automaton m a b -> Recursive m a b+toRecursive (Automaton automaton) = Recursive $ StreamOptimized.toRecursive automaton++fromRecursive :: Recursive m a b -> Automaton m a b+fromRecursive Recursive {getRecursive} = Automaton $ StreamOptimized.fromRecursive getRecursive

@@ -46,8 +46,8 @@   reactimate,  ) import Data.Automaton.Trans.Except.Internal-import Data.Stream.Except hiding (safely)-import Data.Stream.Except qualified as StreamExcept+import Data.Stream.Except hiding (safe, safely)+import Data.Stream.Except qualified as StreamExcept hiding (safe) import Data.Stream.Optimized (mapOptimizedStreamT) import Data.Stream.Optimized qualified as StreamOptimized @@ -82,6 +82,12 @@     then throwS -< e     else returnA -< () +-- | When the predicate evaluates to @Just e@, throw the exception @e@, otherwise forward the input.+throwOnMaybe :: (Monad m) => (a -> Maybe e) -> Automaton (ExceptT e m) a a+throwOnMaybe f = proc a -> do+  throwMaybe -< f a+  returnA -< a+ {- | When the input is @Just e@, throw the exception @e@.  This does not output any data since it terminates on the first nontrivial input.@@ -189,6 +195,24 @@ The function @f@ is called on the exception value and produces a continuation automaton which is then executed (until it possibly throws an exception @e2@ itself). +Note: By "exceptions", we mean an 'ExceptT' transformer layer, not 'IO' exceptions.++= @do@-Notation++Since the type has a 'Monad' instance, you can use @do@ notation to define exception handling:++@+example :: Monad m => Automaton m a Int+example = safely $ do+  try $ count >>> throwOnMaybe (\n -> guard (n < 10))+  safe $ arr $ const 0+@++Here, a counter is incremented until it reaches 10.+Once it does, an exception is thrown, and the automaton continues to output 0 forever.++= Performance of 'Monad' vs. 'Applicative'+ The generality of the monad interface comes at a cost, though. In order to achieve higher performance, you should use the 'Monad' interface sparingly. Whenever you can express the same control flow using 'Functor', 'Applicative', 'Selective',@@ -202,7 +226,45 @@ But often the full expressiveness of '>>=' isn't necessary, and in these cases, a much faster automaton is produced by using 'Functor', 'Applicative' and 'Selective'. -Note: By "exceptions", we mean an 'ExceptT' transformer layer, not 'IO' exceptions.+== Recursive definitions when not using the full 'Monad' interface++When the optimized interface is used (by avoiding '>>='),+the same caveat as in "Data.Stream" regarding recursive definitions applies:+They will loop at runtime.++For example, one might expect that this automaton would repeatedly output numbers below or equal to 10:++@+bad :: Monad m => Automaton m a Int+bad = safely $ do+  try $ count >>> throwOnMaybe (\n -> guard (n > 10))+  safe bad+@++But in fact it will loop, and never produce output.+This is because the @do@ notation desugars to an expression involving @>>@, not @>>=@,+which has higher performance in principle, but doesn't support recursion.++Using the full monad interface misses out on some optimizations, but works:++@+userSawtooth :: Int -> Automaton IO a Int+userSawtooth nMax = safely $ do+  try $ count >>> throwOnMaybe (\n -> guard (n > nMax))+  nMax' <- once_ $ do+    putStrLn "Maximum reached, please enter next nMax:"+    readLn+  safe $ userSawtooth nMax'+@++The reason this do notation is desugared using @>>=@ is because the variable @nMax'@ is used later.++To define a recursive, optimized, exception handling automaton, use 'forever':++@+sawtooth :: Automaton IO a Int+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)@@ -221,7 +283,7 @@ Typically used to enter the monad context of 'AutomatonExcept'. -} try :: (Monad m) => Automaton (ExceptT e m) a b -> AutomatonExcept a b m e-try = AutomatonExcept . InitialExcept . hoist commuteReader . getAutomaton+try = AutomatonExcept . CoalgebraicExcept . hoist commuteReader . getAutomaton  {- | Immediately throw the current input as an exception. @@ -255,11 +317,14 @@ safe :: (Monad m) => Automaton m a b -> AutomatonExcept a b m e safe = try . liftS +forever :: (Monad m) => AutomatonExcept a b m e -> Automaton m a b+forever = Automaton . StreamExcept.forever . getAutomatonExcept+ {- | Inside the 'AutomatonExcept' monad, execute an action of the wrapped monad. This passes the last input value to the action, but doesn't advance a tick. -} once :: (Monad m) => (a -> m e) -> AutomatonExcept a b m e-once f = AutomatonExcept $ InitialExcept $ StreamOptimized.constM $ ExceptT $ ReaderT $ fmap Left <$> f+once f = AutomatonExcept $ CoalgebraicExcept $ StreamOptimized.constM $ ExceptT $ ReaderT $ fmap Left <$> f  -- | Variant of 'once' without input. once_ :: (Monad m) => m e -> AutomatonExcept a b m e

@@ -39,7 +39,7 @@  -- * Creating streams -{- | Effectful streams in initial encoding.+{- | Effectful streams in coalgebraic encoding.  A stream consists of an internal state @s@, and a step function. This step can make use of an effect in @m@ (which is often a monad),@@ -47,19 +47,19 @@ Its semantics is continuously outputting values of type @b@, while performing side effects in @m@. -An initial encoding was chosen instead of the final encoding known from e.g. @list-transformer@, @dunai@, @machines@, @streaming@, ...,-because the initial encoding is much more amenable to compiler optimizations-than the final encoding, which is:+A coalgebraic encoding was chosen instead of the direct recursion known from e.g. @list-transformer@, @dunai@, @machines@, @streaming@, ...,+because the coalgebraic encoding is much more amenable to compiler optimizations+than the coalgebraic encoding, which is:  @-  data StreamFinalT m b = StreamFinalT (m (b, StreamFinalT m b))+  data StreamRecursiveT m b = StreamRecursiveT (m (b, StreamRecursiveT m b)) @  When two streams are composed, GHC can often optimize the combined step function,-resulting in a faster streams than what the final encoding can ever achieve,-because the final encoding has to step through every continuation.+resulting in a faster streams than what the coalgebraic encoding can ever achieve,+because the coalgebraic encoding has to step through every continuation. Put differently, the compiler can perform static analysis on the state types of initially encoded state machines,-while the final encoding knows its state only at runtime.+while the coalgebraic encoding knows its state only at runtime.  This performance gain comes at a peculiar cost: Recursive definitions /of/ streams are not possible, e.g. an equation like:@@ -268,6 +268,24 @@     step (Right (s2, f)) = mapResultState (Right . (,f)) <$!> withExceptT f (step2 s2) {-# INLINE applyExcept #-} +{- | Execute the stream until it throws an exception, then restart it.++One might be tempted to define this function recursively with 'applyExcept',+but this would result in a runtime error, trying to define an infinite state.+-}+foreverExcept :: (Functor m, Monad m) => StreamT (ExceptT e m) a -> StreamT m a+foreverExcept StreamT {state, step} =+  StreamT+    { state+    , step = stepNew+    }+  where+    stepNew s = do+      resultOrException <- runExceptT $ step s+      case resultOrException of+        Left _ -> stepNew state+        Right result -> return result+ -- | Whenever an exception occurs, output it and retry on the next step. exceptS :: (Applicative m) => StreamT (ExceptT e m) b -> StreamT m (Either e b) exceptS StreamT {state, step} =@@ -411,7 +429,7 @@ {- | 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 initial encoding of the state.+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) $

@@ -15,10 +15,11 @@ import Control.Selective  -- automaton-import Data.Stream.Final (Final (..))-import Data.Stream.Final.Except+import Data.Stream (foreverExcept) import Data.Stream.Optimized (OptimizedStreamT, applyExcept, constM, selectExcept) import Data.Stream.Optimized qualified as StreamOptimized+import Data.Stream.Recursive (Recursive (..))+import Data.Stream.Recursive.Except  {- | A stream that can terminate with an exception. @@ -29,42 +30,59 @@ -} data StreamExcept a m e   = -- | When using '>>=', this encoding will be used.-    FinalExcept (Final (ExceptT e m) a)+    RecursiveExcept (Recursive (ExceptT e m) a)   | -- | This is usually the faster encoding, as it can be optimized by GHC.-    InitialExcept (OptimizedStreamT (ExceptT e m) a)+    CoalgebraicExcept (OptimizedStreamT (ExceptT e m) a) -toFinal :: (Functor m) => StreamExcept a m e -> Final (ExceptT e m) a-toFinal (FinalExcept final) = final-toFinal (InitialExcept initial) = StreamOptimized.toFinal initial+-- | 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 +toRecursive :: (Functor m) => StreamExcept a m e -> Recursive (ExceptT e m) a+toRecursive (RecursiveExcept coalgebraic) = coalgebraic+toRecursive (CoalgebraicExcept coalgebraic) = StreamOptimized.toRecursive coalgebraic+ runStreamExcept :: StreamExcept a m e -> OptimizedStreamT (ExceptT e m) a-runStreamExcept (FinalExcept final) = StreamOptimized.fromFinal final-runStreamExcept (InitialExcept initial) = initial+runStreamExcept (RecursiveExcept coalgebraic) = StreamOptimized.fromRecursive coalgebraic+runStreamExcept (CoalgebraicExcept coalgebraic) = coalgebraic  instance (Monad m) => Functor (StreamExcept a m) where-  fmap f (FinalExcept fe) = FinalExcept $ hoist (withExceptT f) fe-  fmap f (InitialExcept ae) = InitialExcept $ hoist (withExceptT f) ae+  fmap f (RecursiveExcept fe) = RecursiveExcept $ hoist (withExceptT f) fe+  fmap f (CoalgebraicExcept ae) = CoalgebraicExcept $ hoist (withExceptT f) ae  instance (Monad m) => Applicative (StreamExcept a m) where-  pure = InitialExcept . constM . throwE-  InitialExcept f <*> InitialExcept a = InitialExcept $ applyExcept f a+  pure = CoalgebraicExcept . constM . throwE+  CoalgebraicExcept f <*> CoalgebraicExcept a = CoalgebraicExcept $ applyExcept f a   f <*> a = ap f a  instance (Monad m) => Selective (StreamExcept a m) where-  select (InitialExcept e) (InitialExcept f) = InitialExcept $ selectExcept e f+  select (CoalgebraicExcept e) (CoalgebraicExcept f) = CoalgebraicExcept $ selectExcept e f   select e f = selectM e f  -- | 'return'/'pure' throw exceptions, '(>>=)' uses the last thrown exception as input for an exception handler. instance (Monad m) => Monad (StreamExcept a m) where   (>>) = (*>)-  ae >>= f = FinalExcept $ handleExceptT (toFinal ae) (toFinal . f)+  ae >>= f = RecursiveExcept $ handleExceptT (toRecursive ae) (toRecursive . f)  instance MonadTrans (StreamExcept a) where-  lift = InitialExcept . constM . ExceptT . fmap Left+  lift = CoalgebraicExcept . constM . ExceptT . fmap Left  instance MFunctor (StreamExcept a) where-  hoist morph (InitialExcept automaton) = InitialExcept $ hoist (mapExceptT morph) automaton-  hoist morph (FinalExcept final) = FinalExcept $ hoist (mapExceptT morph) final+  hoist morph (RecursiveExcept recursive) = RecursiveExcept $ hoist (mapExceptT morph) recursive+  hoist morph (CoalgebraicExcept coalgebraic) = CoalgebraicExcept $ hoist (mapExceptT morph) coalgebraic  safely :: (Monad m) => StreamExcept a m Void -> OptimizedStreamT m a safely = hoist (fmap (either absurd id) . runExceptT) . runStreamExcept++safe :: (Monad m) => OptimizedStreamT m a -> StreamExcept a m void+safe = CoalgebraicExcept . hoist lift++forever :: (Monad m) => StreamExcept a m e -> OptimizedStreamT m a+forever recursive@(RecursiveExcept _) = safely go+  where+    go = recursive >> go+forever (CoalgebraicExcept (StreamOptimized.Stateful stream)) = StreamOptimized.Stateful $ foreverExcept stream+forever (CoalgebraicExcept (StreamOptimized.Stateless f)) = StreamOptimized.Stateless go+  where+    go = runExceptT f >>= either (const go) return

@@ -1,63 +0,0 @@-module Data.Stream.Final where---- base-import Control.Applicative (Alternative (..))---- mmorph-import Control.Monad.Morph (MFunctor (..))---- automaton-import Data.Stream (StreamT (..), stepStream)-import Data.Stream.Result--{- | A stream transformer in final encoding.--One step of the stream transformer performs a monadic action and results in an output and a new stream.--}-newtype Final m a = Final {getFinal :: m (Result (Final m a) a)}--{- | Translate an initially encoded stream into a finally encoded one.--This is usually a performance penalty.--}-toFinal :: (Functor m) => StreamT m a -> Final m a-toFinal automaton = Final $ mapResultState toFinal <$> stepStream automaton-{-# INLINE toFinal #-}--{- | Translate a finally encoded stream into an initially encoded one.--The internal state is the stream itself.--}-fromFinal :: Final m a -> StreamT m a-fromFinal final =-  StreamT-    { state = final-    , step = getFinal-    }-{-# INLINE fromFinal #-}--instance MFunctor Final where-  hoist morph = go-    where-      go Final {getFinal} = Final $ morph $ mapResultState go <$> getFinal--instance (Functor m) => Functor (Final m) where-  fmap f Final {getFinal} = Final $ fmap f . mapResultState (fmap f) <$> getFinal--instance (Applicative m) => Applicative (Final m) where-  pure a = go-    where-      go = Final $! pure $! Result go a--  Final mf <*> Final ma = Final $! (\(Result cf f) (Result ca a) -> Result (cf <*> ca) $! f a) <$> mf <*> ma---- | Constantly perform the same effect, without remembering a state.-constM :: (Functor m) => m a -> Final m a-constM ma = go-  where-    go = Final $ Result go <$> ma--instance (Alternative m) => Alternative (Final m) where-  empty = constM empty--  Final ma1 <|> Final ma2 = Final $ ma1 <|> ma2

@@ -1,18 +0,0 @@-module Data.Stream.Final.Except where---- transformers-import Control.Monad.Trans.Class-import Control.Monad.Trans.Except (ExceptT, runExceptT)---- automaton-import Data.Stream.Final (Final (..))-import Data.Stream.Result (mapResultState)--handleExceptT :: (Monad m) => Final (ExceptT e1 m) b -> (e1 -> Final (ExceptT e2 m) b) -> Final (ExceptT e2 m) b-handleExceptT final handler = go final-  where-    go final = Final $ do-      resultOrException <- lift $ runExceptT $ getFinal final-      case resultOrException of-        Right result -> return $! mapResultState go result-        Left e -> getFinal $ handler e

@@ -27,14 +27,15 @@ -- mmorph import Control.Monad.Morph --- automaton-+-- align import Data.Align (Align, Semialign) import Data.Semialign (Align (..), Semialign (..))++-- automaton import Data.Stream hiding (hoist') import Data.Stream qualified as StreamT-import Data.Stream.Final (Final (..))-import Data.Stream.Final qualified as Final (fromFinal, toFinal)+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.@@ -182,23 +183,23 @@ stepOptimizedStream oa@(Stateless m) = Result oa <$> m {-# INLINE stepOptimizedStream #-} -{- | Translate to the final encoding of streams.+{- | Translate to the recursive encoding of streams.  This will typically be a performance penalty. -}-toFinal :: (Functor m) => OptimizedStreamT m a -> Final m a-toFinal (Stateful stream) = Final.toFinal stream-toFinal (Stateless f) = go+toRecursive :: (Functor m) => OptimizedStreamT m a -> Recursive m a+toRecursive (Stateful stream) = Recursive.toRecursive stream+toRecursive (Stateless f) = go   where-    go = Final $ Result go <$> f-{-# INLINE toFinal #-}+    go = Recursive $ Result go <$> f+{-# INLINE toRecursive #-} -{- | Translate a stream from final encoding to stateful, initial encoding.+{- | Translate a stream from recursive encoding to stateful, coalgebraic encoding.   The internal state is the stream itself. -}-fromFinal :: Final m a -> OptimizedStreamT m a-fromFinal = Stateful . Final.fromFinal-{-# INLINE fromFinal #-}+fromRecursive :: Recursive m a -> OptimizedStreamT m a+fromRecursive = Stateful . Recursive.fromRecursive+{-# INLINE fromRecursive #-}  -- | See 'Data.Stream.concatS'. concatS :: (Monad m) => OptimizedStreamT m [a] -> OptimizedStreamT m a

@@ -0,0 +1,63 @@+module Data.Stream.Recursive where++-- base+import Control.Applicative (Alternative (..))++-- mmorph+import Control.Monad.Morph (MFunctor (..))++-- automaton+import Data.Stream (StreamT (..), stepStream)+import Data.Stream.Result++{- | A stream transformer in recursive encoding.++One step of the stream transformer performs a monadic action and results in an output and a new stream.+-}+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+      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++instance (Applicative m) => Applicative (Recursive m) where+  pure a = go+    where+      go = Recursive $! pure $! Result go a++  Recursive mf <*> Recursive ma = Recursive $! (\(Result cf f) (Result ca a) -> Result (cf <*> ca) $! f a) <$> mf <*> ma++-- | Constantly perform the same effect, without remembering a state.+constM :: (Functor m) => m a -> Recursive m a+constM ma = go+  where+    go = Recursive $ Result go <$> ma++instance (Alternative m) => Alternative (Recursive m) where+  empty = constM empty++  Recursive ma1 <|> Recursive ma2 = Recursive $ ma1 <|> ma2

@@ -0,0 +1,18 @@+module Data.Stream.Recursive.Except where++-- transformers+import Control.Monad.Trans.Class+import Control.Monad.Trans.Except (ExceptT, runExceptT)++-- automaton+import Data.Stream.Recursive (Recursive (..))+import Data.Stream.Result (mapResultState)++handleExceptT :: (Monad m) => Recursive (ExceptT e1 m) b -> (e1 -> Recursive (ExceptT e2 m) b) -> Recursive (ExceptT e2 m) b+handleExceptT recursive handler = go recursive+  where+    go recursive = Recursive $ do+      resultOrException <- lift $ runExceptT $ getRecursive recursive+      case resultOrException of+        Right result -> return $! mapResultState go result+        Left e -> getRecursive $ handler e

@@ -30,7 +30,7 @@ import Automaton.Except import Automaton.Trans.Accum import Data.Automaton-import Data.Automaton.Final+import Data.Automaton.Recursive import Data.Automaton.Trans.Maybe  tests =@@ -40,10 +40,10 @@         "Alternative"         [ testGroup             "<|>"-            [ testProperty "has same semantics as final" $+            [ testProperty "has same semantics as recursive" $                 \(input :: [(Maybe Int, Maybe Int)]) ->                   embed ((arr fst >>> inMaybe) <|> (arr snd >>> inMaybe)) input-                    === embed (fromFinal $ (arr fst >>> toFinal inMaybe) <|> (arr snd >>> toFinal inMaybe)) input+                    === embed (fromRecursive $ (arr fst >>> toRecursive inMaybe) <|> (arr snd >>> toRecursive inMaybe)) input             ]         , testGroup             "some"

@@ -27,5 +27,9 @@             let automaton1 = unfold 0 (\n -> Result (n + 1) (if even n then Right n else Left n))                 automaton2 = pure (* 10)              in take 10 (runIdentity (streamToList (automaton1 <*? automaton2))) @?= [0, 10, 2, 30, 4, 50, 6, 70, 8, 90]+        , testCase "Progresses state of second stream only when first stream returns Left" $+            let automaton1 = unfold 0 (\n -> Result (n + 1) (if even n then Right n else Left n))+                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]         ]     ]