packages feed

Nomyx-Rules 0.0.3 → 0.1.0

raw patch · 8 files changed

+531/−452 lines, 8 files

Files

Nomyx-Rules.cabal view
@@ -1,6 +1,8 @@ name: Nomyx-Rules-version: 0.0.3+version: 0.1.0 cabal-version: >=1.6+--Warning: For using cabal sdist, this patch is needed in cabal: https://github.com/haskell/cabal/pull/1110+--To allow sdist to work with exported generated modules (Paths_Nomyx_Rules) build-type: Simple license: BSD3 license-file: LICENSE@@ -11,19 +13,20 @@ description: Provide a DSL to express rules for a Nomic game, with evaluation engine. See package Nomyx for a full game implementation. category: Language author: Corentin Dupont-data-files: examples/Examples.hs src/Language/Nomyx/Evaluation.hs+data-files: src/Language/Nomyx/Examples.hs src/Language/Nomyx/Evaluation.hs             src/Language/Nomyx/Expression.hs src/Language/Nomyx/Rule.hs-            tests/Test.hs+            src/Language/Nomyx/Test.hs data-dir: ""-extra-source-files: examples/Examples.hs tests/Test.hs, AUTHORS, README+extra-source-files: AUTHORS README   library     build-depends: base ==4.*, containers -any, ghc -any,                    hint-server -any, hslogger -any, mtl -any, old-locale -any,                    safe -any, stm -any, time -any, time-recurrence -any-    exposed-modules: Examples Language.Nomyx.Evaluation-                     Language.Nomyx.Expression Language.Nomyx.Rule Test Paths_Nomyx_Rules+    exposed-modules: Language.Nomyx.Examples Language.Nomyx.Evaluation+                     Language.Nomyx.Expression Language.Nomyx.Rule Language.Nomyx.Test+                     Paths_Nomyx_Rules     exposed: True     buildable: True-    hs-source-dirs: examples src tests- +    hs-source-dirs: src+    other-modules:
− examples/Examples.hs 
@@ -1,114 +0,0 @@-{-# LANGUAGE TupleSections, GADTs #-}---- | 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.---Don't hesitate to get inspiration from there and create your own rules!-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---- | A rule that does nothing-nothing :: RuleFunc-nothing = VoidRule $ return ()---- | A rule that says hello to all players-helloWorld :: RuleFunc-helloWorld = VoidRule $ outputAll "hello"---- | account variable name-accounts :: String-accounts = "Accounts"---- | Create a bank account for each players-createBankAccount :: RuleFunc-createBankAccount = VoidRule $ createValueForEachPlayer_ accounts---- | each player wins X Ecu each day--- you can also try with "minutly", "monthly" as recurrences and everything in time-recurrence-winXEcuPerDay :: Int -> RuleFunc-winXEcuPerDay x = VoidRule $ schedule_ (recur daily) $ modifyAllValues accounts (+x)---- | a player wins X Ecu if a rule proposed is accepted-winXEcuOnRuleAccepted :: Int -> RuleFunc-winXEcuOnRuleAccepted x = VoidRule $ onEvent_ (RuleEv Activated) $ \(RuleData rule) -> modifyValueOfPlayer (rProposedBy rule) accounts (+x)---- | a player can transfer money to another player-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----- | delete a rule-delRule :: RuleNumber -> RuleFunc-delRule rn = VoidRule $ suppressRule rn >> return ()---- | Change unanimity vote (usually rule 2) to absolute majority (half participants plus one)-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----- | player pn is the king-makeKing :: PlayerNumber -> RuleFunc-makeKing pn = VoidRule $ newVar_ "King" pn >> return ()--king :: V PlayerNumber-king = (V "King")---- | Monarchy: only the king decides which rules to accept or reject-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! Hail to the king!--- This rule suppresses the democracy (usually rules 1 and 2), installs the king and activates monarchy.-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---- | set the victory for players having more than X accepted rules-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---- | will display the time to all players in 5 seconds-displayTime :: RuleFunc-displayTime = VoidRule $ do-    t <- getCurrentTime-    onEventOnce_ (Time (T.addUTCTime 5 t)) $ \(TimeData t) -> outputAll $ show t---- | Only one player can achieve victory: No group victory.--- Forbidding group victory usually becomes necessary when lowering the number of players voting:--- a coalition of players could simply force a "victory" rule and win the game.-onePlayerVictory ::  RuleFunc-onePlayerVictory = VoidRule $ onEvent_ Victory $ \(VictoryData ps) -> when (length ps >1) $ setVictory []
src/Language/Nomyx/Evaluation.hs view
@@ -13,9 +13,9 @@ import Data.Function import Data.Time import Debug.Trace-import Unsafe.Coerce  -- | evaluate an expression.+-- The rule number passed is the number of the rule containing the expression. evalExp :: Exp a -> RuleNumber -> State Game a evalExp (NewVar name def) rn = do     vars <- gets variables@@ -78,6 +78,8 @@  evalExp (Output pn string) rn = outputS pn string >> return () evalExp (ProposeRule rule) _ = evProposeRule rule++-- | activates (execute) a rule evalExp (ActivateRule rule) rn = evActivateRule rule rn evalExp (RejectRule rule) rn = evRejectRule rule rn evalExp (AddRule rule) _ = evAddRule rule@@ -110,7 +112,7 @@     mapM_ f filtered where         f (EH {ruleNumber, eventNumber, handler}) = case cast handler of             Just castedH -> do-                traceState ("event found " ++ (show e))+                --traceState ("event found " ++ (show e))                 evalExp (castedH (eventNumber, dat)) ruleNumber             Nothing -> outputS 1 ("failed " ++ (show $ typeOf handler)) @@ -237,8 +239,7 @@ evInputChoice ic d = triggerEvent ic (InputChoiceData d)  evTriggerTime :: UTCTime -> State Game ()-evTriggerTime t = do-    triggerEvent (Time t) (TimeData t)+evTriggerTime t = triggerEvent (Time t) (TimeData t)   --delete all variables of a rule@@ -253,12 +254,7 @@     evs <- gets events     modify (\g -> g { events = filter (\(EH {ruleNumber = myrn}) -> myrn /= rn) evs}) --- | Replaces all instances of a value in a list by another value.-replaceWith :: (a -> Bool)   -- ^ Value to search-        -> a   -- ^ Value to replace it with-        -> [a] -- ^ Input list-        -> [a] -- ^ Output list-replaceWith f y = map (\z -> if f z then y else z)+  traceState :: String -> State s String traceState x = state (\s -> trace ("trace: " ++ x) (x, s))
+ src/Language/Nomyx/Examples.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE TupleSections, GADTs #-}++-- | 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.+--Don't hesitate to get inspiration from there and create your own rules!+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++-- | A rule that does nothing+nothing :: RuleFunc+nothing = VoidRule $ return ()++-- | A rule that says hello to all players+helloWorld :: RuleFunc+helloWorld = VoidRule $ outputAll "hello, world!"++-- | account variable name and type+accounts :: V [(PlayerNumber, Int)]+accounts = V "Accounts"++-- | Create a bank account for each players+createBankAccount :: RuleFunc+createBankAccount = VoidRule $ createValueForEachPlayer_ accounts++-- | 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 -> RuleFunc+winXEcuPerDay x = VoidRule $ schedule_ (recur daily) $ modifyAllValues accounts (+x)++-- | a player wins X Ecu if a rule proposed is accepted+winXEcuOnRuleAccepted :: Int -> RuleFunc+winXEcuOnRuleAccepted x = VoidRule $ onEvent_ (RuleEv Activated) $ \(RuleData rule) -> modifyValueOfPlayer (rProposedBy rule) accounts (+x)++-- | a player can transfer money to another player+-- it does not accept new players or check if balance is positive, to keep the example simple+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+++-- | delete a rule+delRule :: RuleNumber -> RuleFunc+delRule rn = VoidRule $ suppressRule rn >> autoDelete++-- | Change unanimity vote (usually rule 2) to absolute majority (half participants plus one)+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+++-- | player pn is the king+makeKing :: PlayerNumber -> RuleFunc+makeKing pn = VoidRule $ newVar_ "King" pn >> return ()++king :: V PlayerNumber+king = V "King"++-- | Monarchy: only the king decides which rules to accept or reject+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! Hail to the king!+-- This rule suppresses the democracy (usually rules 1 and 2), installs the king and activates monarchy.+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++-- | set the victory for players having more than X accepted rules+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 ()++-- | will display the time to all players in 5 seconds+displayTime :: RuleFunc+displayTime = VoidRule $ do+    t <- getCurrentTime+    onEventOnce_ (Time $ addUTCTime 5 t) $ \(TimeData t) -> outputAll $ show t++-- | 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 ::  RuleFunc+noGroupVictory = VoidRule $ onEvent_ Victory $ \(VictoryData ps) -> when (length ps >1) $ setVictory []++-- | Rule that state that you win. Good luck on having this accepted by other players ;)+iWin :: RuleFunc+iWin = VoidRule $ getSelfProposedByPlayer >>= giveVictory+++
src/Language/Nomyx/Expression.hs view
@@ -16,14 +16,15 @@ import Control.Concurrent.STM
 import Language.Haskell.Interpreter.Server
 import Data.Time
-
+ type PlayerNumber = Int
 type PlayerName = String
 type RuleNumber = Int
 type RuleName = String
 type RuleText = String
 type RuleCode = String
-type EventNumber = Int
+type EventNumber = Int+type EventName = String
 type VarName = String
 type GameName = String
 type Code = String
@@ -59,12 +60,16 @@ 
 instance Monad Exp where
    return = Const
-   (>>=) = Bind
+   (>>=) = Bind+   
+instance Functor Exp where+  fmap f e = Bind e $ Const . f+ 
 -- * Variables
 
 -- | a container for a variable name and type
-data V a = V String
+data V a = V {varName :: String} deriving (Typeable)
 
 -- | stores the variable's data
 data Var = forall a . (Typeable a, Show a, Eq a) =>
@@ -105,13 +110,13 @@ 
 -- | data associated with each events
 data EventData a where
-    PlayerData      :: {playerData :: PlayerInfo}    -> EventData Player
-    RuleData        :: {ruleData :: Rule}            -> EventData RuleEvent
-    TimeData        :: {timeData :: UTCTime}         -> EventData Time
-    MessageData     :: (Show m) => {messageData :: m}            -> EventData (Message m)
-    InputChoiceData :: (Show c) => {inputChoiceData :: c}        -> EventData (InputChoice c)
-    InputStringData :: {inputStringData :: String}   -> EventData InputString
-    VictoryData     :: {victoryData :: [PlayerInfo]} -> EventData Victory
+    PlayerData      :: {playerData :: PlayerInfo}         -> EventData Player
+    RuleData        :: {ruleData :: Rule}                 -> EventData RuleEvent
+    TimeData        :: {timeData :: UTCTime}              -> EventData Time
+    MessageData     :: (Show m) => {messageData :: m}     -> EventData (Message m)
+    InputChoiceData :: (Show c) => {inputChoiceData :: c} -> EventData (InputChoice c)
+    InputStringData :: {inputStringData :: String}        -> EventData InputString
+    VictoryData     :: {victoryData :: [PlayerInfo]}      -> EventData Victory
 
 deriving instance Typeable1 EventData
 deriving instance Typeable1 Event
@@ -133,12 +138,13 @@ data EventHandler where
     EH :: (Typeable e, Show e, Eq e) =>
         {eventNumber :: EventNumber,
-         ruleNumber  :: RuleNumber,
+         ruleNumber  :: RuleNumber,+         --eventName   :: EventName,
          event       :: Event e,
          handler     :: (EventNumber, EventData e) -> Exp ()} -> EventHandler
 
 instance Show EventHandler where
-    show (EH en rn e _) = (show en) ++ " " ++ (show rn) ++ " (" ++ (show e) ++")"
+    show (EH en rn e _) = (show en) ++ " " ++ " " ++ (show rn) ++ " (" ++ (show e) ++")"
  instance Eq EventHandler where     (EH {eventNumber=e1}) == (EH {eventNumber=e2}) = e1 == e2@@ -151,13 +157,13 @@ -- | type of rule to assess the legality of a given parameter
 type OneParamRule a = a -> Exp RuleResponse
 
+-- | type of rule that just mofify the game state
+type NoParamRule = Exp ()+
 -- | a rule can assess the legality either immediatly of later through a messsage
 data RuleResponse = BoolResp {boolResp :: Bool}
                   | MsgResp  {msgResp :: Event (Message Bool)}
 
--- | type of rule that just mofify the game state
-type NoParamRule = Exp ()
-
 -- | the different types of rules
 data RuleFunc =
       RuleRule   {ruleRule   :: OneParamRule Rule}
@@ -165,9 +171,8 @@     | VoidRule   {voidRule   :: NoParamRule} deriving (Typeable)
 
 instance Show RuleFunc where
-    show _ = "RuleFunc"
-
-
+    show _ = "RuleFunc"+    
 -- | An informationnal structure about a rule:
 data Rule = Rule { rNumber       :: RuleNumber,       -- number of the rule (must be unique) TO CHECK
                    rName         :: RuleName,         -- short name of the rule 
@@ -201,7 +206,8 @@ -- * Game
            
 -- | The state of the game:
-data Game = Game { gameName      :: GameName,
+data Game = Game { gameName      :: GameName,+                   gameDesc      :: String,
                    rules         :: [Rule],
                    players       :: [PlayerInfo],
                    variables     :: [Var],
@@ -215,11 +221,23 @@     show (Game { gameName, rules, players, variables, events, outputs, victory}) =
         "Game Name = " ++ (show gameName) ++ "\n Rules = " ++ (concat $ intersperse "\n " $ map show rules) ++ "\n Players = " ++ (show players) ++ "\n Variables = " ++
         (show variables) ++ "\n Events = " ++ (show events) ++ "\n Outputs = " ++ (show outputs) ++ "\n Victory = " ++ (show victory)
-
++instance Eq Game where+   (Game {gameName=gn1}) == (Game {gameName=gn2}) = gn1 == gn2++instance Ord Game where+   compare (Game {gameName=gn1}) (Game {gameName=gn2}) = compare gn1 gn2+   
 
 -- | an equality that tests also the types.
 (===) :: (Typeable a, Typeable b, Eq b) => a -> b -> Bool
 (===) x y = cast x == Just y
-
++-- | Replaces all instances of a value in a list by another value.+replaceWith :: (a -> Bool)   -- ^ Value to search+        -> a   -- ^ Value to replace it with+        -> [a] -- ^ Input list+        -> [a] -- ^ Output list+replaceWith f y = map (\z -> if f z then y else z)
src/Language/Nomyx/Rule.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, GADTs, ScopedTypeVariables, TupleSections#-}
+{-# LANGUAGE DeriveDataTypeable, GADTs, ScopedTypeVariables, TupleSections, TemplateHaskell#-}
 
 -- | All the building blocks to build rules and basic rules examples.
 module Language.Nomyx.Rule where
@@ -16,7 +16,9 @@ import Control.Arrow
 import Data.Time.Recurrence hiding (filter) import Safe+import Control.Applicative + -- * Variables
 -- | variable creation
 newVar :: (Typeable a, Show a, Eq a) => VarName -> a -> Exp (Maybe (V a))
@@ -38,7 +40,7 @@     ma <- ReadVar v
     case ma of
         Just (val:: a) -> return val
-        Nothing -> error $ "readVar_: Variable " ++ a ++ " not existing"
+        Nothing -> error $ "readVar_: Variable \"" ++ a ++ "\" with type \"" ++ (show $ typeOf v) ++ "\" not existing"
 
 -- | variable writing
 writeVar :: (Typeable a, Show a, Eq a) => (V a) -> a -> Exp Bool
@@ -105,11 +107,11 @@ 
 -- | get the association array
 getArrayVarData :: (Ord i, Typeable a, Show a, Eq a, Typeable i, Show i) => (ArrayVar i a) -> Exp ([(i, Maybe a)])
-getArrayVarData (ArrayVar _ v) = readVar_ v >>= return . toList
+getArrayVarData (ArrayVar _ v) = toList <$> (readVar_ v)
 
 -- | get the association array with only the filled values
 getArrayVarData' :: (Ord i, Typeable a, Show a, Eq a, Typeable i, Show i) => (ArrayVar i a) -> Exp ([(i, a)])
-getArrayVarData' v = getArrayVarData v >>= return . catMaybes . map sndMaybe
+getArrayVarData' v = catMaybes . map sndMaybe <$> (getArrayVarData v)
 
 delArrayVar :: (Ord i, Typeable a, Show a, Eq a, Typeable i, Show i) => (ArrayVar i a) -> Exp ()
 delArrayVar (ArrayVar m v) = delAllEvents m >> delVar_ v
@@ -167,31 +169,39 @@ schedule :: (Schedule Freq) -> (UTCTime -> Exp ()) -> Exp () schedule sched f = do     now <- getCurrentTime-    let next = head $ drop 1 $ starting now $ sched-    onEventOnce_ (Time next) $ f' sched where
-    f' sched (TimeData t) = do-        let next = head $ drop 1 $ starting t $ sched
-        onEventOnce_ (Time next) $ f' sched
-        f t+    let next = head $ starting now $ sched+    if (next == now) then executeAndScheduleNext (f . timeData) sched (TimeData now)+                     else onEventOnce_ (Time next) $ executeAndScheduleNext (f . timeData) sched where
 +executeAndScheduleNext :: (EventData Time -> Exp ()) -> (Schedule Freq) -> (EventData Time) -> Exp ()+executeAndScheduleNext f sched now = do+   f now+   let rest = drop 1 $ starting (timeData now) $ sched+   when (rest /= []) $ onEventOnce_ (Time $ head rest) $ executeAndScheduleNext f sched
++ schedule_ :: (Schedule Freq) -> Exp () -> Exp ()
 schedule_ ts f = schedule ts (\_-> f)  --at each time provided, the supplied function will be called
 schedule' :: [UTCTime] -> (UTCTime -> Exp ()) -> Exp ()
 schedule' sched f = do+    let sched' = sort sched     now <- getCurrentTime-    let nextMay = headMay $ filter (>now) $ sched+    let nextMay = headMay $ filter (>=now) $ sched'     case nextMay of-        Just next -> onEventOnce_ (Time next) $ f' sched+        Just next -> do+           if (next == now) then executeAndScheduleNext' (f . timeData) sched' (TimeData now)+                     else onEventOnce_ (Time next) $ executeAndScheduleNext' (f . timeData) sched'         Nothing -> return ()-        where
-            f' sched (TimeData t) = do-                let nextMay = headMay $ filter (>t) $ sched-                case nextMay of-                    Just next -> onEventOnce_ (Time next) $ f' sched-                    Nothing -> return () 
-                f t
+            
++executeAndScheduleNext' :: (EventData Time -> Exp ()) -> [UTCTime] -> (EventData Time) -> Exp ()+executeAndScheduleNext' f sched now = do+   f now+   let rest = drop 1 $ sched+   when (rest /= []) $ onEventOnce_ (Time $ head rest) $ executeAndScheduleNext' f sched+   
 
 schedule'_ :: [UTCTime] -> Exp () -> Exp ()
 schedule'_ ts f = schedule' ts (\_-> f)
@@ -328,21 +338,18 @@ 
 -- | Get the total number of players
 getPlayersNumber :: Exp Int
-getPlayersNumber = getPlayers >>= return . length
+getPlayersNumber = length <$> getPlayers
 
 getAllPlayerNumbers :: Exp [PlayerNumber]
-getAllPlayerNumbers = do
-   ps <- getPlayers
-   return $ map playerNumber ps
+getAllPlayerNumbers = map playerNumber <$> getPlayers
+
  -- | outputs a message to one player
 output :: String -> PlayerNumber -> Exp ()
 output s pn = Output pn s
 
 outputAll :: String -> Exp ()
-outputAll s = do
-    pls <- getPlayers
-    mapM_ ((output s) . playerNumber) pls+outputAll s = getPlayers >>= mapM_ ((output s) . playerNumber) 
 getCurrentTime :: Exp UTCTime
 getCurrentTime = CurrentTime
@@ -351,7 +358,14 @@ getSelfRuleNumber :: Exp RuleNumber getSelfRuleNumber = SelfRuleNumber +getSelfRule :: Exp Rule+getSelfRule  = do+   srn <- getSelfRuleNumber+   rs:[] <- getRulesByNumbers [srn]+   return rs +getSelfProposedByPlayer :: Exp PlayerNumber+getSelfProposedByPlayer = getSelfRule >>= return . rProposedBy 
 -- * Rule samples
 
@@ -359,6 +373,7 @@ autoActivate :: RuleFunc
 autoActivate = VoidRule $ onEvent_ (RuleEv Proposed) (activateRule_ . rNumber . ruleData)
 +-- | This rule will forbid any new rule to delete the rule in parameter immutableRule :: RuleNumber -> RuleFunc
 immutableRule rn = RuleRule f where
    f r = do
@@ -389,38 +404,42 @@             oks <- mapM (applyRule rule) rs
             when (and oks) $ activateRule_ $ rNumber rule
 
-
+applyRule :: Rule -> Rule -> Exp Bool
+applyRule (Rule {rRuleFunc = rf}) r = do
+    case rf of
+        RuleRule f1 -> f1 r >>= return . boolResp
+        otherwise -> return False++        
 -- | active metarules are automatically used to evaluate a given rule
-autoMetarules :: Rule -> Exp RuleResponse
-autoMetarules r = do
+checkWithMetarules :: Rule -> Exp RuleResponse
+checkWithMetarules r = do
     rs <- getActiveRules
-    let rrs = mapMaybe f rs
+    let rrs = mapMaybe maybeMetaRule rs
     evals <- mapM (\rr -> rr r) rrs
     andrrs evals
-    where
-        f Rule {rRuleFunc = (RuleRule r)} = Just r
-        f _ = Nothing
 
--- | any new rule will be activate if all active meta rules returns True
-applicationMetaRule :: RuleFunc
-applicationMetaRule = VoidRule $ onEvent_ (RuleEv Proposed) $ \(RuleData rule) -> do
-            r <- autoMetarules rule
-            case r of
-                BoolResp b -> activateOrReject rule b
-                MsgResp m -> onMessageOnce m $ (activateOrReject rule) . messageData
-            return ()
++maybeMetaRule :: Rule -> Maybe (OneParamRule Rule)+maybeMetaRule Rule {rRuleFunc = (RuleRule r)} = Just r
+maybeMetaRule _ = Nothing 
-applyRule :: Rule -> Rule -> Exp Bool
-applyRule (Rule {rRuleFunc = rf}) r = do
-    case rf of
-        RuleRule f1 -> f1 r >>= return . boolResp
-        otherwise -> return False
++-- | any new rule will be activate if all active meta rules returns True+onRuleProposed :: (Rule -> Exp RuleResponse) -> RuleFunc
+onRuleProposed r = VoidRule $ onEvent_ (RuleEv Proposed) $ \(RuleData rule) -> do
+    resp <- r rule+    case resp of
+        BoolResp b -> activateOrReject rule b
+        MsgResp m -> onMessageOnce m $ (activateOrReject rule) . messageData
+ 
+
 data ForAgainst = For | Against deriving (Typeable, Enum, Show, Eq, Bounded, Read)
 
 -- | rule that performs a vote for a rule on all players. The provided function is used to count the votes.
-vote :: ([(PlayerNumber, ForAgainst)] -> Bool) -> RuleFunc
-vote f = RuleRule $ \rule -> do
+voteWith :: ([(PlayerNumber, ForAgainst)] -> Bool) -> Rule -> Exp RuleResponse
+voteWith f rule = do
     pns <- getAllPlayerNumbers
     let rn = show $ rNumber rule
     let m = Message ("Unanimity for " ++ rn)
@@ -460,26 +479,42 @@         delArrayVar voteVar
         mapM_ delEvent ics
     return $ MsgResp m
-
++-- | perform an action for each current players, new players and leaving players
+forEachPlayer :: (PlayerNumber -> Exp ()) -> (PlayerNumber -> Exp ()) -> (PlayerNumber -> Exp ()) -> Exp ()+forEachPlayer action actionWhenArrive actionWhenLeave = do+    pns <- getAllPlayerNumbers+    mapM_ action pns+    onEvent_ (Player Arrive) $ \(PlayerData p) -> actionWhenArrive $ playerNumber p+    onEvent_ (Player Leave) $ \(PlayerData p) -> actionWhenLeave $ playerNumber p++-- | perform the same action for each players, including new players+forEachPlayer_ :: (PlayerNumber -> Exp ()) -> Exp ()+forEachPlayer_ action = forEachPlayer action action (\_ -> return ())++forEachPlayer' :: (PlayerNumber -> Exp a) -> ((PlayerNumber, a) -> Exp ()) -> Exp ()+forEachPlayer' = undefined 
 -- | create a value initialized for each players
 --manages players joining and leaving
-createValueForEachPlayer :: Int -> String -> Exp ()
-createValueForEachPlayer initialValue varName = do
+createValueForEachPlayer :: Int -> V [(Int, Int)] -> Exp ()
+createValueForEachPlayer initialValue var = do     pns <- getAllPlayerNumbers
-    v <- newVar_ varName $ map (,initialValue::Int) pns
-    onEvent_ (Player Arrive) $ \(PlayerData p) -> modifyVar v ((playerNumber p, initialValue):)
-    onEvent_ (Player Leave) $ \(PlayerData p)   -> modifyVar v $ filter $ (/= playerNumber p) . fst
+    v <- newVar_ (varName var) $ map (,initialValue::Int) pns+    forEachPlayer (\_-> return ())+                  (\p -> modifyVar v ((p, initialValue):))+                  (\p -> modifyVar v $ filter $ (/= p) . fst)
 --- | create and modify values for players-createValueForEachPlayer_ :: String -> Exp ()+-- | create a value initialized for each players initialized to zero
+--manages players joining and leaving+createValueForEachPlayer_ :: V [(Int, Int)] -> Exp () createValueForEachPlayer_ = createValueForEachPlayer 0 
-modifyValueOfPlayer :: PlayerNumber -> String -> (Int -> Int) -> Exp ()
-modifyValueOfPlayer pn var f = modifyVar (V var::V [(Int, Int)]) $ map $ (\(a,b) -> if a == pn then (a, f b) else (a,b))
+modifyValueOfPlayer :: PlayerNumber -> V [(Int, Int)] -> (Int -> Int) -> Exp ()
+modifyValueOfPlayer pn var f = modifyVar var $ map $ (\(a,b) -> if a == pn then (a, f b) else (a,b))
 
-modifyAllValues :: String -> (Int -> Int) -> Exp ()
-modifyAllValues var f = modifyVar (V var::V [(Int, Int)]) $ map $ second f
+modifyAllValues :: V [(Int, Int)] -> (Int -> Int) -> Exp ()
+modifyAllValues var f = modifyVar var $ map $ second f
 
 -- | Player p cannot propose anymore rules
 noPlayPlayer :: PlayerNumber -> RuleFunc
@@ -487,9 +522,7 @@  -- | a rule can autodelete itself (generaly after having performed some actions)
 autoDelete :: Exp ()-autoDelete = do-    s <- getSelfRuleNumber-    suppressRule_ s+autoDelete = getSelfRuleNumber >>= suppressRule_  
 -- | All rules from player p are erased:
+ src/Language/Nomyx/Test.hs view
@@ -0,0 +1,249 @@+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, NamedFieldPuns, GADTs#-}++module Language.Nomyx.Test where++import Language.Nomyx.Rule+import Language.Nomyx.Expression+import Language.Nomyx.Evaluation+import Control.Monad+import Control.Monad.State.Lazy+import Data.Typeable+import Data.Time+import Data.Maybe (fromJust)++date1 = parse822Time "Tue, 02 Sep 1997 09:00:00 -0400"+date2 = parse822Time "Tue, 02 Sep 1997 10:00:00 -0400"++testGame = Game { gameName      = "test",+                  gameDesc      = "test",+                  rules         = [],+                  players       = [PlayerInfo 1 "coco"],+                  variables     = [],+                  events        = [],+                  outputs       = [],+                  victory       = [],+                  currentTime   = date1}++testRule = Rule  { rNumber       = 0,+                   rName         = "test",+                   rDescription  = "test",+                   rProposedBy   = 0,+                   rRuleCode     = "",+                   rRuleFunc     = VoidRule $ return (),+                   rStatus       = Pending,+                   rAssessedBy   = Nothing}++evalRuleFunc (VoidRule f) = evalState (evalExp f 0) testGame+execRuleFuncEvent (VoidRule f) e d = execState (evalExp f 0 >> (triggerEvent e d)) testGame+execRuleFuncGame (VoidRule f) g = execState (evalExp f 0) g+execRuleFuncEventGame (VoidRule f) e d g = execState (evalExp f 0 >> (triggerEvent e d)) g+execRuleFunc f = execRuleFuncGame f testGame++tests = [("test var 1", testVarEx1),+         ("test var 2", testVarEx2),+         ("test var 3", testVarEx3),+         ("test var 4", testVarEx4),+         ("test var 5", testVarEx5),+         ("test single input", testSingleInputEx),+         ("test input string", testInputStringEx),+         ("test send messsage", testSendMessageEx),+         ("test send message 2", testSendMessageEx2),+         ("test user input write", testUserInputWriteEx),+         ("test activate rule", testActivateRuleEx),+         ("test auto activate", testAutoActivateEx),+         ("test unanimity vote", testUnanimityVoteEx),+         ("test time event", testTimeEventEx),+         ("test time event 2", testTimeEventEx2)]++allTests = and $ map snd tests++--Test variable creation+testVar1 :: RuleFunc+testVar1 = VoidRule $ do+   NewVar "toto" (1::Integer)+   return ()++testVarEx1 = variables (execRuleFunc testVar1) == [(Var 0 "toto" (1::Integer))]++--Test variable deleting+testVar2 :: RuleFunc+testVar2 = VoidRule $ do+   var <- newVar_ "toto" (1::Int)+   delVar var+   return ()++testVarEx2 = variables (execRuleFunc testVar2) == []++--Test variable reading+testVar3 :: RuleFunc+testVar3 = VoidRule $ do+   var <- newVar_ "toto" (1::Int)+   a <- readVar var+   case a of+      Just (1::Int) -> output "ok" 1+      Nothing -> output "nok" 1++testVarEx3 = outputs (execRuleFunc testVar3) == [(1,"ok")]++--Test variable writing+testVar4 :: RuleFunc+testVar4 = VoidRule $ do+   var <- newVar_ "toto" (1::Int)+   writeVar var (2::Int)+   a <- readVar var+   case a of+      Just (2::Int) -> output "ok" 1+      Nothing -> output "nok" 1++testVarEx4 = outputs (execRuleFunc testVar4) == [(1,"ok")]++--Test variable writing+testVar5 :: RuleFunc+testVar5 = VoidRule $ do+   var <- newVar_ "toto" ([]::[Int])+   writeVar var ([1]::[Int])+   a <- readVar var+   case a of+      Just (a::[Int]) -> do+         writeVar var (2:a)+         return ()+      Nothing -> output "nok" 1++testVarEx5 = variables (execRuleFunc testVar5) == [(Var 0 "toto" ([2,1]::[Int]))]++data Choice = Holland | Sarkozy deriving (Enum, Typeable, Show, Eq, Bounded)++--mkInputChoiceEnum_ :: forall a. (Enum a, Bounded a, Typeable a, Eq a,  Show a) => String -> a -> PlayerNumber -> (a -> Exp ()) -> Exp EventNumber+++testSingleInput :: RuleFunc+testSingleInput = VoidRule $ do+    onInputChoiceEnum_ "Vote for Holland or Sarkozy" Holland h 1 where+        h a = output ("voted for " ++ (show a)) 1++testSingleInputEx = (outputs $ execRuleFuncEvent testSingleInput (inputChoiceEnum 1 "Vote for Holland or Sarkozy" Holland) (InputChoiceData Holland)) == [(1, "voted for Holland")]++testInputString :: RuleFunc+testInputString = VoidRule $ do+    onInputString_ "Enter a number:" h 1 where+        h a = output ("You entered: " ++ a) 1++testInputStringEx = (outputs $ execRuleFuncEvent testInputString (inputString 1 "Enter a number:") (InputStringData "1")) == [(1, "You entered: 1")]+++testSendMessage :: RuleFunc+testSendMessage = VoidRule $ do+    let msg = Message "msg" :: Event(Message String)+    onEvent_ msg f+    sendMessage msg "toto" where+        f (MessageData a :: EventData(Message String)) = output a 1++testSendMessageEx = outputs (execRuleFunc testSendMessage) == [(1,"toto")]++testSendMessage2 :: RuleFunc+testSendMessage2 = VoidRule $ do+    onEvent_ (Message "msg":: Event(Message ())) f+    sendMessage_ (Message "msg") where+        f (MessageData a) = output "Received" 1++testSendMessageEx2 = outputs (execRuleFunc testSendMessage2) == [(1,"Received")]++data Choice2 = Me | You deriving (Enum, Typeable, Show, Eq, Bounded)++testUserInputWrite :: RuleFunc+testUserInputWrite = VoidRule $ do+    var <- newVar_ "vote" (Nothing::Maybe Choice2)+    onEvent_ (Message "voted" :: Event (Message ())) h2+    onEvent_ (InputChoice 1 "Vote for" [Me, You] Me) h1 where+        h1 (InputChoiceData a :: EventData (InputChoice Choice2)) = do+            writeVar (V "vote") (Just a)+            SendMessage (Message "voted") ()+        h2 (MessageData _) = do+            a <- readVar (V "vote")+            case a of+                Just (Just Me) -> output "voted Me" 1+                Nothing -> output "problem" 1++testUserInputWriteEx = (outputs $ execRuleFuncEvent testUserInputWrite (InputChoice 1 "Vote for" [Me, You] Me) (InputChoiceData Me)) == [(1,"voted Me")]++testActivateRule :: RuleFunc+testActivateRule = VoidRule $ do+    a <- GetRules+    if (rStatus (head a) == Pending) then do+        ActivateRule $ rNumber (head a)+        return ()+        else return ()+++testActivateRuleEx = rStatus (head $ rules (execRuleFuncGame testActivateRule testGame {rules=[testRule]}))  == Active++testAutoActivateEx = rStatus (head $ rules (execRuleFuncEventGame autoActivate (RuleEv Proposed) (RuleData testRule) (testGame {rules=[testRule]})))  == Active++unanimityRule = testRule {rName = "unanimityRule", rRuleFunc = RuleRule $ voteWith unanimity, rNumber = 2, rStatus = Active}+applicationMetaRuleRule = testRule {rName = "onRuleProposedUseMetaRules", rRuleFunc = onRuleProposed checkWithMetarules, rNumber = 3, rStatus = Active}+gameUnanimity = testGame {rules=[unanimityRule]}++testUnanimityVote :: Game+testUnanimityVote = flip execState testGame $ do+    addPlayer (PlayerInfo 1 "coco")+    addPlayer (PlayerInfo 2 "jean paul")+    evAddRule unanimityRule+    evActivateRule (rNumber unanimityRule) 0+    evAddRule applicationMetaRuleRule+    evActivateRule (rNumber applicationMetaRuleRule) 0+    evProposeRule testRule+    evInputChoice (InputChoice 1 "Vote for rule 0" [For, Against] For) For+    evInputChoice (InputChoice 2 "Vote for rule 0" [For, Against] For) For++testUnanimityVoteEx = (rStatus $ head $ rules testUnanimityVote) == Active++testTimeEvent :: RuleFunc+testTimeEvent = VoidRule $ do+    onEvent_ (Time date1) f where+        f t = outputAll $ show date1++testTimeEventEx = (outputs $ execRuleFuncEvent testTimeEvent (Time date1) (TimeData date1)) == [(1,show date1)]++testTimeEvent2 :: Exp ()+testTimeEvent2 = schedule' [date1, date2] (outputAll . show)++testTimeEventEx2 = (outputs $ flip execState testGame (evalExp testTimeEvent2 0 >> gameEvs)) == [(1,show date2), (1,show date1)] where+    gameEvs = do+        evTriggerTime date1+        evTriggerTime date2++timedUnanimityRule = testRule {rName = "unanimityRule", rRuleFunc = voteWithTimeLimit unanimity date1, rNumber = 2, rStatus = Active}+gameTimedUnanimity = testGame {rules=[timedUnanimityRule]}+testTimedUnanimityVote :: Game+testTimedUnanimityVote = flip execState testGame $ do+    addPlayer (PlayerInfo 1 "coco")+    addPlayer (PlayerInfo 2 "jean paul")+    evAddRule timedUnanimityRule+    evActivateRule (rNumber timedUnanimityRule) 0+    evAddRule applicationMetaRuleRule+    evActivateRule (rNumber applicationMetaRuleRule) 0+    evProposeRule testRule+    evInputChoice (InputChoice 1 "Vote for rule 0" [For, Against] For) Against+    evTriggerTime date1++testTimedUnanimityVoteEx = (rStatus $ head $ rules testTimedUnanimityVote) == Reject++--    now <- Rule.getCurrentTime+--    let oneDay = 24 * 60 * 60 :: NominalDiffTime+++{-autoMetarulesR = testRule {rName = "autoMetaRules", rRuleFunc = autoMetarules, rNumber = 2, rStatus = Active}+gameautoMetarules = testGame {rules=[autoMetarulesR]}++testAutoMetarules :: Game+testAutoMetarules = flip execState testGame $ do+    evAddRule unanimityRule+    evActivateRule (rNumber unanimityRule) 0+    evProposeRule testRule+    evInputChoice (InputChoice 1 "Vote for rule test") For+    evInputChoice (InputChoice 2 "Vote for rule test") For++testAutoMetarulesEx = (rStatus $ head $ rules testUnanimityVote) == Active+-}++
− tests/Test.hs 
@@ -1,235 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, NamedFieldPuns, GADTs#-}--module Test where--import Language.Nomyx.Rule-import Language.Nomyx.Expression-import Language.Nomyx.Evaluation-import Control.Monad-import Control.Monad.State.Lazy-import Data.Typeable-import Data.Time-import Data.Maybe (fromJust)--date1 = parse822Time "Tue, 02 Sep 1997 09:00:00 -0400"-date2 = parse822Time "Tue, 02 Sep 1997 10:00:00 -0400"--testGame = Game { gameName      = "test",-                  rules         = [],-                  players       = [PlayerInfo 1 "coco"],-                  variables     = [],-                  events        = [],-                  outputs       = [],-                  victory       = [],-                  currentTime   = date1}--testRule = Rule  { rNumber       = 0,-                   rName         = "test",-                   rDescription  = "test",-                   rProposedBy   = 0,-                   rRuleCode     = "",-                   rRuleFunc     = VoidRule $ return (),-                   rStatus       = Pending,-                   rAssessedBy   = Nothing}--evalRuleFunc (VoidRule f) = evalState (evalExp f 0) testGame-execRuleFuncEvent (VoidRule f) e d = execState (evalExp f 0 >> (triggerEvent e d)) testGame-execRuleFuncGame (VoidRule f) g = execState (evalExp f 0) g-execRuleFuncEventGame (VoidRule f) e d g = execState (evalExp f 0 >> (triggerEvent e d)) g-execRuleFunc f = execRuleFuncGame f testGame--tests = [testVarEx1, testVarEx2, testVarEx3, testVarEx4, testVarEx5, testSingleInputEx, testInputStringEx,-    testSendMessageEx, testSendMessageEx2, testUserInputWriteEx, testActivateRuleEx,-    testAutoActivateEx, testUnanimityVoteEx, testTimeEventEx, testTimeEventEx2]-allTests = and $ tests----Test variable creation-testVar1 :: RuleFunc-testVar1 = VoidRule $ do-   NewVar "toto" (1::Integer)-   return ()--testVarEx1 = variables (execRuleFunc testVar1) == [(Var 0 "toto" (1::Integer))]----Test variable deleting-testVar2 :: RuleFunc-testVar2 = VoidRule $ do-   var <- newVar_ "toto" (1::Int)-   delVar var-   return ()--testVarEx2 = variables (execRuleFunc testVar2) == []----Test variable reading-testVar3 :: RuleFunc-testVar3 = VoidRule $ do-   var <- newVar_ "toto" (1::Int)-   a <- readVar var-   case a of-      Just (1::Int) -> output "ok" 1-      Nothing -> output "nok" 1--testVarEx3 = outputs (execRuleFunc testVar3) == [(1,"ok")]----Test variable writing-testVar4 :: RuleFunc-testVar4 = VoidRule $ do-   var <- newVar_ "toto" (1::Int)-   writeVar var (2::Int)-   a <- readVar var-   case a of-      Just (2::Int) -> output "ok" 1-      Nothing -> output "nok" 1--testVarEx4 = outputs (execRuleFunc testVar4) == [(1,"ok")]----Test variable writing-testVar5 :: RuleFunc-testVar5 = VoidRule $ do-   var <- newVar_ "toto" ([]::[Int])-   writeVar var ([1]::[Int])-   a <- readVar var-   case a of-      Just (a::[Int]) -> do-         writeVar var (2:a)-         return ()-      Nothing -> output "nok" 1--testVarEx5 = variables (execRuleFunc testVar5) == [(Var 0 "toto" ([2,1]::[Int]))]--data Choice = Holland | Sarkozy deriving (Enum, Typeable, Show, Eq, Bounded)----mkInputChoiceEnum_ :: forall a. (Enum a, Bounded a, Typeable a, Eq a,  Show a) => String -> a -> PlayerNumber -> (a -> Exp ()) -> Exp EventNumber---testSingleInput :: RuleFunc-testSingleInput = VoidRule $ do-    onInputChoiceEnum_ "Vote for Holland or Sarkozy" Holland h 1 where-        h a = output ("voted for " ++ (show a)) 1--testSingleInputEx = (outputs $ execRuleFuncEvent testSingleInput (inputChoiceEnum 1 "Vote for Holland or Sarkozy" Holland) (InputChoiceData Holland)) == [(1, "voted for Holland")]--testInputString :: RuleFunc-testInputString = VoidRule $ do-    onInputString_ "Enter a number:" h 1 where-        h a = output ("You entered: " ++ a) 1--testInputStringEx = (outputs $ execRuleFuncEvent testInputString (inputString 1 "Enter a number:") (InputStringData "1")) == [(1, "You entered: 1")]---testSendMessage :: RuleFunc-testSendMessage = VoidRule $ do-    let msg = Message "msg" :: Event(Message String)-    onEvent_ msg f-    sendMessage msg "toto" where-        f (MessageData a :: EventData(Message String)) = output a 1--testSendMessageEx = outputs (execRuleFunc testSendMessage) == [(1,"toto")]--testSendMessage2 :: RuleFunc-testSendMessage2 = VoidRule $ do-    onEvent_ (Message "msg":: Event(Message ())) f-    sendMessage_ (Message "msg") where-        f (MessageData a) = output "Received" 1--testSendMessageEx2 = outputs (execRuleFunc testSendMessage2) == [(1,"Received")]--data Choice2 = Me | You deriving (Enum, Typeable, Show, Eq, Bounded)--testUserInputWrite :: RuleFunc-testUserInputWrite = VoidRule $ do-    var <- newVar_ "vote" (Nothing::Maybe Choice2)-    onEvent_ (Message "voted" :: Event (Message ())) h2-    onEvent_ (InputChoice 1 "Vote for" [Me, You] Me) h1 where-        h1 (InputChoiceData a :: EventData (InputChoice Choice2)) = do-            writeVar (V "vote") (Just a)-            SendMessage (Message "voted") ()-        h2 (MessageData _) = do-            a <- readVar (V "vote")-            case a of-                Just (Just Me) -> output "voted Me" 1-                Nothing -> output "problem" 1--testUserInputWriteEx = (outputs $ execRuleFuncEvent testUserInputWrite (InputChoice 1 "Vote for" [Me, You] Me) (InputChoiceData Me)) == [(1,"voted Me")]--testActivateRule :: RuleFunc-testActivateRule = VoidRule $ do-    a <- GetRules-    if (rStatus (head a) == Pending) then do-        ActivateRule $ rNumber (head a)-        return ()-        else return ()---testActivateRuleEx = rStatus (head $ rules (execRuleFuncGame testActivateRule testGame {rules=[testRule]}))  == Active--testAutoActivateEx = rStatus (head $ rules (execRuleFuncEventGame autoActivate (RuleEv Proposed) (RuleData testRule) (testGame {rules=[testRule]})))  == Active--unanimityRule = testRule {rName = "unanimityRule", rRuleFunc = vote unanimity, rNumber = 2, rStatus = Active}-applicationMetaRuleRule = testRule {rName = "applicationMetaRule", rRuleFunc = applicationMetaRule, rNumber = 3, rStatus = Active}-gameUnanimity = testGame {rules=[unanimityRule]}--testUnanimityVote :: Game-testUnanimityVote = flip execState testGame $ do-    addPlayer (PlayerInfo 1 "coco")-    addPlayer (PlayerInfo 2 "jean paul")-    evAddRule unanimityRule-    evActivateRule (rNumber unanimityRule) 0-    evAddRule applicationMetaRuleRule-    evActivateRule (rNumber applicationMetaRuleRule) 0-    evProposeRule testRule-    evInputChoice (InputChoice 1 "Vote for rule 0" [For, Against] For) For-    evInputChoice (InputChoice 2 "Vote for rule 0" [For, Against] For) For--testUnanimityVoteEx = (rStatus $ head $ rules testUnanimityVote) == Active--testTimeEvent :: RuleFunc-testTimeEvent = VoidRule $ do-    onEvent_ (Time date1) f where-        f t = outputAll $ show date1--testTimeEventEx = (outputs $ execRuleFuncEvent testTimeEvent (Time date1) (TimeData date1)) == [(1,show date1)]--testTimeEvent2 :: Exp ()-testTimeEvent2 = schedule' [date1, date2] (outputAll . show)--testTimeEventEx2 = (outputs $ flip execState testGame (evalExp testTimeEvent2 0 >> gameEvs)) == [(1,show date2), (1,show date1)] where-    gameEvs = do-        evTriggerTime date1-        evTriggerTime date2--timedUnanimityRule = testRule {rName = "unanimityRule", rRuleFunc = voteWithTimeLimit unanimity date1, rNumber = 2, rStatus = Active}-gameTimedUnanimity = testGame {rules=[timedUnanimityRule]}-testTimedUnanimityVote :: Game-testTimedUnanimityVote = flip execState testGame $ do-    addPlayer (PlayerInfo 1 "coco")-    addPlayer (PlayerInfo 2 "jean paul")-    evAddRule timedUnanimityRule-    evActivateRule (rNumber timedUnanimityRule) 0-    evAddRule applicationMetaRuleRule-    evActivateRule (rNumber applicationMetaRuleRule) 0-    evProposeRule testRule-    evInputChoice (InputChoice 1 "Vote for rule 0" [For, Against] For) Against-    evTriggerTime date1--testTimedUnanimityVoteEx = (rStatus $ head $ rules testTimedUnanimityVote) == Reject----    now <- Rule.getCurrentTime---    let oneDay = 24 * 60 * 60 :: NominalDiffTime---{-autoMetarulesR = testRule {rName = "autoMetaRules", rRuleFunc = autoMetarules, rNumber = 2, rStatus = Active}-gameautoMetarules = testGame {rules=[autoMetarulesR]}--testAutoMetarules :: Game-testAutoMetarules = flip execState testGame $ do-    evAddRule unanimityRule-    evActivateRule (rNumber unanimityRule) 0-    evProposeRule testRule-    evInputChoice (InputChoice 1 "Vote for rule test") For-    evInputChoice (InputChoice 2 "Vote for rule test") For--testAutoMetarulesEx = (rStatus $ head $ rules testUnanimityVote) == Active--}--