Display planets 2
Better version to display the planets

authored by Kau

This rule was proposed by player kau2 and activated by rule 2.
Planet Krikkit: ruled by player kau2
Planet Brontital: ruled by player Cogito
Planet Helicon: free planet
Planet Terminus: free planet
Planet Arrakis: ruled by player polux
Planet Caladan: free planet
Planet Hyperion: free planet
Planet Arda: free planet
Planet Zorg: free planet

do
  suppressRule_ 23
  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 claim
Three planets are now occupied

authored by Kau

This rule was proposed by player kau2 and activated by rule 2.
do
  suppressRule_ 22
  setPlanets [Planet "Krikkit"     (Just 2), --Kau2
                    Planet "Brontital"  (Just 27), --Cogito
                    Planet "Helicon"    Nothing,
                    Planet "Terminus"  Nothing,
                    Planet "Arrakis"     (Just 4), --Polux
(...)

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

import Prelude
import Nomyx.Language
import Control.Monad

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 ()
   return $ concatMap showPlanet planets

showPlanet :: Planet -> String
showPlanet (Planet name (Just a)) = "Planet " ++ name ++ ": ruled by player " ++ (show a) ++ "\n"
showPlanet (Planet name Nothing) = "Planet " ++ name ++ ": free planet\n"
  
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 (mmo: True, Wizek: True, polux: True, kau2: True)
Vote finished for rule #25, passed: True (Wizek: False, polux: True, kau2: True)
Vote finished for rule #26, passed: True (Wizek: True, polux: True, kau2: 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

Display planets
Display the planets

authored by Kau

This rule was proposed by player kau2 and deleted by rule 26.
displayPlanets

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

import Prelude
import Nomyx.Language
import Control.Monad

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 ()
   return $ concatMap showPlanet planets

showPlanet :: Planet -> String
showPlanet (Planet name (Just a)) = "Planet " ++ name ++ ": ruled by player " ++ (show a) ++ "\n"
showPlanet (Planet name Nothing) = "Planet " ++ name ++ ": free planet\n"
  
Planets
Several planets appears on your radar!

authored by Kau

This rule was proposed by player kau2 and deleted by rule 25.
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

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 ()
   return $ concatMap showPlanet planets

showPlanet :: Planet -> String
showPlanet (Planet name (Just a)) = "Planet " ++ name ++ ": ruled by player " ++ (show a) ++ "\n"
showPlanet (Planet name Nothing) = "Planet " ++ name ++ ": free planet\n"
  
Bank services
Activate bank services

authored by Kau

This rule was proposed by player kau2 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")
Delete pending rule 19
Delete rule 19

authored by Kau

This rule was proposed by player kau2 and deleted by rule 20.
suppressRule_ 19 >> 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
Let's see how the game handles `bottom`. ;)
Let's see how the game handles `bottom`. ;)

authored by Kau

This rule was proposed by player Wizek and deleted by rule 20.
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 = 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
Delete rule 16: Display current time
polux wants to delete rule 16 because: not really useful

authored by System

This rule was proposed by player polux and deleted by rule 18.
suppressRule_ 16 >> autoDelete

Delete rule 14: Display activation time
polux wants to delete rule 14 because: It is not really useful

authored by System

This rule was proposed by player polux and deleted by rule 17.
suppressRule_ 14 >> autoDelete

Display current time
Will display the current time (when refreshing the screen)

authored by Kau

This rule was proposed by player wahrsagevogel and deleted by rule 18.
displayCurrentTime

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
Bravo button
display a button and greets you when pressed (for player 1)

authored by Kau

This rule was proposed by player Cogito 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
Display activation time
will display the time at which the rule as been activate

authored by Kau

This rule was proposed by player wahrsagevogel and deleted by rule 17.
displayActivateTime

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
8 rules victory
You win if you have 8 rules accepted.

authored by Kau

This rule was proposed by player kau2 and deleted by rule 2.
victoryXRules 8

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


Rule Deletion Proposals
Display radio buttons for chosing a rule to be proposed for deletion

authored by polux

This rule was proposed by player polux and activated by rule 2.
ruleDeletionProposals

Nomyx/Library/RuleDeletion.hs
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DoAndIfThenElse #-}

-- | This file gives a list of example rules that the players can submit.
module Nomyx.Library.RuleDeletion where

import Prelude
import Control.Monad as X
import Nomyx.Language
import Data.Maybe (fromJust)
import Data.List ((\\))

type Reason = String

askRuleNumber :: PlayerNumber -> Event (RuleNumber, Reason)
askRuleNumber player = do
  activeRules <- liftEvent getActiveRules
  rule <-
    inputRadio
      player
      "Select rule to propose for deletion: "
      (choices activeRules)
  reason <- inputText player "Specify reason for deleting the rule: "
  return (rule, reason)
  where
    choices rules = map choice rules
    choice rule =
      let num = _rNumber rule
          repr = "(" ++ show num ++ ") " ++ _rName (_rRuleTemplate rule)
      in (num, repr)

proposeRule' :: PlayerNumber
             -> RuleName
             -> Rule
             -> RuleCode
             -> String
             -> Nomex RuleNumber
proposeRule' player name rule code desc = do
  rns <- map _rNumber <$> getRules
  let number = head $ [1 ..] \\ rns
  res <- proposeRule (ruleInfo number)
  return $
    if res
      then number
      else error "proposeRule': cannot propose rule"
  where
    ruleInfo number =
      RuleInfo
      { _rNumber = number
      , _rProposedBy = player
      , _rRule = rule
      , _rStatus = Pending
      , _rAssessedBy = Nothing
      , _rModules = []
      , _rRuleTemplate = ruleTemplate
      }
    ruleTemplate =
      RuleTemplate
      { _rName = name
      , _rDescription = desc
      , _rRuleCode = code
      , _rAuthor = "System"
      , _rPicture = Nothing
      , _rCategory = []
      , _rDeclarations = []
      }

proposeRuleForDeletion :: PlayerNumber -> (RuleNumber, Reason) -> Nomex ()
proposeRuleForDeletion player (ruleNumber, reason) =
  void $
  do ruleName <- _rName . _rRuleTemplate . fromJust <$> getRule ruleNumber
     playerName <- fromJust <$> getPlayerName player
     proposeRule' player (name ruleName) ruleToCreate code (desc playerName)
  where
    name ruleName = "Delete rule " ++ show ruleNumber ++ ": " ++ ruleName
    ruleToCreate = suppressRule_ ruleNumber >> autoDelete
    code = "suppressRule_ " ++ show ruleNumber ++ " >> autoDelete"
    desc playerName =
      playerName ++
      " wants to delete rule " ++ show ruleNumber ++ " because: " ++ reason

ruleDeletionProposals :: Rule
ruleDeletionProposals = do
  void $ forEachPlayer action (const (return ())) (const (return ()))
  where
    action player =
      void $ onEvent_ (askRuleNumber player) (proposeRuleForDeletion player)
make King
Make a player King (change the 1 with the player number that becomes King)

authored by Kau

This rule was proposed by player bozaloshtsh and deleted by rule 2.
makeKing 23

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

Display accounts
Display all bank accounts

authored by Kau

This rule was proposed by player kau2 and activated by rule 2.
Accounts:
Radvendii	0
BalinKingOfMoria	0
a	0
ihm	0
Salutlolo	0
-Mat-	0
chris	0
iqubic	0
mmo	0
sschles	0
cutangle	0
Wizek	100
Cogito	0
wahrsagevogel	200
bozaloshtsh	0
polux	410
kau2	990


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")
Money transfer
a player can transfer money to another player

authored by Kau

This rule was proposed by player kau2 and activated by rule 2.
moneyTransfer

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")
Bonus rule accepted
a player wins 100 Ecu if a rule proposed is accepted

authored by Kau

This rule was proposed by player polux and activated 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")
Money transfer
a player can transfer money to another player

authored by Kau

This rule was proposed by player polux and deleted by rule 2.
moneyTransfer

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")
Display accounts
Display all bank accounts

authored by Kau

This rule was proposed by player polux and deleted by rule 2.
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")
Display accounts
Display all bank accounts

authored by Kau

This rule was proposed by player polux and deleted by rule 2.
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")
Bank accounts
Create a bank account for each players

authored by Kau

This rule was proposed by player polux 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")
Delete rule
Delete rule number one and then deletes itself

authored by Kau

This rule was proposed by player kau2 and deleted by rule 3.
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
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 kau2 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 3.
autoActivate