module Examples where
import Language.Nomyx.Rule
import Language.Nomyx.Expression
import Data.Function
import System.Locale (defaultTimeLocale, rfc822DateFormat)
import qualified Data.Time.Clock as T
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"
accounts :: String
accounts = "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) $ mapM_ (selPlayer pls) 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 >> return ()
voteWithMajority :: RuleFunc
voteWithMajority = VoidRule $ do
suppressRule 2
addRuleParams_ "vote with majority" (vote majority) "vote majority" 2 "meta-rule: return true if a majority of players vote positively for a new rule"
activateRule_ 2
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
suppressRule 2
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
displayTime :: RuleFunc
displayTime = VoidRule $ do
t <- getCurrentTime
onEventOnce_ (Time (T.addUTCTime 5 t)) $ \(TimeData t) -> outputAll $ show t
onePlayerVictory :: RuleFunc
onePlayerVictory = VoidRule $ onEvent_ Victory $ \(VictoryData ps) -> when (length ps >1) $ setVictory []