packages feed

automaton 1.6.1 → 1.7

raw patch · 10 files changed

+201/−26 lines, 10 filesdep ~changesetPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: changeset

API changes (from Hackage documentation)

+ Data.Automaton: initial :: forall (m :: Type -> Type) a. Applicative m => Automaton m a a
+ Data.Automaton.Trans.Except: foreverE :: forall (m :: Type -> Type) e a b. Monad m => e -> AutomatonExcept a b (ReaderT e m) e -> Automaton m a b
+ Data.Stream: foreverExceptE :: forall (m :: Type -> Type) e a. (Functor m, Monad m) => e -> StreamT (ExceptT e (ReaderT e m)) a -> StreamT m a
+ Data.Stream.Except: foreverE :: forall (m :: Type -> Type) e a. Monad m => e -> StreamExcept a (ReaderT e m) e -> OptimizedStreamT m a

Files

CHANGELOG.md view
@@ -1,5 +1,11 @@ # Revision history for automaton +## 1.7++* Add `safely`, `forever` and `foreverE` exception handling functions for streams+* Use `TimeDomain Seconds` extensively+* Add `|-|` and `||-||` resampling buffer utilities+ ## 1.6  * Fix `lastS`. Thanks to Sebastian Wålinder for reporting.
automaton.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: automaton-version: 1.6.1+version: 1.7 synopsis: Effectful streams and automata in coalgebraic encoding description:   Effectful streams have an internal state and a step function.@@ -30,7 +30,7 @@   build-depends:     MonadRandom >=0.5,     base >=4.16 && <4.22,-    changeset ^>=0.1.1,+    changeset ^>=0.2,     mmorph ^>=1.2,     mtl >=2.2 && <2.4,     profunctors ^>=5.6,@@ -47,14 +47,26 @@     -W    default-extensions:+    ApplicativeDo     Arrows     DataKinds+    DerivingStrategies+    DerivingVia+    ExistentialQuantification     FlexibleContexts     FlexibleInstances+    GADTs+    GeneralizedNewtypeDeriving     ImportQualifiedPost+    InstanceSigs+    LambdaCase     MultiParamTypeClasses     NamedFieldPuns     NoStarIsType+    NumericUnderscores+    RankNTypes+    ScopedTypeVariables+    StandaloneDeriving     TupleSections     TypeApplications     TypeFamilies
src/Data/Automaton.hs view
@@ -3,7 +3,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE RankNTypes #-} {-# LANGUAGE UndecidableInstances #-}  module Data.Automaton where@@ -78,6 +77,7 @@ This allows for more ways of creating or composing them.  For example, you can sequentially and parallely compose two automata:+ @ automaton1 :: Automaton m a b automaton2 :: Automaton m b c@@ -88,6 +88,7 @@ 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. @@ -475,7 +476,7 @@ {- | Launch many copies of the automaton in parallel, depending on the input shape.  * This generalises 'parallelyList' from lists to arbitrary 'Witherable's satisfying 'Align'-  such as 'Map's, 'Seq'uences', and other data structures.+  such as 'Map's, 'Seq'uences, and other data structures. * The copies of the automaton are launched on demand as the input shape changes in such a way that there are new positions. * The automaton copy on a particular position will always receive the input from that position. * Only those automaton copies on positions with a matching input will be stepped.@@ -650,6 +651,12 @@ lastS :: (Monad m) => a -> Automaton m (Maybe a) a lastS a = arr Last >>> mappendFromR mempty >>> arr (getLast >>> fromMaybe a) {-# INLINE lastS #-}++-- | Indefinitely outputs the first input value+initial :: (Applicative m) => Automaton m a a+initial = unfold Nothing $ \aInput -> \case+  Nothing -> Result (Just aInput) aInput+  s@(Just a) -> Result s a  -- | Call the monadic action once on the first tick and provide its result indefinitely. initialised :: (Monad m) => (a -> m b) -> Automaton m a b
src/Data/Automaton/Filter.hs view
@@ -56,8 +56,9 @@ -} newtype FilterAutomaton m f a b = FilterAutomaton   { getFilterAutomaton :: Automaton m a (f b)-  -- ^ Interpret a 'FilterAutomaton'.-  --   For instance if @f = 'Maybe'@, the resulting automaton will output 'Nothing' whenever there is no output of the 'FilterAutomaton'.+  {- ^ Interpret a 'FilterAutomaton'.+  For instance if @f = 'Maybe'@, the resulting automaton will output 'Nothing' whenever there is no output of the 'FilterAutomaton'.+  -}   }   deriving (Functor, Applicative, Alternative) via Compose (Automaton m a) f 
src/Data/Automaton/Trans/Except.hs view
@@ -59,6 +59,7 @@   if cond a     then throwS -< e     else returnA -< a+{-# INLINEABLE throwOnCond #-}  {- | Throws the exception when the input is 'True'. @@ -70,10 +71,12 @@   if b     then throwS -< e     else returnA -< a+{-# INLINEABLE throwOnCondM #-}  -- | Throw the exception when the input is 'True'. throwOn :: (Monad m) => e -> Automaton (ExceptT e m) Bool () throwOn e = proc b -> throwOn' -< (b, e)+{-# INLINEABLE throwOn #-}  -- | Variant of 'throwOn', where the exception may change every tick. throwOn' :: (Monad m) => Automaton (ExceptT e m) (Bool, e) ()@@ -81,12 +84,14 @@   if b     then throwS -< e     else returnA -< ()+{-# INLINEABLE throwOn' #-}  -- | 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+{-# INLINEABLE throwOnMaybe #-}  {- | When the input is @Just e@, throw the exception @e@. @@ -94,6 +99,7 @@ -} throwMaybe :: (Monad m) => Automaton (ExceptT e m) (Maybe e) (Maybe void) throwMaybe = mapMaybeS throwS+{-# INLINEABLE throwMaybe #-}  {- | Immediately throw the incoming exception. @@ -102,14 +108,17 @@ -} throwS :: (Monad m) => Automaton (ExceptT e m) e a throwS = arrM throwE+{-# INLINEABLE throwS #-}  -- | Immediately throw the given exception. throw :: (Monad m) => e -> Automaton (ExceptT e m) a b throw = constM . throwE+{-# INLINEABLE throw #-}  -- | Do not throw an exception. pass :: (Monad m) => Automaton (ExceptT e m) a a pass = Category.id+{-# INLINEABLE pass #-}  {- | Converts an 'Automaton' in 'MaybeT' to an 'Automaton' in 'ExceptT'. @@ -120,6 +129,7 @@   Automaton (MaybeT m) a b ->   Automaton (ExceptT () m) a b maybeToExceptS = hoistS (ExceptT . (maybe (Left ()) Right <$>) . runMaybeT)+{-# INLINEABLE maybeToExceptS #-}  -- * Catching exceptions @@ -134,6 +144,7 @@ catchS automaton f = safely $ do   e <- try automaton   safe $ f e+{-# INLINEABLE catchS #-}  -- | Similar to Yampa's delayed switching. Loses a @b@ in case of an exception. untilE ::@@ -145,6 +156,7 @@   b <- liftS automaton -< a   me <- liftS automatone -< b   inExceptT -< ExceptT $ return $ maybe (Right b) Left me+{-# INLINEABLE untilE #-}  {- | Escape an 'ExceptT' layer by outputting the exception whenever it occurs. @@ -152,6 +164,7 @@ -} exceptS :: (Functor m, Monad m) => Automaton (ExceptT e m) a b -> Automaton m a (Either e b) exceptS = Automaton . StreamOptimized.exceptS . mapOptimizedStreamT commuteReader . getAutomaton+{-# INLINEABLE exceptS #-}  {- | Embed an 'ExceptT' value inside the 'Automaton'. @@ -159,12 +172,14 @@ -} inExceptT :: (Monad m) => Automaton (ExceptT e m) (ExceptT e m a) a inExceptT = arrM id+{-# INLINEABLE inExceptT #-}  {- | In case an exception occurs in the first argument, replace the exception by the second component of the tuple. -} tagged :: (Monad m) => Automaton (ExceptT e1 m) a b -> Automaton (ExceptT e2 m) (a, e2) b tagged automaton = runAutomatonExcept $ try (automaton <<< arr fst) *> (snd <$> currentInput)+{-# INLINEABLE tagged #-}  -- * Monad interface for Exception Automatons @@ -183,6 +198,7 @@     function, which can throw exceptions in a different type.  Consider this example:+ @ automaton :: AutomatonExcept a b m e1 f :: e1 -> AutomatonExcept a b m e2@@ -271,12 +287,15 @@  instance MonadTrans (AutomatonExcept a b) where   lift = AutomatonExcept . lift . lift+  {-# INLINEABLE lift #-}  instance MFunctor (AutomatonExcept a b) where   hoist morph = AutomatonExcept . hoist (mapReaderT morph) . getAutomatonExcept+  {-# INLINEABLE hoist #-}  runAutomatonExcept :: (Monad m) => AutomatonExcept a b m e -> Automaton (ExceptT e m) a b runAutomatonExcept = Automaton . hoist commuteReaderBack . runStreamExcept . getAutomatonExcept+{-# INLINE runAutomatonExcept #-}  {- | Execute an 'Automaton' in 'ExceptT' until it raises an exception. @@ -284,6 +303,7 @@ -} try :: (Monad m) => Automaton (ExceptT e m) a b -> AutomatonExcept a b m e try = AutomatonExcept . CoalgebraicExcept . hoist commuteReader . getAutomaton+{-# INLINEABLE try #-}  {- | Immediately throw the current input as an exception. @@ -292,6 +312,7 @@ -} currentInput :: (Monad m) => AutomatonExcept e b m e currentInput = try throwS+{-# INLINEABLE currentInput #-}  {- | If no exception can occur, the 'Automaton' can be executed without the 'ExceptT' layer.@@ -307,6 +328,7 @@ -} safely :: (Monad m) => AutomatonExcept a b m Void -> Automaton m a b safely = Automaton . StreamExcept.safely . getAutomatonExcept+{-# INLINEABLE safely #-}  {- | An 'Automaton' without an 'ExceptT' layer never throws an exception, and can thus have an arbitrary exception type.@@ -316,19 +338,37 @@ -} safe :: (Monad m) => Automaton m a b -> AutomatonExcept a b m e safe = try . liftS+{-# INLINEABLE safe #-} +-- | Run the automaton until the exception is thrown, then restart, continuing this cycle forever. forever :: (Monad m) => AutomatonExcept a b m e -> Automaton m a b forever = Automaton . StreamExcept.forever . getAutomatonExcept+{-# INLINEABLE forever #-} +{- | Like 'forever', but keep the last thrown exception.++Before any exception was thrown, an initialisation value is given.+-}+foreverE ::+  (Monad m) =>+  -- | The initial value that is supplied to the 'ReaderT' context before the first exception is thrown+  e ->+  AutomatonExcept a b (ReaderT e m) e ->+  Automaton m a b+foreverE e = Automaton . StreamExcept.foreverE e . hoist (\rae -> ReaderT $ \e -> ReaderT $ \a -> runReaderT (runReaderT rae a) e) . getAutomatonExcept+{-# INLINEABLE foreverE #-}+ {- | 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 $ CoalgebraicExcept $ StreamOptimized.constM $ ExceptT $ ReaderT $ fmap Left <$> f+{-# INLINEABLE once #-}  -- | Variant of 'once' without input. once_ :: (Monad m) => m e -> AutomatonExcept a b m e once_ = once . const+{-# INLINEABLE once_ #-}  -- | Advances a single tick with the given Kleisli arrow, and then throws an exception. step :: (Monad m) => (a -> m (b, e)) -> AutomatonExcept a b m e@@ -337,16 +377,19 @@   (b, e) <- arrM (lift . f) -< a   _ <- throwOn' -< (n > (1 :: Int), e)   returnA -< b+{-# INLINEABLE step #-}  -- | Advances a single tick outputting the value, and then throws '()'. step_ :: (Monad m) => b -> AutomatonExcept a b m () step_ b = step $ const $ return (b, ())+{-# INLINEABLE step_ #-}  {- | Converts a list to an 'AutomatonExcept', which outputs an element of the list at each step, throwing '()' when the list ends. -} listToAutomatonExcept :: (Monad m) => [b] -> AutomatonExcept a b m () listToAutomatonExcept = mapM_ step_+{-# INLINEABLE listToAutomatonExcept #-}  -- * Utilities definable in terms of 'AutomatonExcept' @@ -359,14 +402,17 @@ performOnFirstSample mAutomaton = safely $ do   automaton <- once_ mAutomaton   safe automaton+{-# INLINEABLE performOnFirstSample #-}  -- | 'reactimate's an 'AutomatonExcept' until it throws an exception. reactimateExcept :: (Monad m) => AutomatonExcept () () m e -> m e reactimateExcept ae = fmap (either id absurd) $ runExceptT $ reactimate $ runAutomatonExcept ae+{-# INLINEABLE reactimateExcept #-}  -- | 'reactimate's an 'Automaton' until it returns 'True'. reactimateB :: (Monad m) => Automaton m () Bool -> m () reactimateB ae = reactimateExcept $ try $ liftS ae >>> throwOn ()+{-# INLINEABLE reactimateB #-}  {- | Run the first 'Automaton' until the second value in the output tuple is @Just c@, then start the second automaton, discarding the current output @b@.@@ -380,6 +426,7 @@   (b, me) <- liftS automaton -< a   throwMaybe -< me   returnA -< b+{-# INLINEABLE switch #-}  {- | Run the first 'Automaton' until the second value in the output tuple is @Just c@, then start the second automaton one step later (after the current @b@ has been output).@@ -392,3 +439,4 @@ dSwitch sf = catchS $ feedback Nothing $ proc (a, me) -> do   throwMaybe -< me   liftS sf -< a+{-# INLINEABLE dSwitch #-}
src/Data/Stream.hs view
@@ -1,8 +1,3 @@-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-}  module Data.Stream where@@ -21,6 +16,7 @@ import Control.Monad.Trans.Class import Control.Monad.Trans.Except (ExceptT (..), except, runExceptT, throwE, withExceptT) import Control.Monad.Trans.Maybe (MaybeT (..))+import Control.Monad.Trans.Reader (ReaderT (..)) import Control.Monad.Trans.Writer (WriterT (runWriterT), writer)  -- mmorph@@ -69,9 +65,11 @@  This performance gain comes at a peculiar cost: Recursive definitions /of/ streams are not possible, e.g. an equation like:+ @   fixA stream = stream <*> fixA stream @+ This is impossible since the stream under definition itself appears in the definition body, and thus the internal /state type/ would be recursively defined, which GHC doesn't allow: Type level recursion is not supported in existential types.@@ -87,10 +85,11 @@   { state :: s   -- ^ The internal state of the stream   , step :: s -> m (Result s a)-  -- ^ Stepping a stream by one tick means:-  --   1. performing a side effect in @m@-  --   2. updating the internal state @s@-  --   3. outputting a value of type @a@+  {- ^ Stepping a stream by one tick means:+  1. performing a side effect in @m@+  2. updating the internal state @s@+  3. outputting a value of type @a@+  -}   }  -- | Initialise with an internal state, update the state and produce output without side effects.@@ -356,6 +355,23 @@         Left _ -> stepNew state         Right result -> pure result +{- | Like 'foreverExcept', but keep the last thrown exception.++Before any exception was thrown, an initialisation value is given.+-}+foreverExceptE :: (Functor m, Monad m) => e -> StreamT (ExceptT e (ReaderT e m)) a -> StreamT m a+foreverExceptE e StreamT {state, step} =+  StreamT+    { state = JointState e state+    , step = stepNew+    }+  where+    stepNew (JointState e s) = do+      resultOrException <- runReaderT (runExceptT (step s)) e+      case resultOrException of+        Left e -> stepNew $! JointState e state+        Right result -> pure $! mapResultState (JointState e) 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} =@@ -422,10 +438,12 @@  If you want to define a stream recursively, this is not possible directly. For example, consider this definition:+ @ loops :: Monad m => StreamT m [Int] loops = (:) <$> unfold_ 0 (+ 1) <*> loops @+ The defined value @loops@ contains itself in its definition. This means that the internal state type of @loops@ must itself be recursively defined. But GHC cannot do this automatically, because type level and value level are separate.
src/Data/Stream/Except.hs view
@@ -4,6 +4,7 @@ import Control.Category ((>>>)) import Control.Monad (ap) import Data.Bifunctor (bimap)+import Data.Bitraversable (bisequenceA) import Data.Function ((&)) import Data.Functor ((<&>)) import Data.Void@@ -11,6 +12,7 @@ -- transformers import Control.Monad.Trans.Class import Control.Monad.Trans.Except+import Control.Monad.Trans.Reader (ReaderT (..))  -- mmorph import Control.Monad.Morph (MFunctor, hoist)@@ -19,7 +21,8 @@ import Control.Selective  -- automaton-import Data.Stream (foreverExcept)+import Data.Stream (foreverExcept, foreverExceptE)+import Data.Stream qualified as StreamT import Data.Stream.Optimized as OptimizedStreamT (OptimizedStreamT, applyExcept, constM, hoist', selectExcept) import Data.Stream.Optimized qualified as StreamOptimized import Data.Stream.Recursive (Recursive (..))@@ -66,42 +69,61 @@       traverseRecursive =         getRecursive           >>> runExceptT-          >>> fmap (bimap f (mapResultState traverseRecursive >>> (\Result {resultState, output} -> (Result <$> resultState) <&> ($ output))) >>> bitraverseEither)+          >>> fmap (bimap f (mapResultState traverseRecursive >>> (\Result {resultState, output} -> (Result <$> resultState) <&> ($ output))) >>> bisequenceA)           >>> sequenceA           >>> fmap (ExceptT >>> fmap (mapResultState Recursive))-      bitraverseEither :: (Functor f) => Either (f a) (f b) -> f (Either a b)-      bitraverseEither = either (fmap Left) (fmap Right)  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+  {-# INLINEABLE fmap #-}  instance (Monad m) => Applicative (StreamExcept a m) where   pure = CoalgebraicExcept . constM . throwE+  {-# INLINEABLE pure #-}   CoalgebraicExcept f <*> CoalgebraicExcept a = CoalgebraicExcept $ applyExcept f a   f <*> a = ap f a+  {-# INLINEABLE (<*>) #-}  instance (Monad m) => Selective (StreamExcept a m) where   select (CoalgebraicExcept e) (CoalgebraicExcept f) = CoalgebraicExcept $ selectExcept e f   select e f = selectM e f+  {-# INLINEABLE select #-}  -- | 'return'/'pure' throw exceptions, '(>>=)' uses the last thrown exception as input for an exception handler. instance (Monad m) => Monad (StreamExcept a m) where   (>>) = (*>)+  {-# INLINE (>>) #-} -- FIXME this doesn't inline properly. Because of polymorphism?   ae >>= f = RecursiveExcept $ handleExceptT (toRecursive ae) (toRecursive . f)  instance MonadTrans (StreamExcept a) where   lift = CoalgebraicExcept . constM . ExceptT . fmap Left+  {-# INLINEABLE lift #-}  instance MFunctor (StreamExcept a) where   hoist morph (RecursiveExcept recursive) = RecursiveExcept $ hoist (mapExceptT morph) recursive   hoist morph (CoalgebraicExcept coalgebraic) = CoalgebraicExcept $ hoist (mapExceptT morph) coalgebraic+  {-# INLINEABLE hoist #-} +{- | If no exception can occur, the stream can be executed without the 'ExceptT'+layer.++Used to exit the 'StreamExcept' context, often in combination with 'safe'.+-} safely :: (Monad m) => StreamExcept a m Void -> OptimizedStreamT m a safely = hoist (fmap (either absurd id) . runExceptT) . runStreamExcept+{-# INLINEABLE safely #-}++{- | A stream without an 'ExceptT' layer never throws an exception,+and can thus have an arbitrary exception type.++In particular, the exception type can be 'Void', so it can be used as the last statement in a 'StreamExcept' @do@-block.+See 'safely' for an example.+-} safe :: (Monad m) => OptimizedStreamT m a -> StreamExcept a m void safe = CoalgebraicExcept . hoist lift +-- | Run the stream until the exception is thrown, then restart, continuing this cycle forever. forever :: (Monad m) => StreamExcept a m e -> OptimizedStreamT m a forever recursive@(RecursiveExcept _) = safely go   where@@ -110,3 +132,20 @@ forever (CoalgebraicExcept (StreamOptimized.Stateless f)) = StreamOptimized.Stateless go   where     go = runExceptT f >>= either (const go) pure++{- | Like 'forever', but keep the last thrown exception.++Before any exception was thrown, an initialisation value is given.+-}+foreverE ::+  (Monad m) =>+  -- | The initial value that is supplied to the 'ReaderT' context before the first exception is thrown+  e ->+  StreamExcept a (ReaderT e m) e ->+  OptimizedStreamT m a+foreverE e = \case+  (RecursiveExcept recursive) -> StreamOptimized.Stateful $ foreverExceptE e $ StreamT.fromRecursive recursive+  (CoalgebraicExcept (StreamOptimized.Stateful stream)) -> StreamOptimized.Stateful $ foreverExceptE e stream+  (CoalgebraicExcept (StreamOptimized.Stateless f)) -> StreamOptimized.Stateless $ go e+    where+      go e = runReaderT (runExceptT f) e >>= either go pure
src/Data/Stream/Filter.hs view
@@ -31,8 +31,9 @@ -} newtype FilterStream m f a = FilterStream   { getFilterStream :: StreamT m (f a)-  -- ^ Interpret a 'FilterStream'.-  --   For instance if @f = 'Maybe'@, the resulting stream will output 'Nothing' whenever there is no output of the 'FilterStream'.+  {- ^ Interpret a 'FilterStream'.+  For instance if @f = 'Maybe'@, the resulting stream will output 'Nothing' whenever there is no output of the 'FilterStream'.+  -}   }   deriving (Functor, Foldable, Traversable)   deriving (Applicative) via Compose (StreamT m) f
test/Automaton.hs view
@@ -76,6 +76,10 @@         [ testCase "Remembers a Just value" $ runIdentity (embed (lastS 0) [Nothing, Just 10]) @?= [0, 10]         , testCase "Remembers the last of several Just values" $ runIdentity (embed (lastS 0) [Nothing, Nothing, Just 1, Nothing, Just 2, Just 10]) @?= [0, 0, 1, 1, 2, 10]         ]+    , testGroup+        "initial"+        [ testCase "Remembers first value" $ runIdentity (embed initial [1, 2, 3]) @?= [1, 1, 1]+        ]     , Automaton.Except.tests     , Automaton.Filter.tests     , Automaton.Trans.Accum.tests
test/Stream.hs view
@@ -5,7 +5,9 @@ import Control.Monad.Identity (Identity (..))  -- transformers-import Control.Monad.Trans.Except (throwE)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Except (ExceptT (..), throwE)+import Control.Monad.Trans.Reader (ReaderT (..), ask) import Control.Monad.Trans.Writer.Lazy (runWriter, tell)  -- selective@@ -18,15 +20,15 @@ import Test.Tasty.HUnit (testCase, (@?=))  -- automaton-import Automaton-import Data.Stream (StreamT, constM, handleExceptT, handleWriterT, mmap, snapshot, streamToList, unfold, unfold_)+import Data.Stream (StreamT (..), constM, foreverExceptE, handleExceptT, handleWriterT, mmap, snapshot, streamToList, unfold, unfold_)+import Data.Stream.Except qualified as StreamExcept+import Data.Stream.Optimized qualified as StreamOptimized import Data.Stream.Result  tests =   testGroup     "Stream"-    [ Automaton.tests-    , testGroup+    [ testGroup         "Selective"         [ testCase "Selects second stream based on first stream" $             let automaton1 = unfold 0 (\n -> Result (n + 1) (if even n then Right n else Left n))@@ -58,7 +60,44 @@                  in take 3 (fmap fst $ runIdentity $ streamToList $ handleWriterT stream) @?= [[1], [1, 2], [1, 2, 3]]             ]         ]+    , testGroup+        "foreverExceptE"+        [ testCase "Uses initial ReaderT value, stores exceptions, and resets state" $+            take 5 (runIdentity $ streamToList $ foreverExceptE 0 throwsNext)+              @?= [0, 1, 2, 3, 4]+        , testCase "StreamExcept.foreverE behaves the same for stateful streams" $+            let streamExcept = StreamExcept.CoalgebraicExcept $ StreamOptimized.Stateful throwsNext+             in take 5 (runIdentity $ streamToList $ StreamOptimized.toStreamT $ StreamExcept.foreverE 0 streamExcept)+                  @?= [0, 1, 2, 3, 4]+        , testCase "StreamExcept.foreverE handles stateless streams" $+            let stateless =+                  StreamExcept.CoalgebraicExcept $+                    StreamOptimized.Stateless $ do+                      ExceptT $ ReaderT $ \e -> if e > 10 then pure $ Right e else pure $ Left $ e + 1+             in take 4 (runIdentity $ streamToList $ StreamOptimized.toStreamT $ StreamExcept.foreverE 0 stateless)+                  @?= [11, 11, 11, 11]+        , testCase "StreamExcept.foreverE handles RecursiveExcept via bind" $+            let recursive = StreamExcept.RecursiveExcept $+                  StreamOptimized.toRecursive $+                    StreamOptimized.Stateful $+                      StreamT 0 $ \n -> ExceptT $ ReaderT $ \lastE ->+                        if n < lastE+                          then pure $ Right $ Result (n + 1) n+                          else pure $ Left $ lastE + 1+             in take 10 (runIdentity $ streamToList $ StreamOptimized.toStreamT $ StreamExcept.foreverE 0 recursive)+                  @?= [0, 0, 1, 0, 1, 2, 0, 1, 2, 3]+        ]     ]  nats :: (Applicative m) => StreamT m Int nats = unfold_ 0 (+ 1)++-- | Emit the current ReaderT value when 'shouldThrow' is False; otherwise throw its successor.+throwsNext :: StreamT (ExceptT Int (ReaderT Int Identity)) Int+throwsNext = StreamT False $ \shouldThrow ->+  do+    exceptionValue <- lift ask+    if shouldThrow+      then throwE (exceptionValue + 1)+      else+        pure $ Result True exceptionValue