Skip to content

Instantly share code, notes, and snippets.

@therewillbecode
Created November 20, 2021 14:53
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save therewillbecode/22ad270985e3970f4d08444afdad704f to your computer and use it in GitHub Desktop.
machines
module Main where
import Lib
import Data.Char
import Data.Machine
-- newtype CurrPlayerToAct = CurrPlayerToAct String deriving (Eq, Show, Ord)
-- need two players who in Acted state to progress game stage
data Stage = One | Two deriving (Show, Eq, Ord)
data BettingStatus
= BettingDone
| BettingNotDone
deriving (Eq, Show, Ord)
newHand :: Mealy BettingStatus Stage
newHand = Mealy toOne
toOne :: BettingStatus -> (Stage, Mealy BettingStatus Stage)
toOne BettingDone = (One, Mealy toTwo)
toOne BettingNotDone = (One, Mealy toOne)
toTwo :: BettingStatus -> (Stage, Mealy BettingStatus Stage)
toTwo BettingDone = (Two, Mealy toOne)
toTwo BettingNotDone = (One, Mealy toTwo)
stageMachine :: Monad m => MachineT m (Is BettingStatus) Stage
stageMachine = auto newHand
--m2m :: Monad m => MachineT m k Stage
--m2m = source [BettingDone, BettingDone, BettingDone] ~> stageMachine
data Action = Activate | Deactivate | Act deriving (Show, Eq, Ord)
data HasActed = ActedThisTurn | NotActedThisTurn deriving (Show, Eq, Ord)
data PlayerStatus = Active HasActed | Inactive deriving (Show, Eq, Ord)
data Player = Player String PlayerStatus deriving (Show, Eq, Ord)
-- newtype Mealy a b
-- Constructors
-- Mealy runMealy :: a -> (b, Mealy a b)
-- unfoldMealy :: (s -> a -> (b, s)) -> s -> Mealy a b
initPlayer :: String -> Player
initPlayer n = Player n (Active NotActedThisTurn)
playerMealy :: Player -> Action -> (Either String Action, Player)
playerMealy (Player name Inactive) Activate =
(Right Activate, Player name $ Active NotActedThisTurn)
playerMealy (Player name (Active _)) Activate =
(Left "couldnt activate as already active", Player name $ Active NotActedThisTurn)
playerMealy (Player name (Active _)) Deactivate =
(Right Deactivate, Player name Inactive)
playerMealy (Player name Inactive) Deactivate =
(Left "couldnt deactivate as already inactive", Player name Inactive)
playerMealy (Player name Inactive) Act =
(Left "couldnt act since inactive", Player name Inactive)
playerMealy (Player name (Active ActedThisTurn)) Act =
(Left "already acted this turn", Player name Inactive)
playerMealy (Player name (Active _)) Act =
(Right Act, Player name $ Active ActedThisTurn)
playerMealy' :: String -> Mealy Action (Either String Action)
playerMealy' name = unfoldMealy playerMealy $ initPlayer name
playerMachine :: Monad m => String -> MachineT m (Is Action) (Either String Action)
playerMachine = auto . playerMealy'
runPlayerMachine :: Monad m => String -> MachineT m (Is Action) (Either String Action)
runPlayerMachine name = source [Activate] ~> playerMachine name
main :: IO ()
main = print $ run $ runPlayerMachine "player1"
-- Initially I want two players to be activated and then both Act once each per game stage
-- to progress game to the game stage.
-- Then the next step could be to have two kinds of machines for Players InactivePlayers and ActivePlayers.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment