derive RenderableVertices instances via AllVertices in the examples

This commit is contained in:
Marco Perone 2023-03-15 12:30:42 +01:00 committed by Marco Perone
parent 0f943e4a22
commit 900f48423b
6 changed files with 25 additions and 0 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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.

View File

@ -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