Nomyx-0.0.1: src/Game.hs

{-# LANGUAGE StandaloneDeriving, GADTs, DeriveDataTypeable,
    FlexibleContexts, GeneralizedNewtypeDeriving,
    MultiParamTypeClasses, TemplateHaskell, TypeFamilies,
    TypeOperators, FlexibleInstances, NoMonomorphismRestriction,
    TypeSynonymInstances #-}

-- | This module implements Game management.
-- a game is a set of rules, and results of actions made by players (usually vote results)
-- the module manages the effects of rules over each others.
module Game (initialGame, activeRules, execWithGame, pendingRules, rejectedRules) where

import Language.Nomyx.Rule
import Control.Monad.State
import Data.List
import Language.Nomyx.Expression
import Language.Nomyx.Evaluation
import Examples
import Data.Time.Clock as T


-- | the initial rule set for a game.
rApplicationMetaRule = Rule  {
    rNumber       = 1,
    rName         = "Evaluate rule using meta-rules",
    rDescription  = "a proposed rule will be activated if all active metarules return true",
    rProposedBy   = 0,
    rRuleCode     = "applicationMetaRule",
    rRuleFunc     = applicationMetaRule,
    rStatus       = Active,
    rAssessedBy   = Nothing}

rVoteUnanimity = Rule  {
    rNumber       = 2,
    rName         = "Vote Unanimity",
    rDescription  = "meta-rule: return true if all players vote positively for a rule",
    rProposedBy   = 0,
    rRuleCode     = "vote unanimity",
    rRuleFunc     = vote unanimity,
    rStatus       = Active,
    rAssessedBy   = Nothing}

rVictory5Rules = Rule  {
    rNumber       = 3,
    rName         = "Victory 5 accepted rules",
    rDescription  = "Victory is achieved if you have 5 active rules",
    rProposedBy   = 0,
    rRuleCode     = "victoryXRules 5",
    rRuleFunc     = victoryXRules 5,
    rStatus       = Active,
    rAssessedBy   = Nothing}

emptyGame name date = Game { gameName      = name,
                          rules         = [],
                          players       = [],
                          variables     = [],
                          events        = [],
                          outputs       = [],
                          victory       = [],
                          currentTime   = date}

--initialGame :: Game
initialGame name date = flip execState (emptyGame name date) $ do
    evAddRule rVoteUnanimity
    evActivateRule (rNumber rVoteUnanimity) 0
    evAddRule rApplicationMetaRule
    evActivateRule (rNumber rApplicationMetaRule) 0
    evAddRule rVictory5Rules
    evActivateRule (rNumber rVictory5Rules) 0


-- | An helper function to use the state transformer GameState.
execWithGame :: StateT Game IO () -> Game -> IO Game
execWithGame gs g = do
    t <- T.getCurrentTime
    let g' = g {currentTime = t}
    execStateT gs g'


--accessors

activeRules :: Game -> [Rule]
activeRules = sort . filter (\(Rule {rStatus=rs}) -> rs==Active) . rules

pendingRules :: Game -> [Rule]
pendingRules = sort . filter (\(Rule {rStatus=rs}) -> rs==Pending) . rules

rejectedRules :: Game -> [Rule]
rejectedRules = sort . filter (\(Rule {rStatus=rs}) -> rs==Reject) . rules

instance Eq Game where
   (Game name1 _ _ _ _ _ _ _) == (Game name2 _ _ _ _ _ _ _) = name1 == name2

instance Ord Game where
   compare (Game name1 _ _ _ _ _ _ _) (Game name2 _ _ _ _ _ _ _) = compare name1 name2


instance Ord PlayerInfo where
   h <= g = (playerNumber h) <= (playerNumber g)