machines

machines.hs

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.