Nomyx-Language 0.3.0 → 0.3.1

raw patch · 6 files changed

+55/−32 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Nomyx-Language.cabal +2/−1
• src/Language/Nomyx/Definition.hs +8/−0
• src/Language/Nomyx/Examples.hs +14/−6
• src/Language/Nomyx/Game.hs +2/−2
• src/Language/Nomyx/Rule.hs +21/−18
• src/Language/Nomyx/Vote.hs +8/−5

@@ -1,5 +1,5 @@ name: Nomyx-Language-version: 0.3.0+version: 0.3.1 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_Language)@@ -12,6 +12,7 @@ synopsis: Language to express rules for Nomic description: Provide a DSL to express rules for a Nomic game, with evaluation engine. See package Nomyx for a full game implementation. category: Language+Homepage: www.nomyx.net author: Corentin Dupont data-files: src/Language/Nomyx/Definition.hs             src/Language/Nomyx/Examples.hs

@@ -64,7 +64,10 @@     mv <- newVar name a     return $ mv >>= Just . MsgVar (Message name) 
+newMsgVar_ :: (Typeable a, Show a, Eq a) => VarName -> a -> Nomex (MsgVar a)
+newMsgVar_ name a = partial "newMsgVar_: Variable existing" (newMsgVar name a)
 + newMsgVar' :: (Typeable a, Show a, Eq a) => VarName -> a -> (VEvent a -> Nomex()) -> Nomex (Maybe (MsgVar a))
 newMsgVar' name a f = do
     mv <- newMsgVar name a@@ -89,6 +92,9 @@ readMsgVar_ :: (Typeable a, Show a, Eq a) => MsgVar a -> Nomex a
 readMsgVar_ mv = partial "readMsgVar_: variable not existing" (readMsgVar mv) +modifyMsgVar :: (Typeable a, Show a, Eq a) => MsgVar a -> (a -> a) -> Nomex ()+modifyMsgVar mv f = writeMsgVar_ mv . f =<< readMsgVar_ mv+ delMsgVar :: (Typeable a, Show a, Eq a) => MsgVar a -> Nomex Bool
 delMsgVar (MsgVar m v) = do    sendMessage m VDeleted@@ -125,6 +131,8 @@ getMsgVarData_ :: (Typeable a, Show a, Eq a) => (MsgVar a) -> Nomex a
 getMsgVarData_ (MsgVar _ v) = readVar_ v +getMsgVarName :: (Typeable a, Show a, Eq a) => (MsgVar a) -> String+getMsgVarName (MsgVar _ (V varName)) = varName     
 -- * Variable arrays
 -- | ArrayVar is an indexed array with a signal attached triggered at every change.

@@ -8,20 +8,19 @@     winXEcuOnRuleAccepted, moneyTransfer, delRule, voteWithMajority, king, makeKing, monarchy,     revolution, victoryXRules, victoryXEcu, displayTime, noGroupVictory, iWin, returnToDemocracy,     banPlayer, referendum, referendumOnKickPlayer, gameMasterElections, gameMaster, bravoButton,-    enterHaiku,+    enterHaiku, displayBankAccount,     module Data.Time.Recurrence, module Control.Monad, module Data.List, module Data.Time.Clock) where  import Language.Nomyx.Definition import Language.Nomyx.Rule import Language.Nomyx.Expression+import Language.Nomyx.Vote import Data.Function import Data.Time.Clock hiding (getCurrentTime) import Data.Time.Recurrence hiding (filter) import Control.Arrow import Data.List import Control.Monad-import Language.Nomyx.Vote-       (elections, referendum, assessOnTimeDelay, assessOnEveryVote, withQuorum, majority, voteWith_) import Language.Nomyx.Utils (oneDay) import Safe (readDef) @@ -34,13 +33,17 @@ helloWorld = voidRule $ outputAll "hello, world!"  -- | account variable name and type-accounts :: V [(PlayerNumber, Int)]-accounts = V "Accounts"+accounts :: MsgVar [(PlayerNumber, Int)]+accounts = msgVar "Accounts"  -- | Create a bank account for each players createBankAccount :: RuleFunc createBankAccount = voidRule $ createValueForEachPlayer_ accounts +-- | Permanently display the bank accounts+displayBankAccount :: RuleFunc+displayBankAccount = voidRule $ forEachPlayer_ displayPlayerAccount+ -- | 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@@ -106,7 +109,7 @@  victoryXEcu :: Int -> RuleFunc victoryXEcu x = voidRule $ onEvent_ (RuleEv Activated) $ \_ -> do-    as <- readVar_ accounts+    as <- readMsgVar_ accounts     let victorious = map fst $ filter ((>= x) . snd) as     if (length victorious /= 0) then setVictory victorious else return () @@ -174,3 +177,8 @@  enterHaiku :: RuleFunc enterHaiku = voidRule $ onInputTextarea_ "Enter a haiku:" outputAll 1++displayPlayerAccount :: PlayerNumber -> Nomex ()+displayPlayerAccount pn = do+   sp <- showPlayer+   displayVar pn accounts (\l -> "Accounts:\n" ++ concatMap (\(i,a) -> (sp i) ++ "\t" ++ (show a) ++ "\n") l)

@@ -18,7 +18,7 @@ import Data.Lens import Control.Category ((>>>)) import Data.Lens.Template-import Control.Exception+import Control.Exception as E import Control.Monad.Trans.State hiding (get)  data TimedEvent = TimedEvent UTCTime GameEvent deriving (Show, Read, Eq, Ord)@@ -195,4 +195,4 @@    rules %= (sysRule rule : )    mapStateIO $ runEvalError 0 $ void $ evalExp (_rRuleFunc rule) (_rNumber rule) -stateCatch = liftCatch catch+stateCatch = liftCatch E.catch

