module Language.Nomyx.Engine.Game where
import Prelude hiding (log)
import Data.List
import Language.Nomyx.Expression
import Language.Nomyx.Engine.Utils
import Data.Lens.Template
import Data.Time
import Data.Typeable
import GHC.Show (showList__)
import GHC.Read (readListPrecDefault, readListDefault, Read(..), lexP, parens)
import qualified Text.ParserCombinators.ReadPrec as ReadPrec (prec)
import Text.Read.Lex (Lexeme(..))
import Text.ParserCombinators.ReadPrec (reset)
import Data.Data
type GameName = String
data Game = Game { _gameName :: GameName,
_gameDesc :: GameDesc,
_rules :: [Rule],
_players :: [PlayerInfo],
_variables :: [Var],
_events :: [EventHandler],
_outputs :: [Output],
_victory :: [PlayerNumber],
_logs :: [Log],
_currentTime :: UTCTime
}
deriving (Typeable)
data GameDesc = GameDesc { _desc :: String, _agora :: String} deriving (Eq, Show, Read, Ord)
instance Eq Game where
(Game {_gameName=gn1}) == (Game {_gameName=gn2}) = gn1 == gn2
instance Ord Game where
compare (Game {_gameName=gn1}) (Game {_gameName=gn2}) = compare gn1 gn2
instance Read Game where
readPrec = parens $ ReadPrec.prec 11 $ do
Ident "Game" <- lexP;
Punc "{" <- lexP;
Ident "_gameName" <- lexP;
Punc "=" <- lexP;
name <- reset readPrec;
Punc "," <- lexP;
Ident "_gameDesc" <- lexP;
Punc "=" <- lexP;
desc <- reset readPrec;
Punc "," <- lexP;
Ident "_currentTime" <- lexP;
Punc "=" <- lexP;
time <- reset readPrec;
Punc "}" <- lexP;
return $ Game name desc [] [] [] [] [] [] [] time
readList = readListDefault
readListPrec = readListPrecDefault
instance Show Game where
showsPrec p(Game name desc _ _ _ _ _ _ _ time) = showParen (p >= 11) $
showString "Game {" .
showString "_gameName = " .
showsPrec 0 name .
showString ", " .
showString "_gameDesc = " .
showsPrec 0 desc .
showString ", " .
showString "_currentTime = " .
showsPrec 0 time .
showString "}"
showList = showList__ (showsPrec 0)
displayGame :: Game -> String
displayGame (Game { _gameName, _rules, _players, _variables, _events, _outputs, _victory, _currentTime}) =
"Game Name = " ++ (show _gameName) ++ "\n Rules = " ++ (concat $ intersperse "\n " $ map show _rules) ++ "\n Players = " ++ (show _players) ++ "\n Variables = " ++
(show _variables) ++ "\n Events = " ++ (show _events) ++ "\n Outputs = " ++ (show _outputs) ++ "\n Victory = " ++ (show _victory) ++ "\n currentTime = " ++ (show _currentTime) ++ "\n"
emptyGame name desc date = Game {
_gameName = name,
_gameDesc = desc,
_rules = [],
_players = [],
_variables = [],
_events = [],
_outputs = [],
_victory = [],
_logs = [],
_currentTime = date}
data Var = forall a . (Typeable a, Show a, Eq a) =>
Var { _vRuleNumber :: RuleNumber,
_vName :: String,
vData :: a}
instance Show Var where
show (Var a b c) = "Rule number = " ++ (show a) ++ ", Name = " ++ (show b) ++ ", Value = " ++ (show c) ++ "\n"
instance Eq Var where
Var a b c == Var d e f = (a,b,c) === (d,e,f)
data EventHandler where
EH :: (Typeable e, Show e, Eq e) =>
{_eventNumber :: EventNumber,
_ruleNumber :: RuleNumber,
event :: Event e,
handler :: (EventNumber, EventData e) -> Nomex (),
_evStatus :: Status} -> EventHandler
data Status = SActive | SDeleted deriving (Eq, Show)
instance Show EventHandler where
show (EH en rn e _ s) = (show en) ++ " " ++ (show rn) ++ " (" ++ (show e) ++"), status = " ++ (show s)
instance Eq EventHandler where
(EH {_eventNumber=e1}) == (EH {_eventNumber=e2}) = e1 == e2
instance Ord EventHandler where
(EH {_eventNumber=e1}) <= (EH {_eventNumber=e2}) = e1 <= e2
data Output = Output { _outputNumber :: OutputNumber,
_oRuleNumber :: RuleNumber,
_oPlayerNumber :: (Maybe PlayerNumber),
_output :: String,
_oStatus :: Status}
deriving (Eq, Show)
data Log = Log { _lPlayerNumber :: Maybe PlayerNumber,
_lTime :: UTCTime,
_lMsg :: String}
deriving (Show)
data SubmitRule = SubmitRule RuleName RuleDesc RuleCode deriving (Show, Read, Eq, Ord, Data, Typeable)
$( makeLenses [''Game, ''GameDesc, ''EventHandler, ''Var, ''Output] )