mirror of
https://github.com/marcosh/crem.git
synced 2024-10-26 11:52:20 +03:00
derive RenderableVertices instances via AllVertices in the examples
This commit is contained in:
parent
0f943e4a22
commit
900f48423b
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
@ -14,6 +15,7 @@
|
||||
module Crem.Example.LockDoor where
|
||||
|
||||
import Crem.BaseMachine
|
||||
import Crem.Render.RenderableVertices (AllVertices (..), RenderableVertices)
|
||||
import Crem.Topology
|
||||
import "singletons-base" Data.Singletons.Base.TH
|
||||
|
||||
@ -35,6 +37,8 @@ $( singletons
|
||||
|]
|
||||
)
|
||||
|
||||
deriving via AllVertices LockDoorVertex instance RenderableVertices LockDoorVertex
|
||||
|
||||
data LockDoorCommand
|
||||
= LockOpen
|
||||
| LockClose
|
||||
|
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
@ -13,6 +14,7 @@ module Crem.Example.RiskManager.Aggregate where
|
||||
|
||||
import Crem.BaseMachine
|
||||
import Crem.Example.RiskManager.Domain
|
||||
import Crem.Render.RenderableVertices (AllVertices (..), RenderableVertices)
|
||||
import Crem.Topology
|
||||
import "singletons-base" Data.Singletons.Base.TH
|
||||
|
||||
@ -38,6 +40,8 @@ $( singletons
|
||||
|]
|
||||
)
|
||||
|
||||
deriving via AllVertices AggregateVertex instance RenderableVertices AggregateVertex
|
||||
|
||||
data AggregateState (vertex :: AggregateVertex) where
|
||||
NoData :: AggregateState 'NoDataVertex
|
||||
CollectedUserData :: UserData -> AggregateState 'CollectedUserDataVertex
|
||||
|
@ -15,6 +15,7 @@ module Crem.Example.RiskManager.Projection where
|
||||
|
||||
import Crem.BaseMachine
|
||||
import Crem.Example.RiskManager.Domain
|
||||
import Crem.Render.RenderableVertices (AllVertices (..), RenderableVertices)
|
||||
import Crem.Topology
|
||||
import "base" Data.Monoid (Last (..))
|
||||
import "base" GHC.Generics (Generic)
|
||||
@ -60,6 +61,8 @@ $( singletons
|
||||
|]
|
||||
)
|
||||
|
||||
deriving via AllVertices ProjectionVertex instance RenderableVertices ProjectionVertex
|
||||
|
||||
data ProjectionState (vertex :: ProjectionVertex) where
|
||||
SingleProjectionState :: ReceivedData -> ProjectionState 'SingleProjectionVertex
|
||||
|
||||
|
@ -13,6 +13,7 @@
|
||||
module Crem.Example.TheHobbit where
|
||||
|
||||
import Crem.BaseMachine
|
||||
import Crem.Render.RenderableVertices (AllVertices (..), RenderableVertices)
|
||||
import Crem.Topology
|
||||
import "base" Data.Semigroup
|
||||
import "singletons-base" Data.Singletons.Base.TH
|
||||
@ -59,6 +60,8 @@ $( singletons
|
||||
|]
|
||||
)
|
||||
|
||||
deriving via AllVertices HobbitVertex instance RenderableVertices HobbitVertex
|
||||
|
||||
data KeyState
|
||||
= NoKey
|
||||
| DayDawned
|
||||
|
@ -1,4 +1,5 @@
|
||||
> {-# LANGUAGE DataKinds #-}
|
||||
> {-# LANGUAGE DerivingVia #-}
|
||||
> {-# LANGUAGE TemplateHaskell #-}
|
||||
> {-# LANGUAGE TypeFamilies #-}
|
||||
> {-# LANGUAGE UndecidableInstances #-}
|
||||
@ -13,6 +14,7 @@
|
||||
>
|
||||
> import "crem" Crem.BaseMachine
|
||||
> import "crem" Crem.Render.Render
|
||||
> import "crem" Crem.Render.RenderableVertices (AllVertices(..), RenderableVertices)
|
||||
> import "crem" Crem.Render.RenderFlow
|
||||
> import "crem" Crem.StateMachine
|
||||
> import "crem" Crem.Topology
|
||||
@ -48,6 +50,10 @@ Moreover, we want those switches to be usable only once, and therefore we want t
|
||||
|
||||
Notice that we need to wrap this in `singletons` because we will soon need to use this data type as a kind, to store information in the type of our state machines.
|
||||
|
||||
We need also an instance of `RenderableVertices SwitchVertex` to decide which vertices to render for our machine. To obtain that, we use `deriving via` together with the `AllVertices` newtype.
|
||||
|
||||
> deriving via AllVertices SwitchVertex instance RenderableVertices SwitchVertex
|
||||
|
||||
Next we need to define which data every vertex of our topology should contain. To express that we use a generalized algebraid data type indexed with `SwitchVertex`
|
||||
|
||||
> data SwitchState (vertex :: SwitchVertex) where
|
||||
@ -108,6 +114,8 @@ Again, we need to start thinking about the topology of our machine. Since we nee
|
||||
> ]
|
||||
> |]
|
||||
> )
|
||||
>
|
||||
> deriving via AllVertices BothVertex instance RenderableVertices BothVertex
|
||||
|
||||
The topology again constrains the machine with the invariant the we can only turn on switches.
|
||||
|
||||
|
@ -19,6 +19,7 @@ module Crem.Example.Uno where
|
||||
|
||||
import Crem.BaseMachine (InitialState (..))
|
||||
import Crem.Decider (Decider (..), EvolutionResult (..))
|
||||
import Crem.Render.RenderableVertices (AllVertices (..), RenderableVertices)
|
||||
import Crem.Topology
|
||||
import "singletons-base" Data.Singletons.Base.TH
|
||||
import Prelude hiding (id, init, reverse)
|
||||
@ -178,6 +179,8 @@ $( singletons
|
||||
|]
|
||||
)
|
||||
|
||||
deriving via AllVertices UnoVertex instance RenderableVertices UnoVertex
|
||||
|
||||
-- * State
|
||||
|
||||
data StateData = StateData
|
||||
|
Loading…
Reference in New Issue
Block a user