diff --git a/Nomyx-Language.cabal b/Nomyx-Language.cabal --- a/Nomyx-Language.cabal +++ b/Nomyx-Language.cabal @@ -1,5 +1,5 @@ name: Nomyx-Language -version: 0.2.2 +version: 0.2.3 cabal-version: >=1.6 ---Warning: For using "cabal sdist", this patch is needed in cabal: https://github.com/haskell/cabal/pull/1110 ---To allow sdist to work with exported generated modules (Paths_Nomyx_Language) diff --git a/src/Language/Nomyx/Evaluation.hs b/src/Language/Nomyx/Evaluation.hs --- a/src/Language/Nomyx/Evaluation.hs +++ b/src/Language/Nomyx/Evaluation.hs @@ -65,13 +65,13 @@ events %= ((EH en rn event handler EvActive) : ) return en -evalExp (DelEvent en) rn = evDelEvent en rn +evalExp (DelEvent en) _ = evDelEvent en -evalExp (DelAllEvents e) rn = do +evalExp (DelAllEvents e) _ = do evs <- access events let filtered = filter (\EH {event} -> event === e) evs --traceM ("DelAllEvents: deleting " ++ show filtered) - mapM_ (\e -> evDelEvent e rn) (_eventNumber <$> filtered) + mapM_ (\e -> evDelEvent e) (_eventNumber <$> filtered) evalExp (SendMessage (Message id) myData) _ = triggerEvent_ (Message id) (MessageData myData) @@ -255,8 +255,8 @@ players ~= replaceWith ((== pn) . getL playerNumber) (PlayerInfo pn name) pls return True -evDelEvent :: EventNumber -> RuleNumber -> Evaluate Bool -evDelEvent en _ = do +evDelEvent :: EventNumber -> Evaluate Bool +evDelEvent en = do --traceM ("DelEvent: called with en=" ++ (show en)) evs <- access events case find ((== en) . getL eventNumber) evs of @@ -287,8 +287,10 @@ --delete all events of a rule delEventsRule :: RuleNumber -> Evaluate () -delEventsRule rn = void $ events %= filter ((/= rn) . getL ruleNumber) - +delEventsRule rn = do + evs <- access events + let toDelete = filter ((== rn) . getL ruleNumber) evs + mapM_ (evDelEvent . _eventNumber) toDelete runEvalError :: PlayerNumber -> Evaluate () -> State Game () runEvalError pn egs = do diff --git a/src/Language/Nomyx/Examples.hs b/src/Language/Nomyx/Examples.hs --- a/src/Language/Nomyx/Examples.hs +++ b/src/Language/Nomyx/Examples.hs @@ -20,8 +20,7 @@ import Data.List import Control.Monad import Language.Nomyx.Vote - (elections, referendum, assessOnTimeDelay, assessOnEveryVotes, - withQuorum, majority, voteWith_) + (elections, referendum, assessOnTimeDelay, assessOnEveryVote, withQuorum, majority, voteWith_) import Language.Nomyx.Utils (oneDay) -- | A rule that does nothing @@ -131,13 +130,13 @@ -- the vote is assessed after every vote in case the winner is already known -- the vote will finish anyway after one day voteWithMajority :: RuleFunc -voteWithMajority = onRuleProposed $ voteWith_ (majority `withQuorum` 2) $ assessOnEveryVotes >> assessOnTimeDelay oneDay +voteWithMajority = onRuleProposed $ voteWith_ (majority `withQuorum` 2) $ assessOnEveryVote >> assessOnTimeDelay oneDay -- | Change current system (the rules passed in parameter) to absolute majority (half participants plus one) returnToDemocracy :: [RuleNumber] -> RuleFunc returnToDemocracy rs = voidRule $ do mapM_ suppressRule rs - rNum <- addRuleParams "vote with majority" voteWithMajority "voteWithMajority" "meta-rule: return true if a majority of players vote positively for a new rule" + rNum <- addRuleParams "vote with majority" voteWithMajority "voteWithMajority" "majority with a quorum of 2" activateRule_ rNum autoDelete diff --git a/src/Language/Nomyx/Game.hs b/src/Language/Nomyx/Game.hs --- a/src/Language/Nomyx/Game.hs +++ b/src/Language/Nomyx/Game.hs @@ -10,7 +10,7 @@ module Language.Nomyx.Game (GameEvent(..), update, update', LoggedGame(..), game, gameLog, emptyGame, execWithGame, execWithGame', outputAll, getLoggedGame, tracePN, getTimes, activeRules, pendingRules, rejectedRules) where -import Prelude hiding (catch) +import Prelude import Control.Monad.State import Data.List import Language.Nomyx hiding (outputAll) diff --git a/src/Language/Nomyx/Rule.hs b/src/Language/Nomyx/Rule.hs --- a/src/Language/Nomyx/Rule.hs +++ b/src/Language/Nomyx/Rule.hs @@ -89,6 +89,11 @@ --manages players joining and leaving createValueForEachPlayer_ :: V [(Int, Int)] -> Nomex () createValueForEachPlayer_ = createValueForEachPlayer 0 + +getValueOfPlayer :: PlayerNumber -> V [(Int, Int)] -> Nomex (Maybe Int) +getValueOfPlayer pn var = do + value <- readVar_ var + return $ lookup pn value modifyValueOfPlayer :: PlayerNumber -> V [(Int, Int)] -> (Int -> Int) -> Nomex () modifyValueOfPlayer pn var f = modifyVar var $ map $ (\(a,b) -> if a == pn then (a, f b) else (a,b)) diff --git a/src/Language/Nomyx/Test.hs b/src/Language/Nomyx/Test.hs --- a/src/Language/Nomyx/Test.hs +++ b/src/Language/Nomyx/Test.hs @@ -58,10 +58,10 @@ ("test time event 2", testTimeEventEx2), ("test assess on vote complete 1", testVoteAssessOnVoteComplete1), ("test assess on vote complete 2", testVoteAssessOnVoteComplete2), - ("test assess on every vote 1", testVoteAssessOnEveryVotes1), - ("test assess on every vote 2", testVoteAssessOnEveryVotes2), - ("test assess on every vote 3", testVoteAssessOnEveryVotes3), - ("test assess on every vote 4", testVoteAssessOnEveryVotes4), + ("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), @@ -258,14 +258,14 @@ -- 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 -testVoteAssessOnEveryVotes1 = testVoteRule Active $ voteGame 10 0 10 $ onRuleProposed $ voteWith_ unanimity $ assessOnEveryVotes -testVoteAssessOnEveryVotes2 = testVoteRule Active $ voteGame 6 0 10 $ onRuleProposed $ voteWith_ majority $ assessOnEveryVotes -testVoteAssessOnEveryVotes3 = testVoteRule Pending $ voteGame 5 0 10 $ onRuleProposed $ voteWith_ majority $ assessOnEveryVotes -testVoteAssessOnEveryVotes4 = testVoteRule Reject $ voteGame 0 5 10 $ onRuleProposed $ voteWith_ majority $ assessOnEveryVotes -testVoteMajorityWith = testVoteRule Active $ voteGame 6 0 10 $ onRuleProposed $ voteWith_ (majorityWith 50) $ assessOnEveryVotes -testVoteNumberPositiveVotes = testVoteRule Active $ voteGame 3 7 10 $ onRuleProposed $ voteWith_ (numberVotes 3) $ assessOnEveryVotes -testVoteWithQuorum1 = testVoteRule Active $ voteGame 7 3 10 $ onRuleProposed $ voteWith_ (majority `withQuorum` 7) $ assessOnEveryVotes -testVoteWithQuorum2 = testVoteRule Pending $ voteGame 6 0 10 $ onRuleProposed $ voteWith_ (majority `withQuorum` 7) $ assessOnEveryVotes +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 diff --git a/src/Language/Nomyx/Vote.hs b/src/Language/Nomyx/Vote.hs --- a/src/Language/Nomyx/Vote.hs +++ b/src/Language/Nomyx/Vote.hs @@ -52,7 +52,7 @@ --- | Performs a vote. +-- | Perform a vote. voteWith :: (Votable a) => VoteResult a -- ^ the function used to count the votes. -> Assessor a -- ^ assessors: when and how to perform the vote assessment (several assessors can be chained). -> a -- ^ toVote: the matter to be voted. @@ -77,8 +77,8 @@ -- | assess the vote on every new vote with the assess function, and as soon as the vote has an issue (positive of negative), sends a signal -assessOnEveryVotes :: (Votable a) => Assessor a -assessOnEveryVotes = do +assessOnEveryVote :: (Votable a) => Assessor a +assessOnEveryVote = do (VoteData msgEnd voteVar _ assess) <- get lift $ do msgVotes <- getArrayVarMessage voteVar @@ -193,7 +193,7 @@ referendum :: String -> Nomex () -> RuleFunc referendum name action = voidRule $ do - msg <- voteWith_ (majority `withQuorum` 2) (assessOnEveryVotes >> assessOnTimeDelay oneDay) (Referendum name) + msg <- voteWith_ (majority `withQuorum` 2) (assessOnEveryVote >> assessOnTimeDelay oneDay) (Referendum name) onMessageOnce msg resolution where resolution (MessageData [Yes]) = do outputAll "Positive result of referendum"