Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- newtype Automaton m a b = Automaton {
- getAutomaton :: OptimizedStreamT (ReaderT a m) b
- unfold :: Applicative m => s -> (a -> s -> Result s b) -> Automaton m a b
- unfoldM :: s -> (a -> s -> m (Result s b)) -> Automaton m a b
- unfold_ :: Applicative m => s -> (a -> s -> s) -> Automaton m a s
- arrM :: Functor m => (a -> m b) -> Automaton m a b
- constM :: Functor m => m b -> Automaton m a b
- hoistS :: Monad m => (forall x. m x -> n x) -> Automaton m a b -> Automaton n a b
- liftS :: (MonadTrans t, Monad m, Functor (t m)) => Automaton m a b -> Automaton (t m) a b
- feedback :: Functor m => c -> Automaton m (a, c) (b, c) -> Automaton m a b
- stepAutomaton :: Functor m => Automaton m a b -> a -> m (Result (Automaton m a b) b)
- reactimate :: Monad m => Automaton m () () -> m void
- embed :: Monad m => Automaton m a b -> [a] -> m [b]
- withAutomaton :: (Functor m1, Functor m2) => (forall s. (a1 -> m1 (Result s b1)) -> a2 -> m2 (Result s b2)) -> Automaton m1 a1 b1 -> Automaton m2 a2 b2
- mapMaybeS :: Monad m => Automaton m a b -> Automaton m (Maybe a) (Maybe b)
- traverseS :: (Monad m, Traversable f) => Automaton m a b -> Automaton m (f a) (f b)
- traverseS_ :: (Monad m, Traversable f) => Automaton m a b -> Automaton m (f a) ()
- parallely :: Applicative m => Automaton m a b -> Automaton m [a] [b]
- handleAutomaton_ :: Monad m => (forall m. Monad m => StreamT m a -> StreamT m b) -> Automaton m i a -> Automaton m i b
- handleAutomaton :: Monad m => (StreamT (ReaderT a m) b -> StreamT (ReaderT c n) d) -> Automaton m a b -> Automaton n c d
- concatS :: Monad m => Automaton m () [b] -> Automaton m () b
- withSideEffect :: Monad m => (a -> m b) -> Automaton m a a
- accumulateWith :: Monad m => (a -> b -> b) -> b -> Automaton m a b
- mappendFrom :: (Monoid w, Monad m) => w -> Automaton m w w
- delay :: Applicative m => a -> Automaton m a a
- prepend :: Monad m => b -> Automaton m a b -> Automaton m a b
- mappendS :: (Monoid w, Monad m) => Automaton m w w
- sumFrom :: (VectorSpace v s, Monad m) => v -> Automaton m v v
- sumS :: (Monad m, VectorSpace v s) => Automaton m v v
- sumN :: (Monad m, Num a) => Automaton m a a
- count :: (Num n, Monad m) => Automaton m a n
- lastS :: Monad m => a -> Automaton m (Maybe a) a
Constructing automata
newtype Automaton m a b Source #
An effectful automaton in initial encoding.
m
: The monad in which the automaton performs side effects.a
: The type of inputs the automaton constantly consumes.b
: The type of outputs the automaton constantly produces.
An effectful automaton with input a
is the same as an effectful stream
with the additional effect of reading an input value a
on every step.
This is why automata are defined here as streams.
The API of automata follows that of streams (StreamT
and OptimizedStreamT
) closely.
The prominent addition in automata is now that they are instances of the Category
, Arrow
, Profunctor
,
and related type classes.
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
sequentially :: Automaton m a c sequentially = automaton1 >>> automaton2
parallely :: Automaton m (a, b) (b, c) parallely = 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.
Through the Arrow
type class, you can use arr
to create an automaton from a pure function,
and more generally use the arrow syntax extension to define automata.
Automaton | |
|
Instances
:: Applicative m | |
=> s | The initial state |
-> (a -> s -> Result s b) | The step function |
-> Automaton m a b |
Create an Automaton
from a state and a pure step function.
Create an Automaton
from a state and an effectful step function.
:: Applicative m | |
=> s | The initial state |
-> (a -> s -> s) | The step function |
-> Automaton m a s |
Like unfold
, but output the current state.
arrM :: Functor m => (a -> m b) -> Automaton m a b Source #
Consume an input and produce output effectfully, without keeping internal state
constM :: Functor m => m b -> Automaton m a b Source #
Produce output effectfully, without keeping internal state
hoistS :: Monad m => (forall x. m x -> n x) -> Automaton m a b -> Automaton n a b Source #
Apply an arbitrary monad morphism to an automaton.
liftS :: (MonadTrans t, Monad m, Functor (t m)) => Automaton m a b -> Automaton (t m) a b Source #
Lift the monad of an automaton to a transformer.
:: Functor m | |
=> c | The additional internal state |
-> Automaton m (a, c) (b, c) | The original automaton |
-> Automaton m a b |
Extend the internal state and feed back part of the output to the next input.
This is one of the fundamental ways to incorporate recursive dataflow in automata. Given an automaton which consumes an additional input and produces an additional output, the state of the automaton is extended by a further value. This value is used as the additional input, and the resulting additional output is stored in the internal state for the next step.
Running automata
stepAutomaton :: Functor m => Automaton m a b -> a -> m (Result (Automaton m a b) b) Source #
Run one step of an automaton.
This consumes an input value, performs a side effect, and returns an updated automaton together with an output value.
reactimate :: Monad m => Automaton m () () -> m void Source #
Run an automaton with trivial input and output indefinitely.
If the input and output of an automaton does not contain information,
all of its meaning is in its effects.
This function runs the automaton indefinitely.
Since it will never return with a value, this function also has no output (its output is void).
The only way it can return is if m
includes some effect of termination,
e.g. Maybe
or Either
could terminate with a Nothing
or Left
value,
or IO
can raise an exception.
Run an automaton with given input, for a given number of steps.
Especially for tests and batch processing, it is useful to step an automaton with given input.
Modifying automata
withAutomaton :: (Functor m1, Functor m2) => (forall s. (a1 -> m1 (Result s b1)) -> a2 -> m2 (Result s b2)) -> Automaton m1 a1 b1 -> Automaton m2 a2 b2 Source #
Change the output type and effect of an automaton without changing its state type.
mapMaybeS :: Monad m => Automaton m a b -> Automaton m (Maybe a) (Maybe b) Source #
Only step the automaton if the input is Just
.
traverseS :: (Monad m, Traversable f) => Automaton m a b -> Automaton m (f a) (f b) Source #
Use an Automaton
with a variable amount of input.
traverseS_ :: (Monad m, Traversable f) => Automaton m a b -> Automaton m (f a) () Source #
Like traverseS
, discarding the output.
parallely :: Applicative m => Automaton m a b -> Automaton m [a] [b] Source #
Launch arbitrarily many copies of the automaton in parallel.
- 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.
Caution: Uses memory of the order of the largest list that was ever input during runtime.
handleAutomaton_ :: Monad m => (forall m. Monad m => StreamT m a -> StreamT m b) -> Automaton m i a -> Automaton m i b Source #
Given a transformation of streams, apply it to an automaton, without changing the input.
handleAutomaton :: Monad m => (StreamT (ReaderT a m) b -> StreamT (ReaderT c n) d) -> Automaton m a b -> Automaton n c d Source #
Given a transformation of streams, apply it to an automaton. The input can be accessed through the ReaderT
effect.
concatS :: Monad m => Automaton m () [b] -> Automaton m () b Source #
Buffer the output of an automaton. See concatS
.
Examples
:: Monad m | |
=> (a -> m b) | For every value passing through the automaton, this function is called and the resulting side effect performed. |
-> Automaton m a a |
Pass through a value unchanged, and perform a side effect depending on it
Accumulate the input, output the accumulator.
mappendFrom :: (Monoid w, Monad m) => w -> Automaton m w w Source #
Like accumulateWith
, with mappend
as the accumulation function.
:: Applicative m | |
=> a | The value to output on the first step |
-> Automaton m a a |
Delay the input by one step.
prepend :: Monad m => b -> Automaton m a b -> Automaton m a b Source #
Delay an automaton by one step by prepending one value to the output.
On the first step, the given initial output is returned. On all subsequent steps, the automaton is stepped with the previous input.