@@ -9,8 +9,10 @@ import Language.Nomyx.Definition
 import Control.Arrow
 import Data.Lens
-import Language.Nomyx.Vote+import Data.Maybe+import Data.List + 
 -- | This rule will activate automatically any new rule.
 autoActivate :: RuleFunc
@@ -52,12 +54,8 @@       _ -> return Nothing
 
 
--- | any new rule will be activate if the rule in parameter returns True
-onRuleProposed :: (Rule -> Nomex (Msg [ForAgainst]) ) -> RuleFunc
-onRuleProposed f = voidRule $ onEvent_ (RuleEv Proposed) $ \(RuleData rule) -> do
-    resp <- f rule-    onMessageOnce resp $ (activateOrReject rule) . (== [For]) . messageData
 
+
 -- | activate or reject a rule
 activateOrReject :: Rule -> Bool -> Nomex ()
 activateOrReject r b = if b then activateRule_ (_rNumber r) else rejectRule_ (_rNumber r)
@@ -77,29 +75,29 @@ 
 -- | create a value initialized for each players
 --manages players joining and leaving
-createValueForEachPlayer :: Int -> V [(Int, Int)] -> Nomex ()
-createValueForEachPlayer initialValue var = do
+createValueForEachPlayer :: Int -> MsgVar [(Int, Int)] -> Nomex ()
+createValueForEachPlayer initialValue mv = do
     pns <- getAllPlayerNumbers
-    v <- newVar_ (varName var) $ map (,initialValue::Int) pns
+    v <- newMsgVar_ (getMsgVarName mv) $ map (,initialValue::Int) pns
     forEachPlayer (\_-> return ())
-                  (\p -> modifyVar v ((p, initialValue) : ))
-                  (\p -> modifyVar v $ filter $ (/= p) . fst)
+                  (\p -> modifyMsgVar v ((p, initialValue) : ))
+                  (\p -> modifyMsgVar v $ filter $ (/= p) . fst)
 
 -- | create a value initialized for each players initialized to zero
 --manages players joining and leaving
-createValueForEachPlayer_ :: V [(Int, Int)] -> Nomex ()
+createValueForEachPlayer_ :: MsgVar [(Int, Int)] -> Nomex ()
 createValueForEachPlayer_ = createValueForEachPlayer 0
 -getValueOfPlayer :: PlayerNumber -> V [(Int, Int)] -> Nomex (Maybe Int)+getValueOfPlayer :: PlayerNumber -> MsgVar [(Int, Int)] -> Nomex (Maybe Int) getValueOfPlayer pn var = do-   value <- readVar_ var+   value <- readMsgVar_ var    return $ lookup pn value 
-modifyValueOfPlayer :: PlayerNumber -> V [(Int, Int)] -> (Int -> Int) -> Nomex ()
-modifyValueOfPlayer pn var f = modifyVar var $ map $ (\(a,b) -> if a == pn then (a, f b) else (a,b))
+modifyValueOfPlayer :: PlayerNumber -> MsgVar [(Int, Int)] -> (Int -> Int) -> Nomex ()
+modifyValueOfPlayer pn var f = modifyMsgVar var $ map $ (\(a,b) -> if a == pn then (a, f b) else (a,b))
 
-modifyAllValues :: V [(Int, Int)] -> (Int -> Int) -> Nomex ()
-modifyAllValues var f = modifyVar var $ map $ second f
+modifyAllValues :: MsgVar [(Int, Int)] -> (Int -> Int) -> Nomex ()
+modifyAllValues var f = modifyMsgVar var $ map $ second f
 
 -- | Player p cannot propose anymore rules
 noPlayPlayer :: PlayerNumber -> RuleFunc
@@ -117,3 +115,8 @@     let myrs = filter ((== p) . getL rProposedBy) rs
     res <- mapM (suppressRule . _rNumber) myrs
     return $ and res
++showPlayer :: Nomex (PlayerNumber -> String)+showPlayer = do+   pls <- getPlayers+   return $ (\pn -> _playerName $ fromJust $ find (\(PlayerInfo mypn _) -> mypn == pn) pls)

@@ -6,7 +6,8 @@  import Prelude hiding (foldr)
 import Language.Nomyx.Expression
-import Language.Nomyx.Definition
+import Language.Nomyx.Definition+import Language.Nomyx.Rule
 import Data.Typeable
 import Control.Monad.State hiding (forM_)
 import Data.Maybe@@ -188,10 +189,6 @@    sp <- showPlayer    displayVar pn mv (showVotes title sp) -showPlayer :: Nomex (PlayerNumber -> String)-showPlayer = do-   pls <- getPlayers-   return $ (\pn -> _playerName $ fromJust $ find (\(PlayerInfo mypn _) -> mypn == pn) pls)  showChoice :: (Votable a) => Maybe (Alts a) -> String showChoice (Just a) = show a@@ -214,6 +211,12 @@    sp <- showPlayer    outputAll $ "Vote result for " ++ toVoteName ++ ": " ++ (showChoices result) ++                " (" ++ showVotes' sp vs ++ ")"++-- | any new rule will be activate if the rule in parameter returns True
+onRuleProposed :: (Rule -> Nomex (Msg [ForAgainst]) ) -> RuleFunc
+onRuleProposed f = voidRule $ onEvent_ (RuleEv Proposed) $ \(RuleData rule) -> do
+    resp <- f rule+    onMessageOnce resp $ (activateOrReject rule) . (== [For]) . messageData  -- * Referendum & elections