nomyx-library (empty) → 1.0.0
raw patch · 14 files changed
+865/−0 lines, 14 filesdep +basedep +containersdep +ghcsetup-changed
Dependencies added: base, containers, ghc, lens, mtl, nomyx-language, old-locale, safe, shortcut, time, time-recurrence
Files
- AUTHORS +1/−0
- LICENSE +27/−0
- README.md +39/−0
- Setup.lhs +6/−0
- nomyx-library.cabal +56/−0
- src/Nomyx/Library/Bank.hs +104/−0
- src/Nomyx/Library/Democracy.hs +24/−0
- src/Nomyx/Library/Elections.hs +18/−0
- src/Nomyx/Library/Examples.hs +62/−0
- src/Nomyx/Library/Monarchy.hs +35/−0
- src/Nomyx/Library/PlayerManagement.hs +13/−0
- src/Nomyx/Library/Victory.hs +48/−0
- src/Nomyx/Library/Vote.hs +207/−0
- src/templates.yaml +225/−0
+ AUTHORS view
@@ -0,0 +1,1 @@+Corentin Dupont <corentin.dupont@gmail.com>
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright 2012, Corentin Dupont. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of its contributors may be+ used to endorse or promote products derived from this software without+ specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,39 @@++Introduction+============++Nomyx is a game where you can change the rules: http://www.nomyx.net++This package defines a set of rule examples to be played in Nomyx, that you can modify.+Just fork this package to create your own rule and play them in Nomyx!+To push your rules to Nomyx, use [nomyx-client](https://github.com/cdupont/nomyx-client).+++Usage+=====++Fork this package:+```+git clone git@github.com:cdupont/nomyx-library.git+```++Get Haskell Stack:+```+curl -sSL https://get.haskellstack.org/ | sh+```++You can now compile it:+```+cd nomyx-library+stack install+```++Feel free to modify existing rules, or create new ones!+The rule list is in [templates.yaml](src/templates.yaml).++Once done, you can push your rules to Nomyx with [nomyx-client](https://github.com/cdupont/nomyx-client).++Contact+=======++Bug-reports, questions, suggestions and patches are all welcome.
+ Setup.lhs view
@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell +> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMain+
+ nomyx-library.cabal view
@@ -0,0 +1,56 @@+name: nomyx-library+version: 1.0.0+cabal-version: >=1.8+build-type: Simple+license: BSD3+license-file: LICENSE+copyright: 2012 Corentin Dupont+maintainer: Corentin Dupont+stability: Experimental+synopsis: Library of rules for Nomyx+description: Many example of rules ready to be played+category: Language+Homepage: http://www.nomyx.net+author: Corentin Dupont+--data-files: static/pictures/*.png+data-files: Nomyx/Library/Examples.hs+ Nomyx/Library/Democracy.hs+ Nomyx/Library/Monarchy.hs+ Nomyx/Library/PlayerManagement.hs+ Nomyx/Library/Victory.hs+ Nomyx/Library/Vote.hs+ Nomyx/Library/Elections.hs+ Nomyx/Library/Bank.hs+ templates.yaml+data-dir: src+extra-source-files: AUTHORS README.md++library+ build-depends: nomyx-language == 1.0.*,+ base >= 4.6 && < 5,+ containers == 0.5.*,+ ghc >= 7.6 && < 8.1,+ lens >= 4.7 && < 4.15,+ mtl >= 2.1 && < 2.3,+ old-locale == 1.0.*,+ safe == 0.3.*,+ shortcut == 0.1.*,+ time >= 1.4 && < 1.7,+ time-recurrence == 0.9.*+ exposed-modules: Nomyx.Library.Examples+ Nomyx.Library.Democracy+ Nomyx.Library.Monarchy+ Nomyx.Library.PlayerManagement+ Nomyx.Library.Victory+ Nomyx.Library.Vote+ Nomyx.Library.Elections+ Nomyx.Library.Bank+ Paths_nomyx_library+ exposed: True+ buildable: True+ hs-source-dirs: src+ ghc-options: -W++source-repository head+ type: git+ location: https://github.com/cdupont/Nomyx.git
+ src/Nomyx/Library/Bank.hs view
@@ -0,0 +1,104 @@+ {-# LANGUAGE DoAndIfThenElse #-}++-- | This file gives a list of example rules that the players can submit.+module Nomyx.Library.Bank where++import Prelude+import Data.Time.Recurrence as X hiding (filter)+import Data.List as X+import Data.Maybe+import Control.Monad as X+import Safe (readDef)+import Nomyx.Language+++-- | account variable name and type+accounts :: V [(PlayerNumber, Int)]+accounts = V "Accounts"++-- | Create a bank account for each players+createBankAccounts :: Rule+createBankAccounts = void $ createValueForEachPlayer_ accounts++-- | Declare an API to deposit money for a player+-- The return value shows if the transaction was successful.+depositAPI :: APICall (PlayerNumber, Int) Bool+depositAPI = APICall "deposit"++-- | Declare an API to withdraw money for a player.+-- The return value shows if the transaction was successful.+withdrawAPI :: APICall (PlayerNumber, Int) Bool+withdrawAPI = APICall "withdraw"++-- | Declare an API to get the balance of a player.+balanceAPI :: APICall PlayerNumber (Maybe Int)+balanceAPI = APICall "getBalance"++bankServices :: Nomex ()+bankServices = do+ void $ onAPICall depositAPI deposit+ void $ onAPICall withdrawAPI withdraw+ void $ onAPICall balanceAPI getBalance++deposit :: (PlayerNumber, Int) -> Nomex Bool+deposit (pn, amount) = do+ if amount > 0 then modifyValueOfPlayer pn accounts (+ amount)+ else return False++withdraw :: (PlayerNumber, Int) -> Nomex Bool+withdraw (pn, amount) = do+ balance <- getValueOfPlayer pn accounts+ if (amount > 0 && fromJust balance >= amount) then modifyValueOfPlayer pn accounts (\a -> a - amount)+ else return False++getBalance :: PlayerNumber -> Nomex (Maybe Int)+getBalance pn = getValueOfPlayer pn accounts++-- | Permanently display the bank accounts+displayBankAccounts :: Rule+displayBankAccounts = do+ let displayOneAccount (account_pn, a) = do+ name <- showPlayer account_pn+ return $ name ++ "\t" ++ show a ++ "\n"+ let displayAccounts l = do+ d <- concatMapM displayOneAccount l+ return $ "Accounts:\n" ++ d+ void $ displayVar' Nothing accounts displayAccounts++-- | each player wins X Ecu each day+-- you can also try with "minutly" or "monthly" instead of "daily" and everything in the "time-recurrence" package+winXEcuPerDay :: Int -> Rule+winXEcuPerDay x = schedule_ (recur daily) $ modifyAllValues accounts (+x)++-- | a player wins X Ecu if a rule proposed is accepted+winXEcuOnRuleAccepted :: Int -> Rule+winXEcuOnRuleAccepted x = void $ onEvent_ (ruleEvent Activated) $ \rule -> void $ modifyValueOfPlayer (_rProposedBy rule) accounts (+x)++-- | a player can transfer money to another player+moneyTransfer :: Rule+moneyTransfer = do+ let askAmount :: PlayerNumber -> Event (PlayerNumber, Int)+ askAmount src = do+ pls <- liftEvent getAllPlayerNumbers+ guard (length pls >= 2) >> do+ let pnames = map (\a -> (a, show a)) (delete src $ sort pls)+ dst <- inputRadio src "Transfer money to player: " pnames+ amount <- inputText src ("Select Amount to transfert to player " ++ show dst ++ ": ")+ return (dst, readDef 0 amount)+ void $ forEachPlayer_ (\pn -> void $ onEvent_ (askAmount pn) (transfer pn))++-- | helper function to transfer money from first player to second player+transfer :: PlayerNumber -> (PlayerNumber, Int) -> Nomex ()+transfer src (dst, amount) = do+ withdrawOK <- callAPIBlocking withdrawAPI (src, amount)+ if withdrawOK then do+ depositOK <- callAPIBlocking depositAPI (dst, amount)+ if depositOK then do+ void $ newOutput_ (Just src) ("You transfered " ++ (show amount) ++ " ecu(s) to player " ++ (show dst))+ void $ newOutput_ (Just dst) ("You received " ++ (show amount) ++ " ecu(s) from player " ++ (show src))+ else do+ --If transaction failed, deposit back the money+ callAPIBlocking depositAPI (src, amount)+ void $ newOutput_ (Just src) ("Transaction failed")+ else do+ void $ newOutput_ (Just src) ("Insufficient balance or wrong amount")
+ src/Nomyx/Library/Democracy.hs view
@@ -0,0 +1,24 @@++-- | This file gives a list of example rules that the players can submit.+module Nomyx.Library.Democracy where++import Prelude+import Nomyx.Language+import Nomyx.Library.Vote+++-- | a majority vote, with the folowing parameters:+-- a quorum of 2 voters is necessary for the validity of the vote+-- the vote is assessed after every vote in case the winner is already known+-- the vote will finish anyway after one day+voteWithMajority :: Rule+voteWithMajority = onRuleProposed $ callVoteRule (majority `withQuorum` 2) oneDay++-- | Change current system (the rules passed in parameter) to absolute majority (half participants plus one)+democracy :: [RuleNumber] -> Rule+democracy rs = do+ mapM_ suppressRule rs+ rNum <- addRule' "vote with majority" voteWithMajority "voteWithMajority" "majority with a quorum of 2"+ activateRule_ rNum+ autoDelete+
+ src/Nomyx/Library/Elections.hs view
@@ -0,0 +1,18 @@++-- | This file gives a list of example rules that the players can submit.+module Nomyx.Library.Elections where++import Data.List+import Control.Monad+import Nomyx.Language+++tournamentMasterCandidates :: Rule+tournamentMasterCandidates = do+ let tournamentMasterCandidates = V "tournamentMasterCandidates" :: V [PlayerNumber]+ let candidate pn = void $ modifyVar tournamentMasterCandidates (pn : )+ let displayCandidates pns = return $ "Candidates for the election of Tournament Master: Players #" ++ intercalate ", " (map show pns)+ newVar_ (varName tournamentMasterCandidates) ([] :: [PlayerNumber])+ forEachPlayer_ (\pn -> void $ onInputButtonOnce "I am candidate for the next Tournament Master elections " (const $ candidate pn) pn)+ void $ displayVar' Nothing tournamentMasterCandidates displayCandidates+
+ src/Nomyx/Library/Examples.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DoAndIfThenElse #-}++-- | This file gives a list of example rules that the players can submit.+module Nomyx.Library.Examples where++import Prelude+import Control.Monad as X+import Nomyx.Language+import qualified Data.Time as DT+import Control.Applicative++-- | A rule that does nothing+nothing :: Rule+nothing = return ()++-- | A rule that says hello to all players+helloWorld :: Rule+helloWorld = outputAll_ "hello, world!"++-- | delete a rule+delRule :: RuleNumber -> Rule+delRule rn = suppressRule_ rn >> autoDelete++-- | will display the current time (when refreshing the screen)+displayCurrentTime :: Rule+displayCurrentTime = void $ outputAll $ do+ t <- getCurrentTime+ return $ "The current time is: " ++ (show t)++-- | will display the time at which the rule as been activated+displayActivateTime :: Nomex ()+displayActivateTime = do+ t <- getCurrentTime+ outputAll_ $ "This rule was activated at: " ++ (show t)++-- | display a button and greets you when pressed (for player 1)+bravoButton :: Rule+bravoButton = void $ onInputButton_ "Click here:" (const $ outputAll_ "Bravo!") 1++-- | display a button to greet other players+helloButton :: Rule+helloButton = do+ --get your own player number+ me <- getProposerNumber_+ --create an output for me only+ let displayMsg a = void $ newOutput_ Nothing ("Msg: " ++ a)+ --create a button for me, which will display the output when clicked+ let button = do+ all <- liftEvent getPlayers+ guard (length all >= 2) >> inputText me "send a message"+ void $ onEvent_ button displayMsg++enterHaiku :: Rule+enterHaiku = void $ onInputTextarea_ "Enter a haiku:" outputAll_ 1++testTime :: Rule+testTime = do+ t <- getCurrentTime+ void $ onEvent_ (True <$ inputButton 1 "click here before 5 seconds:" <|> False <$ (timeEvent $ DT.addUTCTime 5 t)) f where+ f a = outputAll_ $ show a
+ src/Nomyx/Library/Monarchy.hs view
@@ -0,0 +1,35 @@++-- | This file gives a list of example rules that the players can submit.+module Nomyx.Library.Monarchy where++import Control.Monad+import Nomyx.Language++-- | Variable holding the player number of the King+king :: V PlayerNumber+king = V "King"++-- | player pn is the king: we create a variable King to identify him,+-- and we prefix his name with "King"+makeKing :: PlayerNumber -> Rule+makeKing pn = do+ newVar_ "King" pn+ void $ modifyPlayerName pn ("King " ++)++-- | Monarchy: only the king decides which rules to accept or reject+monarchy :: PlayerNumber -> Rule+monarchy pn = do+ makeKing pn+ void $ onEvent_ (ruleEvent Proposed) $ \rule -> do+ k <- readVar_ king+ void $ onInputRadioOnce ("Your Royal Highness, do you accept rule " ++ (show $ _rNumber rule) ++ "?") [(True, "Yes"), (False, "No")] (activateOrRejectRule rule) k++-- | Revolution! Hail to the king!+-- This rule suppresses the democracy (usually rules 1 and 2), installs the king and activates monarchy.+revolution :: PlayerNumber -> Rule+revolution pn = do+ suppressRule 1+ rNum <- addRule' "Monarchy" (monarchy pn) ("monarchy " ++ (show pn)) "Monarchy: only the king can vote on new rules"+ activateRule_ rNum+ autoDelete+
+ src/Nomyx/Library/PlayerManagement.hs view
@@ -0,0 +1,13 @@++-- | This file gives a list of example rules that the players can submit.+module Nomyx.Library.PlayerManagement where++import Control.Monad+import Nomyx.Language++-- | kick a player and prevent him from returning+banPlayer :: PlayerNumber -> Rule+banPlayer pn = do+ delPlayer pn+ void $ onEvent_ (playerEvent Arrive) $ const $ void $ delPlayer pn--- | kick a player and prevent him from returning+
+ src/Nomyx/Library/Victory.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DoAndIfThenElse #-}++-- | This file gives a list of example rules that the players can submit.+--You can copy-paste them in the field "Code" of the web GUI.+--You can copy either the name of the function (i.e. "helloWorld") or its body (i.e. "outputAll_ "hello, world!""), but NOT both.+--Don't hesitate to get inspiration from there and create your own rules!+module Nomyx.Library.Victory where++import Data.Function+import Data.List+import Control.Arrow+import Control.Monad+import Nomyx.Language+import Nomyx.Library.Bank+++-- | set the victory for players having more than X accepted rules+victoryXRules :: Int -> Rule+victoryXRules x = setVictory $ do+ rs <- getRules+ let counts :: [(PlayerNumber,Int)]+ counts = map (_rProposedBy . head &&& length) $ groupBy ((==) `on` _rProposedBy) rs+ let victorious = map fst $ filter ((>= x) . snd) counts+ return victorious++victoryXEcu :: Int -> Rule+victoryXEcu x = setVictory $ do+ as <- readVar accounts+ let victorious as = map fst $ filter ((>= x) . snd) as+ return $ maybe [] victorious as++-- | Only one player can achieve victory: No group victory.+-- Forbidding group victory usually becomes necessary when lowering the voting quorum:+-- a coalition of players could simply force a "victory" rule and win the game.+noGroupVictory :: Rule+noGroupVictory = do+ let testVictory (VictoryInfo _ cond) = do+ vics <- cond+ when (length vics >1) $ setVictory (return []) --unset victory condition+ void $ onEvent_ victoryEvent testVictory++-- | Rule that state that you win. Good luck on having this accepted by other players ;)+iWin :: Rule+iWin = getProposerNumber >>= giveVictory++
+ src/Nomyx/Library/Vote.hs view
@@ -0,0 +1,207 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++-- | Voting system+module Nomyx.Library.Vote where++import Control.Applicative+import Control.Arrow+import Control.Monad.State hiding (forM_)+import Control.Shortcut+import Data.List+import qualified Data.Map as M+import Data.Maybe+import Data.Time hiding (getCurrentTime)+import Data.Typeable+import Nomyx.Language+import Prelude hiding (foldr)++-- | a vote assessing function (such as unanimity, majority...)+type AssessFunction = VoteStats -> Maybe Bool++-- | the vote statistics, including the number of votes per choice,+-- the number of persons called to vote, and if the vote is finished (timeout or everybody voted)+data VoteStats = VoteStats { voteCounts :: M.Map Bool Int,+ nbParticipants :: Int,+ voteFinished :: Bool}+ deriving (Show, Typeable)++-- | information broadcasted when a vote begins+data VoteBegin = VoteBegin { vbRule :: RuleInfo,+ vbEndAt :: UTCTime,+ vbEventNumber :: EventNumber }+ deriving (Show, Eq, Ord, Typeable)++-- | information broadcasted when a vote ends+data VoteEnd = VoteEnd { veRule :: RuleInfo,+ veVotes :: [(PlayerNumber, Maybe Bool)],+ vePassed :: Bool,+ veFinishedAt :: UTCTime}+ deriving (Show, Eq, Ord, Typeable)++voteBegin :: Msg VoteBegin+voteBegin = Signal "VoteBegin"++voteEnd :: Msg VoteEnd+voteEnd = Signal "VoteEnd"++-- | vote at unanimity every incoming rule+unanimityVote :: Nomex ()+unanimityVote = do+ onRuleProposed $ callVoteRule unanimity oneDay+ displayVotes++-- | call a vote on a rule for every players, with an assessing function and a delay+callVoteRule :: AssessFunction -> NominalDiffTime -> RuleInfo -> Nomex ()+callVoteRule assess delay ri = do+ endTime <- addUTCTime delay <$> getCurrentTime+ callVoteRule' assess endTime ri++callVoteRule' :: AssessFunction -> UTCTime -> RuleInfo -> Nomex ()+callVoteRule' assess endTime ri = do+ en <- callVote assess endTime (_rName $ _rRuleTemplate ri) (_rNumber ri) (finishVote assess ri)+ sendMessage voteBegin (VoteBegin ri endTime en)++-- | actions to do when the vote is finished+finishVote :: AssessFunction -> RuleInfo -> [(PlayerNumber, Maybe Bool)] -> Nomex ()+finishVote assess ri vs = do+ let passed = fromJust $ assess $ getVoteStats (map snd vs) True+ activateOrRejectRule ri passed+ end <- getCurrentTime+ sendMessage voteEnd (VoteEnd ri vs passed end)++-- | call a vote for every players, with an assessing function, a delay and a function to run on the result+callVote :: AssessFunction -> UTCTime -> String -> RuleNumber -> ([(PlayerNumber, Maybe Bool)] -> Nomex ()) -> Nomex EventNumber+callVote assess endTime name rn payload = do+ let title = "Vote for rule: \"" ++ name ++ "\" (#" ++ (show rn) ++ "):"+ onEventOnce (voteWith endTime assess title) payload+++-- | vote with a function able to assess the ongoing votes.+-- | the vote can be concluded as soon as the result is known.+voteWith :: UTCTime -> AssessFunction -> String -> Event [(PlayerNumber, Maybe Bool)]+voteWith timeLimit assess title = do+ pns <- liftEvent getAllPlayerNumbers+ let voteEvents = map (singleVote title) pns+ let timerEvent = timeEvent timeLimit+ let isFinished votes timer = isJust $ assess $ getVoteStats votes timer+ (vs, _)<- shortcut2b voteEvents timerEvent isFinished+ return $ zip pns vs++-- | display the votes (ongoing and finished)+displayVotes :: Nomex ()+displayVotes = do+ void $ onMessage voteEnd displayFinishedVote+ void $ onMessage voteBegin displayOnGoingVote++-- trigger the display of a radio button choice on the player screen, yelding either True or False.+-- after the time limit, the value sent back is Nothing.+singleVote :: String -> PlayerNumber -> Event Bool+singleVote title pn = inputRadio pn title [(True, "For"), (False, "Against")]++-- | assess the vote results according to a unanimity+unanimity :: AssessFunction+unanimity voteStats = voteQuota (nbVoters voteStats) voteStats++-- | assess the vote results according to an absolute majority (half voters plus one)+majority :: AssessFunction+majority voteStats = voteQuota ((nbVoters voteStats) `div` 2 + 1) voteStats++-- | assess the vote results according to a majority of x (in %)+majorityWith :: Int -> AssessFunction+majorityWith x voteStats = voteQuota ((nbVoters voteStats) * x `div` 100 + 1) voteStats++-- | assess the vote results according to a fixed number of positive votes+numberVotes :: Int -> AssessFunction+numberVotes x voteStats = voteQuota x voteStats++-- | adds a quorum to an assessing function+withQuorum :: AssessFunction -> Int -> AssessFunction+withQuorum f minNbVotes = \voteStats -> if (voted voteStats) >= minNbVotes+ then f voteStats+ else if voteFinished voteStats then Just False else Nothing++getVoteStats :: [Maybe Bool] -> Bool -> VoteStats+getVoteStats votes finished = VoteStats+ {voteCounts = M.fromList $ counts (catMaybes votes),+ nbParticipants = length votes,+ voteFinished = finished}++counts :: (Eq a, Ord a) => [a] -> [(a, Int)]+counts as = map (head &&& length) (group $ sort as)++-- | Compute a result based on a quota of positive votes.+-- the result can be positive if the quota if reached, negative if the quota cannot be reached anymore at that point, or still pending.+voteQuota :: Int -> VoteStats -> Maybe Bool+voteQuota q voteStats+ | M.findWithDefault 0 True vs >= q = Just True+ | M.findWithDefault 0 False vs > (nbVoters voteStats) - q = Just False+ | otherwise = Nothing+ where vs = voteCounts voteStats+++-- | number of people that voted if the voting is finished,+-- total number of people that should vote otherwise+nbVoters :: VoteStats -> Int+nbVoters vs+ | voteFinished vs = voted vs+ | otherwise = nbParticipants vs++voted, notVoted :: VoteStats -> Int+notVoted vs = (nbParticipants vs) - (voted vs)+voted vs = M.findWithDefault 0 True (voteCounts vs) + M.findWithDefault 0 False (voteCounts vs)++-- | display an on going vote+displayOnGoingVote :: VoteBegin -> Nomex ()+displayOnGoingVote (VoteBegin ri endTime en) = void $ outputAll $ do+ mds <- getIntermediateResults en+ let mbs = map getBooleanResult <$> mds+ pns <- getAllPlayerNumbers+ case mbs of+ Just bs -> showOnGoingVote (getVotes pns bs) (_rNumber ri) endTime+ Nothing -> return ""++getVotes :: [PlayerNumber] -> [(PlayerNumber, Bool)] -> [(PlayerNumber, Maybe Bool)]+getVotes pns rs = map (findVote rs) pns where+ findVote :: [(PlayerNumber, Bool)] -> PlayerNumber -> (PlayerNumber, Maybe Bool)+ findVote rs' pn = case (find (\(pn1, _) -> pn == pn1) rs') of+ Just (pn', b) -> (pn', Just b)+ Nothing -> (pn, Nothing)++getBooleanResult :: (PlayerNumber, SomeData) -> (PlayerNumber, Bool)+getBooleanResult (pn, SomeData sd) = case (cast sd) of+ Just a -> (pn, a)+ Nothing -> error "incorrect vote field"++showOnGoingVote :: [(PlayerNumber, Maybe Bool)] -> RuleNumber -> UTCTime -> Nomex String+showOnGoingVote [] rn _ = return $ "Nobody voted yet for rule #" ++ (show rn) ++ "."+showOnGoingVote listVotes rn endTime = do+ list <- mapM showVote listVotes+ let timeString = formatTime defaultTimeLocale "on %d/%m at %H:%M UTC" endTime+ return $ "Votes for rule #" ++ (show rn) ++ ", finishing " ++ timeString ++ "\n" +++ concatMap (\(name, vote) -> name ++ "\t" ++ vote ++ "\n") list++-- | display a finished vote+displayFinishedVote :: VoteEnd -> Nomex ()+displayFinishedVote (VoteEnd ri vs passed end) = void $ outputAll $ showFinishedVote (_rNumber ri) passed vs end++showFinishedVote :: RuleNumber -> Bool -> [(PlayerNumber, Maybe Bool)] -> UTCTime -> Nomex String+showFinishedVote rn passed l _ = do+ let title = "Vote finished for rule #" ++ (show rn) ++ ", passed: " ++ (show passed)+ let voted = filter (\(_, r) -> isJust r) l+ votes <- mapM showVote voted+ return $ title ++ " (" ++ (intercalate ", " $ map (\(name, vote) -> name ++ ": " ++ vote) votes) ++ ")"++showVote :: (PlayerNumber, Maybe Bool) -> Nomex (String, String)+showVote (pn, v) = do+ name <- showPlayer pn+ return (name, showChoice v)++showChoice :: Maybe Bool -> String+showChoice (Just a) = show a+showChoice Nothing = "Not voted"
+ src/templates.yaml view
@@ -0,0 +1,225 @@++# Democracy++- name: Majority vote+ author: Kau+ desc: "A majority vote is cast for new rules. Vote will pass with more than 50% of \"yes\",+ with minimum 2 voters to be valid,+ finishing after maximum one day."+ rule: onRuleProposed $ callVoteRule (majority `withQuorum` 2) oneDay+ category: [Democracy]+ decls:+ - Nomyx/Library/Vote.hs+ - Nomyx/Library/Democracy.hs+ picture: null++- name: Unanimity vote+ author: Kau+ desc: "A unanimity vote: all players need to vote \"yes\" for a new rule to be accepted."+ rule: onRuleProposed $ callVoteRule unanimity oneDay+ category: [Democracy]+ decls:+ - Nomyx/Library/Vote.hs+ - Nomyx/Library/Democracy.hs+ picture: null++# Monarchy++- name: make King+ author: Kau+ desc: "Make a player King (change the 1 with the player number that becomes King)"+ rule: makeKing 1+ category: [Monarchy]+ decls:+ - Nomyx/Library/Monarchy.hs+ picture: null++- name: Monarchy+ author: Kau+ desc: "Monarchy: only the king decides which rules to accept or reject (change the 1 with the player number)"+ rule: monarchy 1+ category: [Monarchy]+ decls:+ - Nomyx/Library/Monarchy.hs+ picture: null++- name: revolution+ author: Kau+ desc: "Revolution! Hail to the king!+ This rule suppresses the democracy (usually rules 1 or 2), installs the king and activates monarchy.+ (change the 1 with the player number that you want for King)"+ rule: revolution 1+ category: [Monarchy]+ decls:+ - Nomyx/Library/Monarchy.hs+ picture: null+++# Victories++- name: 5 rules victory+ author: Kau+ desc: "You win if you have 5 rules accepted."+ rule: victoryXRules 5+ category: [Victory]+ decls:+ - Nomyx/Library/Victory.hs+ picture: null++- name: 100 ECU wins+ author: Kau+ desc: "You win if you have 1000 ECU on your bank account."+ rule: victoryXEcu 1000+ category: [Victory]+ decls:+ - Nomyx/Library/Victory.hs+ picture: null++- name: I win+ author: Kau+ desc: "You win. That's it, if this rule is accepted you win the game.+ Good luck on having this accepted by other players ;)"+ rule: iWin+ category: [Victory]+ decls:+ - Nomyx/Library/Victory.hs+ picture: null++- name: No group victory+ author: Kau+ desc: "Only one player can achieve victory: No group victory.+ Forbidding group victory usually becomes necessary when lowering the voting quorum:+ a coalition of players could simply force a \"victory\" rule and win the game."+ rule: noGroupVictory+ category: [Victory]+ decls:+ - Nomyx/Library/Victory.hs+ picture: null++# Bank accounts++- name: Bank accounts+ author: Kau+ desc: Create a bank account for each players+ rule: createBankAccounts+ category: [Bank]+ decls: [Nomyx/Library/Bank.hs]+ picture: null++- name: Bank services+ author: Kau+ desc: Activate bank services+ rule: bankServices+ category: [Bank]+ decls: [Nomyx/Library/Bank.hs]+ picture: null++- name: Display accounts+ author: Kau+ desc: Display all bank accounts+ rule: displayBankAccounts+ category: [Bank]+ decls: [Nomyx/Library/Bank.hs]+ picture: null++- name: Daily salaries+ author: Kau+ desc: each player wins 10 Ecu each days+ rule: winXEcuPerDay 10 + category: [Bank]+ decls: [Nomyx/Library/Bank.hs]+ picture: null++- name: Bonus rule accepted+ author: Kau+ desc: a player wins 100 Ecu if a rule proposed is accepted+ rule: winXEcuOnRuleAccepted 100+ category: [Bank]+ decls: [Nomyx/Library/Bank.hs]+ picture: null++- name: Money transfer+ author: Kau+ desc: a player can transfer money to another player+ rule: moneyTransfer+ category: [Bank]+ decls: [Nomyx/Library/Bank.hs]+ picture: null++# Players++- name: Ban player+ author: Kau+ desc: "Kick a player and prevent him from returning."+ rule: banPlayer X+ category: [Players]+ decls:+ - Nomyx/Library/PlayerManagement.hs+ picture: null++# Examples++- name: Nothing+ author: Kau+ desc: A rule that does nothing+ rule: return ()+ category: [Examples]+ decls: [Nomyx/Library/Examples.hs]+ picture: null++- name: Hello World+ author: Kau+ desc: A rule that says hello to all players+ rule: outputAll_ "hello, world!"+ category: [Examples]+ decls: [Nomyx/Library/Examples.hs]+ picture: null++- name: Display current time+ author: Kau+ desc: Will display the current time (when refreshing the screen)+ rule: displayCurrentTime+ category: [Examples]+ decls: [Nomyx/Library/Examples.hs]+ picture: null++- name: Display activation time+ author: Kau+ desc: will display the time at which the rule as been activate+ rule: displayActivateTime+ category: [Examples]+ decls: [Nomyx/Library/Examples.hs]+ picture: null++- name: Delete rule+ author: Kau+ desc: Delete rule number one and then deletes itself+ rule: suppressRule_ 1 >> autoDelete+ category: [Examples]+ decls: [Nomyx/Library/Examples.hs]+ picture: null++- name: Bravo button+ author: Kau+ desc: display a button and greets you when pressed (for player 1)+ rule: void $ onInputButton_ "Click here:" (const $ outputAll_ "Bravo!") 1+ category: [Examples]+ decls: [Nomyx/Library/Examples.hs]+ picture: null++- name: Hello button+ author: Kau+ desc: display a button to greet other players+ rule: helloButton+ category: [Examples]+ decls: [Nomyx/Library/Examples.hs]+ picture: null++- name: Enter Haiku+ author: Kau+ desc: display a field where you can enter a poem+ rule: void $ onInputTextarea_ "Enter a haiku:" outputAll_ 1+ category: [Examples]+ decls: [Nomyx/Library/Examples.hs]+ picture: null+