Delete rule
Delete rule number one and then deletes itself

authored by Kau

This rule was proposed by player iceclimb and deleted by rule 2.
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
Delete rule
Delete rule number one and then deletes itself

authored by Kau

This rule was proposed by player iceclimb and deleted by rule 2.
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
Delete rule
Delete rule number one and then deletes itself

authored by Kau

This rule was proposed by player iceclimb and deleted by rule 5.
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
Enter Haiku
display a field where you can enter a poem

authored by Kau

This rule was proposed by player iceclimb and activated by rule 1.
void $ onInputTextarea_ "Enter a haiku:" outputAll_ 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
I win
You win. That's it, if this rule is accepted you win the game. Good luck on having this accepted by other players ;)

authored by Kau

This rule was proposed by player 78 and deleted by rule 2.
iWin

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


Unanimity vote
A unanimity vote: all players need to vote "yes" for a new rule to be accepted.

authored by Kau

This rule was proposed by player 77 and activated by rule 1.
onRuleProposed $ callVoteRule unanimity 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 5.
autoActivate