Safe Haskell | None |
---|---|
Language | Haskell2010 |
Shpadoinkle Continuation is the abstract structure of Shpadoinkle's event handling system. It allows for asynchronous effects in event handlers by providing a model for atomic updates of application state.
Synopsis
- data Continuation m a
- = Continuation (a -> a, a -> m (Continuation m a))
- | Rollback (Continuation m a)
- | Pure (a -> a)
- runContinuation :: Monad m => Continuation m a -> a -> m (a -> a)
- done :: Continuation m a
- pur :: (a -> a) -> Continuation m a
- impur :: Monad m => m (a -> a) -> Continuation m a
- kleisli :: (a -> m (Continuation m a)) -> Continuation m a
- causes :: Monad m => m () -> Continuation m a
- contIso :: Functor m => (a -> b) -> (b -> a) -> Continuation m a -> Continuation m b
- class Continuous f where
- mapC :: Functor m => Functor n => (Continuation m a -> Continuation n b) -> f m a -> f n b
- hoist :: Functor m => (forall b. m b -> n b) -> Continuation m a -> Continuation n a
- voidC' :: Monad m => Continuation m () -> Continuation m a
- voidC :: Monad m => Continuous f => f m () -> f m a
- forgetC :: Monad m => Monad n => Continuous f => f m a -> f n b
- forgetC' :: Monad m => Continuous f => f m a -> f m b
- liftC' :: Functor m => (a -> b -> b) -> (b -> a) -> Continuation m a -> Continuation m b
- liftCMay' :: Applicative m => (a -> b -> b) -> (b -> Maybe a) -> Continuation m a -> Continuation m b
- liftC :: Functor m => Continuous f => (a -> b -> b) -> (b -> a) -> f m a -> f m b
- liftCMay :: Applicative m => Continuous f => (a -> b -> b) -> (b -> Maybe a) -> f m a -> f m b
- leftC' :: Functor m => Continuation m a -> Continuation m (a, b)
- leftC :: Functor m => Continuous f => f m a -> f m (a, b)
- rightC' :: Functor m => Continuation m b -> Continuation m (a, b)
- rightC :: Functor m => Continuous f => f m b -> f m (a, b)
- eitherC' :: Monad m => Continuation m a -> Continuation m b -> Continuation m (Either a b)
- eitherC :: Monad m => Continuous f => (a -> f m a) -> (b -> f m b) -> Either a b -> f m (Either a b)
- maybeC' :: Applicative m => Continuation m a -> Continuation m (Maybe a)
- maybeC :: Applicative m => Continuous f => f m a -> f m (Maybe a)
- comaybe :: (Maybe a -> Maybe a) -> a -> a
- comaybeC' :: Functor m => Continuation m (Maybe a) -> Continuation m a
- comaybeC :: Functor m => Continuous f => f m (Maybe a) -> f m a
- writeUpdate :: MonadUnliftIO m => TVar a -> Continuation m a -> m ()
- shouldUpdate :: MonadUnliftIO m => Eq a => (b -> a -> m b) -> b -> TVar a -> m ()
- constUpdate :: a -> Continuation m a
- newtype ContinuationT model m a = ContinuationT {
- runContinuationT :: m (a, Continuation m model)
- voidRunContinuationT :: Monad m => ContinuationT model m a -> Continuation m model
- kleisliT :: Monad m => (model -> ContinuationT model m a) -> Continuation m model
- commit :: Monad m => Continuation m model -> ContinuationT model m ()
The Continuation Type
data Continuation m a Source #
A Continuation builds up an atomic state update incrementally in a series of stages. For each stage we perform a monadic IO computation and we may get a pure state updating function. When all of the stages have been executed we are left with a composition of the resulting pure state updating functions, and this composition is applied atomically to the state.
Additionally, a Continuation stage may feature a Rollback action which cancels all state updates generated so far but allows for further state updates to be generated based on further monadic IO computation.
The functions generating each stage of the Continuation are called with states which reflect the current state of the app, with all the pure state updating functions generated so far having been applied to it, so that each stage "sees" both the current state (even if it changed since the start of computing the Continuation), and the updates made so far, although those updates are not committed to the real state until the Continuation finishes and they are all done atomically together.
Continuation (a -> a, a -> m (Continuation m a)) | |
Rollback (Continuation m a) | |
Pure (a -> a) |
Instances
Continuous Continuation Source # | |
Defined in Shpadoinkle.Continuation mapC :: (Functor m, Functor n) => (Continuation m a -> Continuation n b) -> Continuation m a -> Continuation n b Source # | |
Applicative m => Functor EndoIso EndoIso (Continuation m :: Type -> Type) Source # |
|
Defined in Shpadoinkle.Continuation map :: EndoIso a b -> EndoIso (Continuation m a) (Continuation m b) # | |
Monad m => Semigroup (Continuation m a) Source # | You can combine multiple Continuations homogeneously using the |
Defined in Shpadoinkle.Continuation (<>) :: Continuation m a -> Continuation m a -> Continuation m a # sconcat :: NonEmpty (Continuation m a) -> Continuation m a # stimes :: Integral b => b -> Continuation m a -> Continuation m a # | |
Monad m => Monoid (Continuation m a) Source # | Since combining Continuations homogeneously is an associative operation,
and this operation has a unit element (done), Continuations are a |
Defined in Shpadoinkle.Continuation mempty :: Continuation m a # mappend :: Continuation m a -> Continuation m a -> Continuation m a # mconcat :: [Continuation m a] -> Continuation m a # |
runContinuation :: Monad m => Continuation m a -> a -> m (a -> a) Source #
runContinuation
takes a Continuation
and a state value and runs the whole Continuation
as if the real state was frozen at the value given to runContinuation
. It performs all the
IO actions in the stages of the Continuation and returns a pure state updating function
which is the composition of all the pure state updating functions generated by the
non-rolled-back stages of the Continuation. If you are trying to update a Continuous
territory, then you should probably be using writeUpdate
instead of runContinuation
,
because writeUpdate
will allow each stage of the Continuation to see any extant updates
made to the territory after the Continuation started running.
done :: Continuation m a Source #
A Continuation which doesn't touch the state and doesn't have any side effects
pur :: (a -> a) -> Continuation m a Source #
A pure state updating function can be turned into a Continuation. This function is here so that users of the Continuation API can do basic things without needing to depend on the internal structure of the type.
impur :: Monad m => m (a -> a) -> Continuation m a Source #
A monadic computation of a pure state updating function can be turned into a Continuation.
kleisli :: (a -> m (Continuation m a)) -> Continuation m a Source #
This turns a Kleisli arrow for computing a Continuation into the Continuation which reads the state, runs the monadic computation specified by the arrow on that state, and runs the resulting Continuation.
causes :: Monad m => m () -> Continuation m a Source #
A monadic computation can be turned into a Continuation which does not touch the state.
contIso :: Functor m => (a -> b) -> (b -> a) -> Continuation m a -> Continuation m b Source #
Transform the type of a Continuation using an isomorphism.
The Class
class Continuous f where Source #
f
is a Functor to Hask from the category where the objects are
Continuation types and the morphisms are functions.
mapC :: Functor m => Functor n => (Continuation m a -> Continuation n b) -> f m a -> f n b Source #
Instances
Continuous Continuation Source # | |
Defined in Shpadoinkle.Continuation mapC :: (Functor m, Functor n) => (Continuation m a -> Continuation n b) -> Continuation m a -> Continuation n b Source # | |
Continuous Prop Source # | Given a lens, you can change the type of a Prop by using the lens to convert the types of the Continuations which it contains if it is a listener. |
Defined in Shpadoinkle.Core mapC :: (Functor m, Functor n) => (Continuation m a -> Continuation n b) -> Prop m a -> Prop n b Source # | |
Continuous Html Source # | Given a lens, you can change the type of an Html by using the lens to convert the types of the Continuations inside it. |
Defined in Shpadoinkle.Core mapC :: (Functor m, Functor n) => (Continuation m a -> Continuation n b) -> Html m a -> Html n b Source # |
Hoist
hoist :: Functor m => (forall b. m b -> n b) -> Continuation m a -> Continuation n a Source #
Given a natural transformation, change a Continuation's underlying functor.
Forgetting
voidC' :: Monad m => Continuation m () -> Continuation m a Source #
Change a void continuation into any other type of Continuation.
voidC :: Monad m => Continuous f => f m () -> f m a Source #
Change the type of the f-embedded void Continuations into any other type of Continuation.
forgetC :: Monad m => Monad n => Continuous f => f m a -> f n b Source #
Forget about the Continuations.
forgetC' :: Monad m => Continuous f => f m a -> f m b Source #
Forget about the Continuations without changing the monad. This can be easier on type inference compared to forgetC.
Lifts
liftC' :: Functor m => (a -> b -> b) -> (b -> a) -> Continuation m a -> Continuation m b Source #
Apply a lens inside a Continuation to change the Continuation's type.
liftCMay' :: Applicative m => (a -> b -> b) -> (b -> Maybe a) -> Continuation m a -> Continuation m b Source #
Apply a traversal inside a Continuation to change the Continuation's type.
liftC :: Functor m => Continuous f => (a -> b -> b) -> (b -> a) -> f m a -> f m b Source #
Given a lens, change the value type of f
by applying the lens in the Continuations inside f
.
liftCMay :: Applicative m => Continuous f => (a -> b -> b) -> (b -> Maybe a) -> f m a -> f m b Source #
Given a traversal, change the value of f
by apply the traversal in the Continuations inside f
.
Utilities
Product
leftC' :: Functor m => Continuation m a -> Continuation m (a, b) Source #
leftC :: Functor m => Continuous f => f m a -> f m (a, b) Source #
Change the type of f
by applying the Continuations inside f
to the left coordinate of a tuple.
rightC' :: Functor m => Continuation m b -> Continuation m (a, b) Source #
Change the type of a Continuation by applying it to the right coordinate of a tuple.
rightC :: Functor m => Continuous f => f m b -> f m (a, b) Source #
Change the value type of f
by applying the Continuations inside f
to the right coordinate of a tuple.
Coproduct
eitherC' :: Monad m => Continuation m a -> Continuation m b -> Continuation m (Either a b) Source #
Combine Continuations heterogeneously into coproduct Continuations. The first value the Continuation sees determines which of the two input Continuation branches it follows. If the coproduct Continuation sees the state change to a different Either-branch, then it cancels itself. If the state is in a different Either-branch when the Continuation completes than it was when the Continuation started, then the coproduct Continuation will have no effect on the state.
eitherC :: Monad m => Continuous f => (a -> f m a) -> (b -> f m b) -> Either a b -> f m (Either a b) Source #
Create a structure containing coproduct Continuations using two case alternatives which generate structures containing Continuations of the types inside the coproduct. The Continuations in the resulting structure will only have effect on the state while it is in the branch of the coproduct selected by the input value used to create the structure.
Maybe
maybeC' :: Applicative m => Continuation m a -> Continuation m (Maybe a) Source #
maybeC :: Applicative m => Continuous f => f m a -> f m (Maybe a) Source #
Change the value type of f
by transforming the Continuations inside f
to work on Maybe
s using maybeC'.
comaybe :: (Maybe a -> Maybe a) -> a -> a Source #
Turn a Maybe a
updating function into an a
updating function which acts as
the identity function when the input function outputs Nothing
.
comaybeC' :: Functor m => Continuation m (Maybe a) -> Continuation m a Source #
Change the type of a Maybe-valued Continuation into the Maybe-wrapped type.
The resulting Continuation acts like the input Continuation except that
when the input Continuation would replace the current value with Nothing
,
instead the current value is retained.
comaybeC :: Functor m => Continuous f => f m (Maybe a) -> f m a Source #
Transform the Continuations inside f
using comaybeC'.
Updates
writeUpdate :: MonadUnliftIO m => TVar a -> Continuation m a -> m () Source #
Run a Continuation on a state variable. This may update the state. This is a synchronous, non-blocking operation for pure updates, and an asynchronous, non-blocking operation for impure updates.
shouldUpdate :: MonadUnliftIO m => Eq a => (b -> a -> m b) -> b -> TVar a -> m () Source #
Execute a fold by watching a state variable and executing the next step of the fold each time it changes.
constUpdate :: a -> Continuation m a Source #
Create an update to a constant value.
Monad Transformer
newtype ContinuationT model m a Source #
A monad transformer for building up a Continuation in a series of steps in a monadic computation
ContinuationT | |
|
Instances
voidRunContinuationT :: Monad m => ContinuationT model m a -> Continuation m model Source #
This turns a monadic computation to build up a Continuation into the Continuation which it represents. The actions inside the monadic computation will be run when the Continuation is run. The return value of the monadic computation will be discarded.
kleisliT :: Monad m => (model -> ContinuationT model m a) -> Continuation m model Source #
This turns a function for building a Continuation in a monadic computation which is parameterized by the current state of the model into a Continuation which reads the current state of the model, runs the resulting monadic computation, and runs the Continuation resulting from that computation.
commit :: Monad m => Continuation m model -> ContinuationT model m () Source #
This adds the given Continuation to the Continuation being built up in the monadic context where this function is invoked.