Bravo button
display a button and greets you when pressed (for player 1)

authored by Kau

This rule was proposed by player King mhbr and deleted by rule 2.
void $ onInputButton_ "Click here:" (const $ outputAll_ "Bravo!") 1

Nomyx/Library/Examples.hs
{-# 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
Attacking planets
Players can attack planets

authored by Kau

This rule was proposed by player nomeata and activated by rule 2.
do
let fleets :: V [(PlayerNumber, [String])]
    fleets = V "Fleets"

void $ createValueForEachPlayer [] fleets

let askTarget src = inputText src ("Which planet to attack?")
(...)

Nomyx/Library/Examples.hs
{-# 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 = giveVictory 73 >> 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
I would be happy if we had a Monarchy
Monarchy: only the king decides which rules to accept or reject (change the 1 with the player number)

authored by Kau

This rule was proposed by player King mhbr and activated by rule 2.
monarchy 1

Nomyx/Library/Monarchy.hs
-- | 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

Duplicate all planets
A rule that does nothing

authored by Kau

This rule was proposed by player agrafix and deleted by rule 2.
do {allPlanets <- callAPIBlocking planetAPI ()
     ; setPlanets (allPlanets ++ allPlanets)
     }

Nomyx/Library/Examples.hs
module Nomyx.Library.Examples where

import Prelude
import Nomyx.Language
import Control.Monad
import Data.Maybe

data Planet = Planet { name  :: String,
                       owner :: Maybe PlayerNumber}
                       deriving (Eq, Show)

planetAPI :: APICall () [Planet]
planetAPI = APICall "getPlanets"

setPlanets :: [Planet] -> Rule
setPlanets ps = void $ onAPICall planetAPI (const $ return ps) where 

displayPlanets :: Rule
displayPlanets = void $ outputAll $ do
   planets <- callAPIBlocking planetAPI ()
   s <- concatMapM showPlanet planets
   return s

showPlanet :: Planet -> Nomex String
showPlanet (Planet planetName (Just pn)) = do
   playerName <- getPlayerName pn
   return $ "Planet " ++ planetName ++ ": ruled by player " ++ (fromJust playerName) ++ "\n"
showPlanet (Planet planetName Nothing) = return $ "Planet " ++ planetName ++ ": free planet\n"
  
100 ECU rule royality
This rules gives 100 ECU for every player that gets a rule accepted

authored by Kau

This rule was proposed by player nomeata and activated by rule 2.
Player 72 successfully got a rule accepted, and earned 100 ECU
Player 70 successfully got a rule accepted, and earned 100 ECU
Player 73 successfully got a rule accepted, and earned 100 ECU
Player 70 successfully got a rule accepted, and earned 100 ECU
onRuleProposed $ \ri -> do
    let p = _rProposedBy ri
    outputAll (Return ("Player " ++ show p ++ " successfully got a rule accepted, and earned 100 ECU"))
    modifyValueOfPlayer p (V "Accounts" :: V [(PlayerNumber, Int)]) (\a -> a + 100)
    return ()

Nomyx/Library/Examples.hs
{-# 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 = giveVictory 73 >> 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
Display votes
Display on-going and finished votes.

authored by Kau

This rule was proposed by player kau2 and activated by rule 2.
Vote finished for rule #24, passed: True (kau2: True, King mhbr: True, agrafix: True, quchen: True)
Vote finished for rule #16, passed: False (jcmincke: True, kau2: False, nomeata: False, King mhbr: True, agrafix: False, quchen: True)
Vote finished for rule #19, passed: True (jcmincke: True, kau2: True, nomeata: True, King mhbr: False, agrafix: True, quchen: False)
Vote finished for rule #18, passed: False (jcmincke: True, kau2: True, nomeata: False, King mhbr: False, agrafix: False, quchen: True)
Vote finished for rule #25, passed: True (jcmincke: True, kau2: True, nomeata: True, quchen: True)
Vote finished for rule #23, passed: False (jcmincke: True, kau2: True, nomeata: False, King mhbr: True, agrafix: False, quchen: False)
Vote finished for rule #28, passed: True (kau2: True, King mhbr: True, agrafix: True, quchen: True)
Vote finished for rule #26, passed: False (jcmincke: True, kau2: False, nomeata: False, King mhbr: False, agrafix: True, quchen: True)
Vote finished for rule #27, passed: True (jcmincke: True, kau2: True, nomeata: False, King mhbr: True, agrafix: False, quchen: True)
Vote finished for rule #29, passed: False (King mhbr: True)
displayVotes

Nomyx/Library/Vote.hs
Nomyx/Library/Democracy.hs
{-# 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,
                             vbPlayers     :: [PlayerNumber]}
                             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)
   pns <- getAllPlayerNumbers
   sendMessage voteBegin (VoteBegin ri endTime en pns)

-- | 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
   onEventOnce (voteWith endTime assess name rn) 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 -> RuleNumber-> Event [(PlayerNumber, Maybe Bool)]
voteWith timeLimit assess name rn = do
   pns <- liftEvent getAllPlayerNumbers
   let voteEvents = map (singleVote name rn) 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 -> RuleNumber -> PlayerNumber -> Event Bool
singleVote name rn pn = inputRadio pn title [(True, "For"), (False, "Against")] where
   title = "Vote for rule: \"" ++ name ++ "\" (#" ++ (show rn) ++ "):"

-- | 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 (RuleInfo rn _ _ _ _ _ (RuleTemplate name _ _ _ _ _ _)) endTime en pns) = void $ outputAll $ do
   isa <- isEventActive en
   if isa
     then do
        ers <- mapM (\pn -> getEventResult en (singleVote name rn pn)) pns
        showOnGoingVote (zip pns ers) rn endTime
     else return ""

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

Bonus rule accepted
a player wins 100 Ecu if a rule proposed is accepted

authored by Kau

This rule was proposed by player King mhbr and deleted by rule 2.
winXEcuOnRuleAccepted 100

Nomyx/Library/Bank.hs
 {-# 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")
Planets owners
Several planets appears on your radar!

authored by Kau

This rule was proposed by player kau2 and activated by rule 2.
do suppressRule_ 20
   setPlanets [Planet "Krikkit"     (Just 70),
                  Planet "Brontital"  (Just 69),
                  Planet "Helicon"    (Just 2),
                  Planet "Terminus"  (Just 72),
                  Planet "Arrakis"     (Just 73),
                  Planet "Caladan"   Nothing,
(...)

Nomyx/Library/Planets.hs
module Nomyx.Library.Planets where

import Prelude
import Nomyx.Language
import Control.Monad
import Data.Maybe

data Planet = Planet { name  :: String,
                       owner :: Maybe PlayerNumber}
                       deriving (Eq, Show)

planetAPI :: APICall () [Planet]
planetAPI = APICall "getPlanets"

setPlanets :: [Planet] -> Rule
setPlanets ps = void $ onAPICall planetAPI (const $ return ps) where 

displayPlanets :: Rule
displayPlanets = void $ outputAll $ do
   planets <- callAPIBlocking planetAPI ()
   s <- concatMapM showPlanet planets
   return s

showPlanet :: Planet -> Nomex String
showPlanet (Planet planetName (Just pn)) = do
   playerName <- getPlayerName pn
   return $ "Planet " ++ planetName ++ ": ruled by player " ++ (fromJust playerName) ++ "\n"
showPlanet (Planet planetName Nothing) = return $ "Planet " ++ planetName ++ ": free planet\n"
  
Display planets
Display the planets

authored by Kau

This rule was proposed by player kau2 and activated by rule 2.
Planet Krikkit: ruled by player King mhbr
Planet Brontital: ruled by player jcmincke
Planet Helicon: ruled by player kau2
Planet Terminus: ruled by player agrafix
Planet Arrakis: ruled by player nomeata
Planet Caladan: free planet
Planet Hyperion: free planet
Planet Arda: free planet
Planet Zorg: free planet

displayPlanets

Nomyx/Library/Planets.hs
module Nomyx.Library.Planets where

import Prelude
import Nomyx.Language
import Control.Monad
import Data.Maybe

data Planet = Planet { name  :: String,
                       owner :: Maybe PlayerNumber}
                       deriving (Eq, Show)

planetAPI :: APICall () [Planet]
planetAPI = APICall "getPlanets"

setPlanets :: [Planet] -> Rule
setPlanets ps = void $ onAPICall planetAPI (const $ return ps) where 

displayPlanets :: Rule
displayPlanets = void $ outputAll $ do
   planets <- callAPIBlocking planetAPI ()
   s <- concatMapM showPlanet planets
   return s

showPlanet :: Planet -> Nomex String
showPlanet (Planet planetName (Just pn)) = do
   playerName <- getPlayerName pn
   return $ "Planet " ++ planetName ++ ": ruled by player " ++ (fromJust playerName) ++ "\n"
showPlanet (Planet planetName Nothing) = return $ "Planet " ++ planetName ++ ": free planet\n"
  
Planets
Several planets appears on your radar!

authored by Kau

This rule was proposed by player kau2 and deleted by rule 22.
setPlanets [Planet "Krikkit"     Nothing,
                  Planet "Brontital"  Nothing,
                  Planet "Helicon"    Nothing,
                  Planet "Terminus"  Nothing,
                  Planet "Arrakis"     Nothing,
                  Planet "Caladan"   Nothing,
                  Planet "Hyperion" Nothing,
(...)

Nomyx/Library/Planets.hs
module Nomyx.Library.Planets where

import Prelude
import Nomyx.Language
import Control.Monad
import Data.Maybe

data Planet = Planet { name  :: String,
                       owner :: Maybe PlayerNumber}
                       deriving (Eq, Show)

planetAPI :: APICall () [Planet]
planetAPI = APICall "getPlanets"

setPlanets :: [Planet] -> Rule
setPlanets ps = void $ onAPICall planetAPI (const $ return ps) where 

displayPlanets :: Rule
displayPlanets = void $ outputAll $ do
   planets <- callAPIBlocking planetAPI ()
   s <- concatMapM showPlanet planets
   return s

showPlanet :: Planet -> Nomex String
showPlanet (Planet planetName (Just pn)) = do
   playerName <- getPlayerName pn
   return $ "Planet " ++ planetName ++ ": ruled by player " ++ (fromJust playerName) ++ "\n"
showPlanet (Planet planetName Nothing) = return $ "Planet " ++ planetName ++ ": free planet\n"
  
No group victory
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.

authored by Kau

This rule was proposed by player agrafix and activated by rule 2.
noGroupVictory

Nomyx/Library/Victory.hs
{-# 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


Free Money For All!
Free Money For All!

authored by Kau

This rule was proposed by player jcmincke and deleted by rule 2.
moneyForAll 101

Nomyx/Library/Bank.hs
 {-# 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 wins X Ecu if a rule proposed is accepted
moneyForAll :: Int -> Rule
moneyForAll money = do
---  pls <- liftEvent getAllPlayerNumbers
  void $ onEvent_ (ruleEvent Activated) $ \rule -> do
    void $ forEachPlayer_ (\pn -> do
        void $ modifyValueOfPlayer pn accounts (+money)
        return ()
       )
  return () 
Money transfer
a player can transfer money to another player

authored by Kau

This rule was proposed by player agrafix and activated by rule 2.
You received 1 ecu(s) from player 72
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
(...)

Nomyx/Library/Bank.hs
 {-# 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")
Bank accounts
Free Money For All!

authored by Kau

This rule was proposed by player jcmincke and deleted by rule 2.
moneyForAll 100

Nomyx/Library/Bank.hs
 {-# 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 wins X Ecu if a rule proposed is accepted
moneyForAll :: Int -> Rule
moneyForAll money = do
---  pls <- liftEvent getAllPlayerNumbers
  void $ onEvent_ (ruleEvent Activated) $ \rule -> do
    void $ forEachPlayer_ (\pn -> do
        void $ modifyValueOfPlayer pn accounts (+money)
        return ()
       )
  return () 
Bank accounts
Free Money For All!

authored by Kau

This rule was proposed by player jcmincke and activated by rule 2.
moneyForAll 100

Nomyx/Library/Bank.hs
 {-# 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 wins X Ecu if a rule proposed is accepted
moneyForAll :: Int -> Rule
moneyForAll money = do
---  pls <- liftEvent getAllPlayerNumbers
  void $ onEvent_ (ruleEvent Activated) $ \rule -> do
    void $ forEachPlayer_ (\pn -> do
        void $ modifyValueOfPlayer pn accounts (+money)
        return ()
       )
  return () 
Display accounts
Display all bank accounts

authored by Kau

This rule was proposed by player quchen and activated by rule 2.
Accounts:
secretsnail9	0
jcmincke	3800
kau2	3801
nomeata	3900
King mhbr	4000
agrafix	609
quchen	7090


displayBankAccounts

Nomyx/Library/Bank.hs
 {-# 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")
revolution: Remove the King
Revolution! Remove the king!

authored by Kau

This rule was proposed by player King mhbr and deleted by rule 2.
revolution 70

Nomyx/Library/Monarchy.hs
-- | 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

Bank services
Activate bank services

authored by Kau

This rule was proposed by player agrafix and activated by rule 2.
bankServices

Nomyx/Library/Bank.hs
 {-# 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")
Bravo button
display a button and greets you when pressed (for player 1)

authored by Kau

This rule was proposed by player agrafix and activated by rule 2.
void $ onInputButton_ "Click here:" (const $ outputAll_ "Bravo!") 1

Nomyx/Library/Examples.hs
{-# 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
Bank accounts
Free Money For All!

authored by Kau

This rule was proposed by player jcmincke and activated by rule 2.
moneyForAll 100

Nomyx/Library/Bank.hs
 {-# 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 wins X Ecu if a rule proposed is accepted
moneyForAll :: Int -> Rule
moneyForAll money = do
---  pls <- liftEvent getAllPlayerNumbers
  void $ onEvent_ (ruleEvent Activated) $ \rule -> do
    void $ forEachPlayer_ (\pn -> do
        void $ modifyValueOfPlayer pn accounts (+money)
        return ()
       )
  return () 
100 ECU wins
You win if you have 100 ECU on your bank account.

authored by Kau

This rule was proposed by player King mhbr and deleted by rule 2.
victoryXEcu 100

Nomyx/Library/Victory.hs
{-# 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


Bank accounts
Free Money For All!

authored by Kau

This rule was proposed by player jcmincke and activated by rule 2.
moneyForAll 100

Nomyx/Library/Bank.hs
 {-# 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 wins X Ecu if a rule proposed is accepted
moneyForAll :: Int -> Rule
moneyForAll money = do
---  pls <- liftEvent getAllPlayerNumbers
  void $ onEvent_ (ruleEvent Activated) $ \rule -> do
    void $ forEachPlayer_ (\pn -> do
        void $ modifyValueOfPlayer pn accounts (+money)
        return ()
       )
  return () 
Hello World
A rule that says hello to all players

authored by Kau

This rule was proposed by player nomeata and activated by rule 2.
outputAll_ "hello, world!"

Nomyx/Library/Examples.hs
{-# 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 = giveVictory 73 >> 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
Bank accounts
Create a bank account for each players

authored by Kau

This rule was proposed by player agrafix and activated by rule 2.
createBankAccounts

Nomyx/Library/Bank.hs
 {-# 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")
Monarchy
Monarchy: only the king decides which rules to accept or reject (change the 1 with the player number)

authored by Kau

This rule was proposed by player King mhbr and deleted by rule 2.
monarchy 1

Nomyx/Library/Monarchy.hs
-- | 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

Delete rule
Delete rule number one and then deletes itself

authored by Kau

This rule was proposed by player nomeata and deleted by rule 4.
suppressRule_ 1 >> autoDelete

Nomyx/Library/Examples.hs
{-# 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
Need a King?
Need a King?

authored by Kau

This rule was proposed by player King mhbr and deleted by rule 2.
makeKing 70

Nomyx/Library/Monarchy.hs
-- | 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

Majority vote
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.

authored by Kau

This rule was proposed by player nomeata and activated by rule 1.
onRuleProposed $ callVoteRule (majority `withQuorum` 2) oneDay

Nomyx/Library/Vote.hs
Nomyx/Library/Democracy.hs
{-# 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,
                             vbPlayers     :: [PlayerNumber]}
                             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)
   pns <- getAllPlayerNumbers
   sendMessage voteBegin (VoteBegin ri endTime en pns)

-- | 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
   onEventOnce (voteWith endTime assess name rn) 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 -> RuleNumber-> Event [(PlayerNumber, Maybe Bool)]
voteWith timeLimit assess name rn = do
   pns <- liftEvent getAllPlayerNumbers
   let voteEvents = map (singleVote name rn) 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 -> RuleNumber -> PlayerNumber -> Event Bool
singleVote name rn pn = inputRadio pn title [(True, "For"), (False, "Against")] where
   title = "Vote for rule: \"" ++ name ++ "\" (#" ++ (show rn) ++ "):"

-- | 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 (RuleInfo rn _ _ _ _ _ (RuleTemplate name _ _ _ _ _ _)) endTime en pns) = void $ outputAll $ do
   isa <- isEventActive en
   if isa
     then do
        ers <- mapM (\pn -> getEventResult en (singleVote name rn pn)) pns
        showOnGoingVote (zip pns ers) rn endTime
     else return ""

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

AutoActivate
Any proposed rule will be automatically activated, without any vote

authored by Kau

This rule was proposed by System and deleted by rule 4.
autoActivate