Safe Haskell | None |
---|---|
Language | GHC2021 |
TypedFsm.Core
Synopsis
- class StateTransMsg ps where
- data Msg ps (st :: ps) (st' :: ps)
- data Operate (a :: Type -> Type) (b :: ps -> Type) (c :: ps) where
- IReturn :: forall ps (b :: ps -> Type) (c :: ps) (a :: Type -> Type). b c -> Operate a b c
- LiftM :: forall {ps} (mode' :: ps) (a :: Type -> Type) (b :: ps -> Type) (c :: ps). Sing mode' -> a (Operate a b mode') -> Operate a b c
- In :: forall ps (a :: Type -> Type) (c :: ps) (b :: ps -> Type). (Msg ps c ~> Operate a b) -> Operate a b c
- getInput :: forall ps (m :: Type -> Type) (from :: ps). Functor m => Operate m (Msg ps from) from
- liftm :: forall ps m (mode :: ps) a. (Functor m, SingI mode) => m a -> Operate m (At a mode) mode
Documentation
class StateTransMsg ps Source #
The state-transition type class
data Operate (a :: Type -> Type) (b :: ps -> Type) (c :: ps) where Source #
Core AST
Essentially all we do is build this AST and then interpret it.
`Operate m ia st` is an instance of IMonad
, and it contains an m
internally
Typed-fsm only contains two core functions: getInput
, liftm
.
We use these two functions to build Operate.
The overall behavior is as follows: constantly reading messages from the outside and converting them into internal monads action.
Constructors
IReturn :: forall ps (b :: ps -> Type) (c :: ps) (a :: Type -> Type). b c -> Operate a b c | |
LiftM :: forall {ps} (mode' :: ps) (a :: Type -> Type) (b :: ps -> Type) (c :: ps). Sing mode' -> a (Operate a b mode') -> Operate a b c | |
In :: forall ps (a :: Type -> Type) (c :: ps) (b :: ps -> Type). (Msg ps c ~> Operate a b) -> Operate a b c |