packages feed

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