{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, GADTs#-} module Language.Nomyx.Engine.Test where import Language.Nomyx.Expression import Language.Nomyx.Variables import Language.Nomyx.Rules import Language.Nomyx.Events import Language.Nomyx.Outputs import Language.Nomyx.Inputs import Language.Nomyx.Vote import Language.Nomyx.Engine.Evaluation import Language.Nomyx.Engine.Game import Language.Nomyx.Engine.Utils import Control.Monad.State import Data.Typeable import Data.Lens date1 = parse822Time "Tue, 02 Sep 1997 09:00:00 -0400" date2 = parse822Time "Tue, 02 Sep 1997 10:00:00 -0400" date3 = parse822Time "Tue, 02 Sep 1997 11:00:00 -0400" testGame = Game { _gameName = "test", _gameDesc = GameDesc "test" "test", _rules = [], _players = [PlayerInfo 1 "coco"], _variables = [], _events = [], _outputs = [], _victory = [], _logs = [], _currentTime = date1} testRule = Rule { _rNumber = 0, _rName = "test", _rDescription = "test", _rProposedBy = 0, _rRuleCode = "", _rRuleFunc = return Void, _rStatus = Pending, _rAssessedBy = Nothing} evalRuleFunc f = evalState (runEvalError 0 $ evalExp f 0) testGame execRuleFuncEvent f e d = execState (runEvalError 0 $ evalExp f 0 >> (triggerEvent_ e d)) testGame execRuleFuncGame f g = execState (runEvalError 0 $ void $ evalExp f 0) g execRuleFuncEventGame f e d g = execState (runEvalError 0 $ evalExp f 0 >> (triggerEvent_ e d)) g execRuleFunc f = execRuleFuncGame f testGame addActivateRule :: RuleFunc -> RuleNumber -> Evaluate () addActivateRule rf rn = do let rule = testRule {_rName = "testRule", _rRuleFunc = rf, _rNumber = rn, _rStatus = Pending} evAddRule rule evActivateRule (_rNumber rule) 0 return () tests = [("test var 1", testVarEx1), ("test var 2", testVarEx2), ("test var 3", testVarEx3), ("test var 4", testVarEx4), ("test var 5", testVarEx5), ("test single input", testSingleInputEx), ("test multiple input", testMultipleInputsEx), ("test input string", testInputStringEx), ("test send messsage", testSendMessageEx), ("test send message 2", testSendMessageEx2), ("test user input write", testUserInputWriteEx), ("test activate rule", testActivateRuleEx), ("test auto activate", testAutoActivateEx), --("test meta rules vote", testApplicationMetaRuleEx), ("test time event", testTimeEventEx), ("test time event 2", testTimeEventEx2), ("test delete rule", testDeleteRuleEx1), ("test assess on vote complete 1", testVoteAssessOnVoteComplete1), ("test assess on vote complete 2", testVoteAssessOnVoteComplete2), ("test assess on every vote 1", testVoteAssessOnEveryVote1), ("test assess on every vote 2", testVoteAssessOnEveryVote2), ("test assess on every vote 3", testVoteAssessOnEveryVote3), ("test assess on every vote 4", testVoteAssessOnEveryVote4), ("test majority with", testVoteMajorityWith), ("test number positive votes", testVoteNumberPositiveVotes), ("test vote with quorum 1", testVoteWithQuorum1), ("test vote with quorum 2", testVoteWithQuorum2), ("test assess on time limit 1", testVoteAssessOnTimeLimit1), ("test assess on time limit 2", testVoteAssessOnTimeLimit2), ("test assess on time limit 3", testVoteAssessOnTimeLimit3), ("test assess on time limit 4", testVoteAssessOnTimeLimit4), ("test assess on time limit 5", testVoteAssessOnTimeLimit5)] allTests = and $ map snd tests --Test variable creation testVar1 :: RuleFunc testVar1 = voidRule $ do NewVar "toto" (1::Integer) return () testVarEx1 = (variables ^$ execRuleFunc testVar1) == [(Var 0 "toto" (1::Integer))] --Test variable deleting testVar2 :: RuleFunc testVar2 = voidRule $ do var <- newVar_ "toto" (1::Int) delVar var return () testVarEx2 = _variables (execRuleFunc testVar2) == [] --Test variable reading testVar3 :: RuleFunc testVar3 = voidRule $ do var <- newVar_ "toto" (1::Int) a <- readVar var case a of Just (1::Int) -> newOutput_ (return "ok") (Just 1) _ -> newOutput_ (return "nok") (Just 1) testVarEx3 = isOutput "ok" (execRuleFunc testVar3) --Test variable writing testVar4 :: RuleFunc testVar4 = voidRule $ do var <- newVar_ "toto" (1::Int) writeVar var (2::Int) a <- readVar var case a of Just (2::Int) -> newOutput_ (return "ok") (Just 1) _ -> newOutput_ (return "nok") (Just 1) testVarEx4 = isOutput "ok" (execRuleFunc testVar4) --Test variable writing testVar5 :: RuleFunc testVar5 = voidRule $ do var <- newVar_ "toto" ([]::[Int]) writeVar var ([1]::[Int]) a <- readVar var case a of Just (a::[Int]) -> do writeVar var (2:a) return () Nothing -> newOutput_ (return "nok") (Just 1) testVarEx5 = _variables (execRuleFunc testVar5) == [(Var 0 "toto" ([2,1]::[Int]))] data Choice = Holland | Sarkozy deriving (Enum, Typeable, Show, Eq, Bounded) -- Test input testSingleInput :: RuleFunc testSingleInput = voidRule $ do onInputRadioEnum_ "Vote for Holland or Sarkozy" Holland h 1 where h a = newOutput_ (return $ "voted for " ++ (show a)) (Just 1) testSingleInputEx = isOutput "voted for Holland" g where g = execRuleFuncEvent testSingleInput (inputRadioEnum 1 "Vote for Holland or Sarkozy" Holland) (InputData (RadioData Holland)) testMultipleInputs :: RuleFunc testMultipleInputs = voidRule $ do onInputCheckbox_ "Vote for Holland and Sarkozy" [(Holland, "Holland"), (Sarkozy, "Sarkozy")] h 1 where h a = newOutput_ (return $ "voted for " ++ (show a)) (Just 1) testMultipleInputsEx = isOutput "voted for [Holland,Sarkozy]" g where g = execRuleFuncEvent testMultipleInputs (inputCheckbox 1 "Vote for Holland and Sarkozy" [(Holland, "Holland"), (Sarkozy, "Sarkozy")]) (InputData (CheckboxData [Holland, Sarkozy])) testInputString :: RuleFunc testInputString = voidRule $ do onInputText_ "Enter a number:" h 1 where h a = newOutput_ (return $ "You entered: " ++ a) (Just 1) testInputStringEx = isOutput "You entered: 1" g where g = execRuleFuncEvent testInputString (inputText 1 "Enter a number:") (InputData (TextData "1")) -- Test message testSendMessage :: RuleFunc testSendMessage = voidRule $ do let msg = Message "msg" :: Event(Message String) onEvent_ msg f sendMessage msg "toto" where f (MessageData a :: EventData(Message String)) = newOutput_ (return a) (Just 1) testSendMessageEx = isOutput "toto" (execRuleFunc testSendMessage) testSendMessage2 :: RuleFunc testSendMessage2 = voidRule $ do onEvent_ (Message "msg":: Event(Message ())) $ const $ newOutput_ (return "Received") (Just 1) sendMessage_ (Message "msg") testSendMessageEx2 = isOutput "Received" (execRuleFunc testSendMessage2) data Choice2 = Me | You deriving (Enum, Typeable, Show, Eq, Bounded) -- Test user input + variable read/write testUserInputWrite :: RuleFunc testUserInputWrite = voidRule $ do newVar_ "vote" (Nothing::Maybe Choice2) onEvent_ (Message "voted" :: Event (Message ())) h2 onEvent_ (InputEv (Input 1 "Vote for" (Radio [(Me, "Me"), (You, "You")]))) h1 where h1 (InputData (RadioData a) :: EventData (Input Choice2)) = do writeVar (V "vote") (Just a) SendMessage (Message "voted") () h1 _ = undefined h2 (MessageData _) = do a <- readVar (V "vote") case a of Just (Just Me) -> newOutput_ (return "voted Me") (Just 1) _ -> newOutput_ (return "problem") (Just 1) h2 _ = undefined testUserInputWriteEx = isOutput "voted Me" g where g = execRuleFuncEvent testUserInputWrite (InputEv (Input 1 "Vote for" (Radio [(Me, "Me"), (You, "You")]))) (InputData (RadioData Me)) -- Test rule activation testActivateRule :: RuleFunc testActivateRule = voidRule $ do a <- GetRules if (_rStatus (head a) == Pending) then do ActivateRule $ _rNumber (head a) return () else return () testActivateRuleEx = _rStatus (head $ _rules (execRuleFuncGame testActivateRule testGame {_rules=[testRule]})) == Active testAutoActivateEx = _rStatus (head $ _rules (execRuleFuncEventGame autoActivate (RuleEv Proposed) (RuleData testRule) (testGame {_rules=[testRule]}))) == Active --Time tests testTimeEvent :: RuleFunc testTimeEvent = voidRule $ do onEvent_ (Time date1) f where f _ = outputAll' $ show date1 testTimeEventEx = isOutput (show date1) g where g = execRuleFuncEvent testTimeEvent (Time date1) (TimeData date1) testTimeEvent2 :: Nomex () testTimeEvent2 = schedule' [date1, date2] (outputAll' . show) testTimeEventEx2 = isOutput (show date1) g && isOutput (show date2) g where g = flip execState testGame (runEvalError 0 $ evalExp testTimeEvent2 0 >> void gameEvs) gameEvs = do evTriggerTime date1 evTriggerTime date2 -- Test deletes testDeleteRule :: RuleFunc testDeleteRule = voidRule $ do newVar_ "toto" (1::Int) onMessage (Message "msg":: Event(Message ())) (const $ return ()) newOutput_ (return "toto") (Just 1) testDeleteGame :: Game testDeleteGame = flip execState testGame {_players = []} $ runEvalError 0 $ do addActivateRule testDeleteRule 1 addActivateRule (voidRule $ suppressRule 1) 2 testDeleteRuleEx1 = (_rStatus $ head $ drop 1 $ _rules testDeleteGame) == Reject && (_variables testDeleteGame == []) && (_oStatus $ head $ _outputs testDeleteGame) == SDeleted && (_evStatus $ head $ _events testDeleteGame) == SDeleted -- Test votes voteGameActions :: Int -> Int -> Int -> Bool -> Evaluate () -> Game voteGameActions positives negatives total timeEvent actions = flip execState testGame {_players = []} $ runEvalError 0 $ do mapM_ (\x -> addPlayer (PlayerInfo x $ "coco " ++ (show x))) [1..total] actions evProposeRule testRule evs <- getChoiceEvents let pos = take positives evs let neg = take negatives $ drop positives evs mapM_ (\x -> triggerInput x (URadioData $ fromEnum For)) pos mapM_ (\x -> triggerInput x (URadioData $ fromEnum Against)) neg when timeEvent $ void $ evTriggerTime date2 voteGame' :: Int -> Int -> Int -> Bool -> RuleFunc -> Game voteGame' positives negatives notVoted timeEvent rf = voteGameActions positives negatives notVoted timeEvent $ addActivateRule rf 1 voteGame :: Int -> Int -> Int -> RuleFunc -> Game voteGame positives negatives notVoted rf = voteGame' positives negatives notVoted True rf voteGameTimed :: Int -> Int -> Int -> RuleFunc -> Game voteGameTimed positives negatives notVoted rf = voteGame' positives negatives notVoted True rf -- Test application meta rule --unanimityRule = testRule {_rName = "unanimityRule", _rRuleFunc = return $ Meta $ voteWith unanimity $ assessWhenEverybodyVoted, _rNumber = 1, _rStatus = Active} --applicationMetaRuleRule = testRule {_rName = "onRuleProposedUseMetaRules", _rRuleFunc = onRuleProposed checkWithMetarules, _rNumber = 2, _rStatus = Active} --testApplicationMetaRuleVote :: Game --testApplicationMetaRuleVote = voteGameActions 2 0 2 False $ do -- evAddRule unanimityRule -- evActivateRule (_rNumber unanimityRule) 0 -- evAddRule applicationMetaRuleRule -- evActivateRule (_rNumber applicationMetaRuleRule) 0 -- return () --testApplicationMetaRuleEx = (_rStatus $ head $ _rules testApplicationMetaRuleVote) == Active -- vote rules |Expected result |pos |neg |total |description of voting system testVoteAssessOnVoteComplete1 = testVoteRule Active $ voteGame 10 0 10 $ onRuleProposed $ voteWith_ majority $ assessWhenEverybodyVoted testVoteAssessOnVoteComplete2 = testVoteRule Pending $ voteGame 9 0 10 $ onRuleProposed $ voteWith_ majority $ assessWhenEverybodyVoted testVoteAssessOnEveryVote1 = testVoteRule Active $ voteGame 10 0 10 $ onRuleProposed $ voteWith_ unanimity $ assessOnEveryVote testVoteAssessOnEveryVote2 = testVoteRule Active $ voteGame 6 0 10 $ onRuleProposed $ voteWith_ majority $ assessOnEveryVote testVoteAssessOnEveryVote3 = testVoteRule Pending $ voteGame 5 0 10 $ onRuleProposed $ voteWith_ majority $ assessOnEveryVote testVoteAssessOnEveryVote4 = testVoteRule Reject $ voteGame 0 5 10 $ onRuleProposed $ voteWith_ majority $ assessOnEveryVote testVoteMajorityWith = testVoteRule Active $ voteGame 6 0 10 $ onRuleProposed $ voteWith_ (majorityWith 50) $ assessOnEveryVote testVoteNumberPositiveVotes = testVoteRule Active $ voteGame 3 7 10 $ onRuleProposed $ voteWith_ (numberVotes 3) $ assessOnEveryVote testVoteWithQuorum1 = testVoteRule Active $ voteGame 7 3 10 $ onRuleProposed $ voteWith_ (majority `withQuorum` 7) $ assessOnEveryVote testVoteWithQuorum2 = testVoteRule Pending $ voteGame 6 0 10 $ onRuleProposed $ voteWith_ (majority `withQuorum` 7) $ assessOnEveryVote testVoteAssessOnTimeLimit1 = testVoteRule Active $ voteGameTimed 10 0 10 $ onRuleProposed $ voteWith_ unanimity $ assessOnTimeLimit date2 testVoteAssessOnTimeLimit2 = testVoteRule Active $ voteGameTimed 1 0 10 $ onRuleProposed $ voteWith_ unanimity $ assessOnTimeLimit date2 testVoteAssessOnTimeLimit3 = testVoteRule Reject $ voteGameTimed 1 0 10 $ onRuleProposed $ voteWith_ (unanimity `withQuorum` 5) $ assessOnTimeLimit date2 testVoteAssessOnTimeLimit4 = testVoteRule Reject $ voteGameTimed 0 0 10 $ onRuleProposed $ voteWith_ (unanimity `withQuorum` 1) $ assessOnTimeLimit date2 testVoteAssessOnTimeLimit5 = testVoteRule Pending $ voteGameTimed 10 0 10 $ onRuleProposed $ voteWith_ unanimity $ assessOnTimeLimit date3 testVoteRule s g = (_rStatus $ head $ _rules g) == s isOutput :: String -> Game -> Bool isOutput s g = any (\(Output _ _ _ mys SActive) -> mys == s) (_outputs g)