Nomyx-Rules 0.0.2 → 0.0.3

raw patch · 7 files changed

+33/−49 lines, 7 files

Files

• Nomyx-Rules.cabal +3/−3
• README +1/−0
• examples/Examples.hs +18/−3
• src/Language/Nomyx/Evaluation.hs +1/−5
• src/Language/Nomyx/Expression.hs +1/−1
• src/Language/Nomyx/Rule.hs +9/−5
• src/Paths_Nomyx_Rules.hs +0/−32

@@ -1,5 +1,5 @@ name: Nomyx-Rules-version: 0.0.2+version: 0.0.3 cabal-version: >=1.6 build-type: Simple license: BSD3@@ -8,8 +8,8 @@ maintainer: Corentin Dupont stability: Experimental synopsis: Language to express rules for Nomic-description: Provide a DSL to express rules for the Nomic game, with evaluation engine-category: Game Engine+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             src/Language/Nomyx/Expression.hs src/Language/Nomyx/Rule.hs

@@ -20,3 +20,4 @@  To get a copy of the git repository: git clone git://github.com/cdupont/Nomic.git+

@@ -59,6 +59,15 @@ 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 ()@@ -80,20 +89,26 @@     suppressRule 1     suppressRule 2     voidRule $ makeKing player-    addRule_ $ defaultRule {rName = "monarchy", rRuleFunc = monarchy, rRuleCode = "monarchy", rNumber = 1}+    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-    setVictory $ map fst $ filter ((>= x) . snd) counts+    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 []

@@ -90,7 +90,7 @@     modify (\game -> game { victory = ps})     pls <- gets players     let victorious = filter (\pl -> playerNumber pl `elem` ps) pls-    trace "setV           " $ triggerEvent Victory (VictoryData victorious)+    triggerEvent Victory (VictoryData victorious)     return ()  evalExp (CurrentTime) _ = gets currentTime@@ -186,10 +186,6 @@     case find (\Rule { rNumber = rn} -> rn == rNumber rule) rs of        Nothing -> do           modify (\game -> game { rules = rule : rs})-          --execute the rule-          --case rRuleFunc rule of-          --   (VoidRule vr) -> evalExp vr (rNumber rule)-          --   _ -> return ()           triggerEvent (RuleEv Added) (RuleData rule)           return True        Just _ -> return False

@@ -53,7 +53,7 @@      GetPlayers   :: Exp [PlayerInfo]
      Const        :: a -> Exp a
      Bind         :: Exp a -> (a -> Exp b) -> Exp b
-     CurrentTime  :: Exp (UTCTime)+     CurrentTime  :: Exp UTCTime      SelfRuleNumber :: Exp RuleNumber
      deriving (Typeable)
 

@@ -50,7 +50,8 @@     case ma of
        True -> return ()
        False -> error "writeVar_: Variable not existing"
-
++-- | modify a variable using the provided function
 modifyVar :: (Typeable a, Show a, Eq a) => (V a) -> (a -> a) -> Exp ()
 modifyVar v f = writeVar_ v . f =<< readVar_ v
 
@@ -234,8 +235,11 @@ addRule r = AddRule r  addRule_ :: Rule -> Exp ()
-addRule_ r = AddRule r >> return ()
+addRule_ r = AddRule r >> return () +addRuleParams_ :: RuleName -> RuleFunc -> RuleCode -> RuleNumber -> String -> Exp ()+addRuleParams_ name func code number desc = addRule_ $ defaultRule {rName = name, rRuleFunc = func, rRuleCode = code, rNumber = number, rDescription = desc}
+ --suppresses completly a rule and its environment from the system
 suppressRule :: RuleNumber -> Exp Bool
 suppressRule rn = DelRule rn
@@ -397,7 +401,7 @@         f Rule {rRuleFunc = (RuleRule r)} = Just r
         f _ = Nothing
 
--- | any incoming rule will be activate if all active meta rules agrees
+-- | 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
@@ -431,9 +435,9 @@ unanimity :: [(PlayerNumber, ForAgainst)] -> Bool
 unanimity l = ((length $ filter ((== Against) . snd) l) == 0)
 
--- | assess the vote results according to a majority
+-- | assess the vote results according to an absolute majority (half participants plus one)
 majority :: [(PlayerNumber, ForAgainst)] -> Bool
-majority l = ((length $ filter ((== For) . snd) l) >= length l)
+majority l = ((length $ filter ((== For) . snd) l) >= (length l) `div` 2 + 1)
 
 activateOrReject :: Rule -> Bool -> Exp ()
 activateOrReject r b = if b then activateRule_ (rNumber r) else rejectRule_ (rNumber r)

@@ -1,32 +0,0 @@-module Paths_Nomyx_Rules (-    version,-    getBinDir, getLibDir, getDataDir, getLibexecDir,-    getDataFileName-  ) where--import qualified Control.Exception as Exception-import Data.Version (Version(..))-import System.Environment (getEnv)-catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a-catchIO = Exception.catch---version :: Version-version = Version {versionBranch = [0,0,1], versionTags = []}-bindir, libdir, datadir, libexecdir :: FilePath--bindir     = "/home/cdupont/.cabal/bin"-libdir     = "/home/cdupont/.cabal/lib/Nomyx-Rules-0.0.1/ghc-7.4.1"-datadir    = "/home/cdupont/.cabal/share/Nomyx-Rules-0.0.1"-libexecdir = "/home/cdupont/.cabal/libexec"--getBinDir, getLibDir, getDataDir, getLibexecDir :: IO FilePath-getBinDir = catchIO (getEnv "Nomyx_Rules_bindir") (\_ -> return bindir)-getLibDir = catchIO (getEnv "Nomyx_Rules_libdir") (\_ -> return libdir)-getDataDir = catchIO (getEnv "Nomyx_Rules_datadir") (\_ -> return datadir)-getLibexecDir = catchIO (getEnv "Nomyx_Rules_libexecdir") (\_ -> return libexecdir)--getDataFileName :: FilePath -> IO FilePath-getDataFileName name = do-  dir <- getDataDir-  return (dir ++ "/" ++ name)