Nomyx-Language 0.2.2 → 0.2.3

raw patch · 7 files changed

+35/−29 lines, 7 files

Files

Nomyx-Language.cabal +1/−1
src/Language/Nomyx/Evaluation.hs +9/−7
src/Language/Nomyx/Examples.hs +3/−4
src/Language/Nomyx/Game.hs +1/−1
src/Language/Nomyx/Rule.hs +5/−0
src/Language/Nomyx/Test.hs +12/−12
src/Language/Nomyx/Vote.hs +4/−4

Nomyx-Language.cabal view

@@ -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)

src/Language/Nomyx/Evaluation.hs view

@@ -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

src/Language/Nomyx/Examples.hs view

@@ -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

src/Language/Nomyx/Game.hs view

@@ -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)

src/Language/Nomyx/Rule.hs view

@@ -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))

src/Language/Nomyx/Test.hs view

@@ -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

src/Language/Nomyx/Vote.hs view

@@ -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"