module Language.Nomyx.Examples(nothing, helloWorld, accounts, createBankAccount, winXEcuPerDay, winXEcuOnRuleAccepted, moneyTransfer,
delRule, voteWithMajority, king, makeKing, monarchy, revolution, victoryXRules, victoryXEcu, displayTime, noGroupVictory, iWin,
module Data.Time.Recurrence, module Control.Monad, module Data.List, module Data.Time.Clock) where
import Language.Nomyx.Rule
import Language.Nomyx.Expression
import Data.Function
import System.Locale (defaultTimeLocale, rfc822DateFormat)
import Data.Time.Clock hiding (getCurrentTime)
import Data.Time.Recurrence hiding (filter)
import Control.Arrow
import Data.List
import Debug.Trace
import Control.Monad
nothing :: RuleFunc
nothing = VoidRule $ return ()
helloWorld :: RuleFunc
helloWorld = VoidRule $ outputAll "hello, world!"
accounts :: V [(PlayerNumber, Int)]
accounts = V "Accounts"
createBankAccount :: RuleFunc
createBankAccount = VoidRule $ createValueForEachPlayer_ accounts
winXEcuPerDay :: Int -> RuleFunc
winXEcuPerDay x = VoidRule $ schedule_ (recur daily) $ modifyAllValues accounts (+x)
winXEcuOnRuleAccepted :: Int -> RuleFunc
winXEcuOnRuleAccepted x = VoidRule $ onEvent_ (RuleEv Activated) $ \(RuleData rule) -> modifyValueOfPlayer (rProposedBy rule) accounts (+x)
moneyTransfer :: RuleFunc
moneyTransfer = VoidRule $ do
pls <- getAllPlayerNumbers
when (length pls >= 2) $ forEachPlayer_ (selPlayer pls) where
selPlayer pls src = onInputChoice_ "Transfer money to player: " (delete src $ sort pls) (selAmount src) src
selAmount src dst = onInputStringOnce_ ("Select Amount to transfert to player: " ++ show dst) (transfer src dst) src
transfer src dst amount = do
modifyValueOfPlayer dst accounts (+ (read amount))
modifyValueOfPlayer src accounts (\a -> a (read amount))
output ("You gave " ++ amount ++ " to " ++ show dst) src
output (show src ++ " gaved you " ++ amount ++ " Ecus") dst
delRule :: RuleNumber -> RuleFunc
delRule rn = VoidRule $ suppressRule rn >> autoDelete
voteWithMajority :: RuleFunc
voteWithMajority = VoidRule $ do
suppressRule 1
addRuleParams_ "vote with majority" (onRuleProposed $ voteWith majority) "onProposedRule $ voteWith majority" 2 "meta-rule: return true if a majority of players vote positively for a new rule"
activateRule_ 1
autoDelete
makeKing :: PlayerNumber -> RuleFunc
makeKing pn = VoidRule $ newVar_ "King" pn >> return ()
king :: V PlayerNumber
king = V "King"
monarchy :: RuleFunc
monarchy = VoidRule $ onEvent_ (RuleEv Proposed) $ \(RuleData rule) -> do
k <- readVar_ king
onInputChoiceEnumOnce_ ("Your Royal Highness, do you accept rule " ++ (show $ rNumber rule) ++ "?") True (activateOrReject rule) k
revolution :: PlayerNumber -> RuleFunc
revolution player = VoidRule $ do
suppressRule 1
voidRule $ makeKing player
addRuleParams_ "Monarchy" monarchy "monarchy" 1 "Monarchy: only the king can vote on new rules"
activateRule_ 1
--autoDelete
victoryXRules :: Int -> RuleFunc
victoryXRules x = VoidRule $ onEvent_ (RuleEv Activated) $ \_ -> do
rs <- getActiveRules
let counts = map (rProposedBy . head &&& length) $ groupBy ((==) `on` rProposedBy) rs
let victorious = map fst $ filter ((>= x) . snd) counts
when (length victorious /= 0) $ setVictory victorious
victoryXEcu :: Int -> RuleFunc
victoryXEcu x = VoidRule $ onEvent_ (RuleEv Activated) $ \_ -> do
as <- readVar_ accounts
let victorious = map fst $ filter ((>= x) . snd) as
if (length victorious /= 0) then setVictory victorious else return ()
displayTime :: RuleFunc
displayTime = VoidRule $ do
t <- getCurrentTime
onEventOnce_ (Time $ addUTCTime 5 t) $ \(TimeData t) -> outputAll $ show t
noGroupVictory :: RuleFunc
noGroupVictory = VoidRule $ onEvent_ Victory $ \(VictoryData ps) -> when (length ps >1) $ setVictory []
iWin :: RuleFunc
iWin = VoidRule $ getSelfProposedByPlayer >>= giveVictory