packages feed

Nomyx-Core 0.7.1 → 0.7.2

raw patch · 13 files changed

+177/−88 lines, 13 filesdep +randomdep ~Nomyx-Language

Dependencies added: random

Dependency ranges changed: Nomyx-Language

Files

Nomyx-Core.cabal view
@@ -1,5 +1,5 @@ name: Nomyx-Core-version: 0.7.1+version: 0.7.2 cabal-version: >=1.6 build-type: Simple license: BSD3@@ -15,7 +15,7 @@ data-dir: data   library -    build-depends: Nomyx-Language         == 0.7.1,+    build-depends: Nomyx-Language         == 0.7.2,                    DebugTraceHelpers      == 0.12.*,                    MissingH               == 1.2.*,                    acid-state             == 0.12.*,@@ -41,6 +41,7 @@                    deepseq                == 1.3.*,                    network                == 2.4.*,                    old-locale             == 1.0.*,+                   random                 == 1.0.*,                    safe                   == 0.3.*,                    safecopy               == 0.8.*,                    stm                    == 2.4.*,
src/Nomyx/Core/Context.hs view
@@ -42,6 +42,7 @@                   "Data.Monoid",                   "Data.Ord",                   "Data.Ratio",+                  "Data.Semigroup",                   "Data.Tree",                   "Data.Tuple",                   "Data.Typeable",@@ -53,7 +54,8 @@                    "array",                    "base",                    "bytestring",-                   "containers"]+                   "containers",+                   "text"]  qualImports :: [(String, Maybe String)] qualImports = [("Control.Category", Just "C"),@@ -67,4 +69,5 @@                ("Data.Map", Just "M"),                ("Data.Sequence", Just "Data.Sequence"),                ("Data.Set", Just "S"),-               ("Data.Traversable", Just "Data.Traversable") ]+               ("Data.Text", Just "T"),+               ("Data.Traversable", Just "Data.Traversable")]
src/Nomyx/Core/Engine/EvalUtils.hs view
@@ -16,22 +16,24 @@ import Data.Typeable import Data.Lens import Data.Maybe+import Data.List import Control.Applicative import Control.Monad.Error import Language.Nomyx.Expression import Nomyx.Core.Engine.Types import Nomyx.Core.Engine.Utils+import Safe  -- find a field result in an environment--- TODO simplify? lookupField :: Typeable a => Field a -> FieldAddress -> [FieldResult] -> Maybe a-lookupField _ _ [] = Nothing-lookupField fi fa ((FieldResult a r fa1) : ers) = case (cast (a,r)) of-   Just (a',r') -> if (a' == fi && maybe True (== fa) fa1)-                      then Just r'-                      else lookupField fi fa ers-   Nothing      -> lookupField fi fa ers+lookupField fi fa frs = headMay $ mapMaybe (maybeField fi fa) frs +--return the field result if it matches with the input field and address+maybeField :: Typeable a => Field a -> FieldAddress -> FieldResult -> Maybe a+maybeField fi fa (FieldResult fi' res fa') = do+   ((fi'', res') :: (Field a, a)) <- cast (fi', res)+   if (fi'' == fi) && maybe True (== fa) fa' then (Just res') else Nothing+ errorHandler :: EventNumber -> String -> Evaluate () errorHandler en s = do    rn <- access eRuleNumber@@ -80,11 +82,32 @@ focusGame :: State Game a -> Evaluate a focusGame = lift . (focus eGame) -accessGame :: Lens Game a -> Evaluate (a, PlayerNumber)+accessGame :: Lens Game a -> Evaluate (a, RuleNumber) accessGame l = do    a <- access (eGame >>> l)-   pn <- access eRuleNumber-   return (a, pn)+   rn <- access eRuleNumber+   return (a, rn)++putGame :: Lens Game a -> a -> Evaluate ()+putGame l a = do+   ruleActive <- evalRuleActive+   when ruleActive $ void $ (eGame >>> l) ~= a++modifyGame :: Lens Game a -> (a -> a) -> Evaluate ()+modifyGame l f = do+   ruleActive <- evalRuleActive+   when ruleActive $ void $ (eGame >>> l) %= f++evalRuleActive :: Evaluate Bool+evalRuleActive = do+   rn <- access eRuleNumber+   rs <- access (eGame >>> rules)+   return $ if rn == 0+      then True+      else case find (\r -> _rNumber r == rn) rs of+         Just r -> _rStatus r == Active+         Nothing -> True --TODO why should there be an evaluating rule not in the list?+  --replace temporarily the rule number used for evaluation withRN :: RuleNumber -> Evaluate a -> Evaluate a
src/Nomyx/Core/Engine/Evaluation.hs view
@@ -20,6 +20,7 @@ import Data.Maybe import Data.Todo import Data.Either+import Data.Function (on) import Control.Category hiding (id) import Control.Applicative import Control.Monad.Error.Class (MonadError(..))@@ -28,7 +29,9 @@ import Nomyx.Core.Engine.EvalUtils import Nomyx.Core.Engine.Utils import Safe+import System.Random + -- * Evaluation  -- | evaluate an effecful expression.@@ -56,6 +59,7 @@ evalNomex (CatchError n h)        = catchError (evalNomex n) (\a -> evalNomex (h a)) evalNomex (Return a)              = return a evalNomex (Bind exp f)            = evalNomex exp >>= \e -> evalNomex (f e)+evalNomex (GetRandomNumber r)     = evGetRandomNumber r  -- | evaluate an effectless expression. evalNomexNE :: NomexNE a -> EvaluateNE a@@ -70,6 +74,8 @@ evalNomexNE (Bind exp f)    = evalNomexNE exp >>= \e -> evalNomexNE (f e) evalNomexNE (Simu sim ev)   = evSimu sim ev ++ --TODO should we also give a rule number to simulate the Nomex with? -- currently we use the simulating rule number evSimu :: Nomex a -> NomexNE Bool -> EvaluateNE Bool@@ -85,7 +91,7 @@    (vars, rn) <- accessGame variables    case find ((== name) . getL vName) vars of       Nothing -> do-         (eGame >>> variables) %= (Var rn name def : )+         modifyGame variables (Var rn name def : )          return $ Just (V name)       Just _ -> return Nothing @@ -95,7 +101,7 @@    case find ((== name) . getL vName) vars of       Nothing -> return False       Just _ -> do-         (eGame >>> variables) %= filter ((/= name) . getL vName)+         modifyGame variables $ filter ((/= name) . getL vName)          return True  evWriteVar :: (Typeable a, Show a) => V a -> a -> Evaluate Bool@@ -104,14 +110,14 @@    case find (\(Var _ myName _) -> myName == name) vars of       Nothing -> return False       Just (Var rn myName _) -> do-         (eGame >>> variables) %= replaceWith ((== name) . getL vName) (Var rn myName val)+         modifyGame variables $ replaceWith ((== name) . getL vName) (Var rn myName val)          return True  evOnEvent :: (Typeable e, Show e) => Event e -> ((EventNumber, e) -> Nomex ()) -> Evaluate EventNumber evOnEvent event handler = do    (evs, rn) <- accessGame events    let en = getFreeNumber (map _eventNumber evs)-   (eGame >>> events) %= (EventInfo en rn event handler SActive [] : )+   modifyGame events (EventInfo en rn event handler SActive [] : )    return en  evSendMessage :: (Typeable a, Show a) => Msg a -> a -> Evaluate ()@@ -122,7 +128,7 @@    (rs, _) <- accessGame rules    case find ((== (rNumber ^$ rule)) . getL rNumber) rs of       Nothing -> do-         (eGame >>> rules) %= (rule:)+         modifyGame rules (rule:)          triggerEvent (RuleEv Proposed) rule          return True       Just _ -> return False@@ -134,8 +140,7 @@    case find (\r -> _rNumber r == rn && _rStatus r /= Active) rs of       Nothing -> return False       Just r -> do-         let newrules = replaceWith ((== rn) . getL rNumber) r{_rStatus = Active, _rAssessedBy = Just by} rs-         (eGame >>> rules) ~= newrules+         putGame rules $ replaceWith ((== rn) . getL rNumber) r{_rStatus = Active, _rAssessedBy = Just by} rs          --execute the rule          withRN (_rNumber r) $ evalNomex (_rRule r)          triggerEvent (RuleEv Activated) r@@ -147,13 +152,12 @@    case find (\r -> _rNumber r == rn && _rStatus r /= Reject) rs of       Nothing -> return False       Just r -> do-         let newrules = replaceWith ((== rn) . getL rNumber) r{_rStatus = Reject, _rAssessedBy = Just by} rs-         (eGame >>> rules) ~= newrules-         triggerEvent (RuleEv Rejected) r          delVarsRule rn          delEventsRule rn          delOutputsRule rn          delVictoryRule rn+         putGame rules $ replaceWith ((== rn) . getL rNumber) r{_rStatus = Reject, _rAssessedBy = Just by} rs+         triggerEvent (RuleEv Rejected) r          return True  evAddRule :: RuleInfo -> Evaluate Bool@@ -161,12 +165,12 @@    (rs, _) <- accessGame rules    case find ((== (rNumber ^$ rule)) . getL rNumber) rs of       Nothing -> do-         (eGame >>> rules) %= (rule:)+         modifyGame rules (rule:)          triggerEvent (RuleEv Added) rule          return True       Just _ -> return False ---TODO: clean and execute new rule+ evModifyRule :: RuleNumber -> RuleInfo -> Evaluate Bool evModifyRule rn rule = do    (rs, _) <- accessGame rules@@ -174,7 +178,7 @@    case find ((== rn) . getL rNumber) rs of       Nothing -> return False       Just r ->  do-         (eGame >>> rules) ~= newRules+         putGame rules newRules          triggerEvent (RuleEv Modified) r          return True @@ -186,7 +190,7 @@          tracePN pn "not in game!"          return False       Just pi -> do-         (eGame >>> players) %= filter ((/= pn) . getL playerNumber)+         modifyGame players $ filter ((/= pn) . getL playerNumber)          triggerEvent (Player Leave) pi          tracePN pn $ "leaving the game: " ++ _gameName g          return True@@ -197,7 +201,7 @@    case find ((== pn) . getL playerNumber) pls of       Nothing -> return False       Just pi -> do-         (eGame >>> players) ~= replaceWith ((== pn) . getL playerNumber) (pi {_playerName = name}) pls+         putGame players $ replaceWith ((== pn) . getL playerNumber) (pi {_playerName = name}) pls          return True  evDelEvent :: EventNumber -> Evaluate Bool@@ -207,8 +211,7 @@       Nothing -> return False       Just eh -> case _evStatus eh of          SActive -> do-            let newEvents = replaceWith ((== en) . getL eventNumber) eh{_evStatus = SDeleted} evs-            (eGame >>> events) ~= newEvents+            putGame events $ replaceWith ((== en) . getL eventNumber) eh{_evStatus = SDeleted} evs             return True          SDeleted -> return False @@ -219,7 +222,7 @@ evNewOutput pn s = do    (ops, rn) <- accessGame outputs    let on = getFreeNumber (map _outputNumber ops)-   (eGame >>> outputs) %= (Output on rn pn s SActive : )+   modifyGame outputs (Output on rn pn s SActive : )    return on  evGetOutput :: OutputNumber -> EvaluateNE (Maybe String)@@ -237,7 +240,7 @@    case find (\(Output myOn _ _ _ s) -> myOn == on && s == SActive) ops of       Nothing -> return False       Just (Output _ rn pn _ _) -> do-         (eGame >>> outputs) %= replaceWith ((== on) . getL outputNumber) (Output on rn pn s SActive)+         modifyGame outputs $ replaceWith ((== on) . getL outputNumber) (Output on rn pn s SActive)          return True  evDelOutput :: OutputNumber -> Evaluate Bool@@ -247,15 +250,14 @@       Nothing -> return False       Just o -> case _oStatus o of          SActive -> do-            let newOutputs = replaceWith ((== on) . getL outputNumber) o{_oStatus = SDeleted} ops-            (eGame >>> outputs) ~= newOutputs+            putGame outputs $ replaceWith ((== on) . getL outputNumber) o{_oStatus = SDeleted} ops             return True          SDeleted -> return False  evSetVictory :: NomexNE [PlayerNumber] -> Evaluate () evSetVictory ps = do    rn <- access eRuleNumber-   void $ (eGame >>> victory) ~= (Just $ VictoryInfo rn ps)+   putGame victory (Just $ VictoryInfo rn ps)    triggerEvent Victory (VictoryInfo rn ps)  evReadVar :: (Typeable a, Show a) => V a -> EvaluateNE (Maybe a)@@ -268,12 +270,20 @@           Just v -> return $ Just v           Nothing -> return Nothing +evGetRandomNumber :: Random a => (a, a) -> Evaluate a+evGetRandomNumber r = do+   g <- access (eGame >>> randomGen)+   let (a, g') = randomR r g+   putGame randomGen g'+   return a+++ -- * Events    -- | Get the field at a certain address---TODO: should we check that the field is not already completed? findField :: EventInfo -> FieldAddress -> FormField -> EvaluateNE (Maybe SomeField) findField (EventInfo _ _ e _ _ er) addr ft = findField' addr e er ft @@ -288,10 +298,10 @@ findField' (AppR:as)  (AppEvent _ e2)  frs ft = findField' as e2 (filterPath AppR frs) ft findField' (BindL:as) (BindEvent e1 _) frs ft = findField' as e1 (filterPath BindL frs) ft findField' (BindR:as) (BindEvent e1 f) frs ft = do-   er <- getEventResult e1 (filterPath BindL frs)-   case er of+   ter <- getEventResult e1 (filterPath BindL frs) --+   case ter of       Done e2 -> findField' as (f e2) (filterPath BindR frs) ft-      Todo _  -> return Nothing+      Todo _  -> return $ Nothing findField' (Shortcut:as) (ShortcutEvents es _) frs ft = do    msfs <- mapM (\e-> findField' as e frs ft) es    return $ headMay $ catMaybes msfs  -- returning the first field that matches@@ -301,8 +311,7 @@ filterPath :: FieldAddressElem -> [FieldResult] -> [FieldResult] filterPath fa frs = mapMaybe f frs where    f (FieldResult fe fr (Just (fa':fas))) | fa == fa' = Just $ FieldResult fe fr (Just fas)-   f _ = Nothing-+   f fr = Just fr  getFormField :: SomeField -> Maybe FormField getFormField (SomeField (Input pn s (Radio choices)))    = Just $ RadioField pn s (zip [0..] (snd <$> choices))@@ -329,7 +338,7 @@ getEventResult'  EmptyEvent     _   _  = return $ Todo [] getEventResult' (SumEvent a b)  ers fa = liftM2 (<|>) (getEventResult' a ers (fa ++ [SumL])) (getEventResult' b ers (fa ++ [SumR])) getEventResult' (AppEvent f b)  ers fa = liftM2 (<*>) (getEventResult' f ers (fa ++ [AppL])) (getEventResult' b ers (fa ++ [AppR]))-getEventResult' (LiftNomexNE a) _   _  = evalNomexNE a >>= return . Done+getEventResult' (LiftEvent a)   _   _  = evalNomexNE a >>= return . Done getEventResult' (BindEvent a f) ers fa = do    er <- getEventResult' a ers (fa ++ [BindL])    case er of@@ -354,9 +363,9 @@ -- trigger some specific events triggerEvent' :: FieldResult -> [EventInfo] -> Evaluate () triggerEvent' res evs = do-   evs' <- mapM (liftEval . (updateEventInfo res)) evs  -- get all the EventInfos updated with the field-   (eGame >>> events) %= union (map fst evs')           -- store them-   void $ mapM triggerIfComplete evs'                   -- trigger the handlers for completed events+   evs' <- mapM (liftEval . (updateEventInfo res)) (sortBy (compare `on` _ruleNumber) evs)  -- get all the EventInfos updated with the field+   (eGame >>> events) %= union (map fst evs')                                               -- store them+   void $ mapM triggerIfComplete evs'                                                       -- trigger the handlers for completed events  -- if the event is complete, trigger its handler triggerIfComplete :: (EventInfo, Maybe SomeData) -> Evaluate ()@@ -393,7 +402,7 @@    i <- liftEval $ findField ei fa ft    case i of       Just sf -> execInputHandler' ir sf fa ei-      Nothing -> logAll "Input not found"+      Nothing -> logAll $ "Input not found, InputData=" ++ (show ir) ++ " FieldAddress=" ++ (show fa) ++ " FormField=" ++ (show ft) execInputHandler _ _ _ _ = return ()  -- execute the event handler using the data received from user@@ -405,6 +414,8 @@ execInputHandler' (CheckboxData is) (SomeField e@(Input _ _ (Checkbox cs))) fa ei = triggerEvent' (FieldResult e (fst <$> cs `sel` is) (Just fa)) [ei] execInputHandler' _ _ _ _ = return () ++ -- * misc  getVictorious :: Game -> [PlayerNumber]@@ -446,15 +457,16 @@ -- | Show instance for Game -- showing a game involves evaluating some parts (such as victory and outputs) instance Show Game where-   show g@(Game gn _ rs ps vs es _ _ _ t) =+   show g@(Game gn _ rs ps vs es os _ l t _) =       "Game Name = "      ++ show gn ++-      "\n Rules = "       ++ (intercalate "\n " $ map show rs) ++-      "\n Players = "     ++ show ps ++-      "\n Variables = "   ++ show vs ++-      "\n Events = "      ++ (intercalate "\n " $ map (displayEvent g) es) ++-      "\n Outputs = "     ++ show (allOutputs g) ++-      "\n Victory = "     ++ show (getVictorious g) ++-      "\n currentTime = " ++ show t ++ "\n"+      "\n\n Rules = "       ++ (intercalate "\n " $ map show rs) +++      "\n\n Players = "     ++ show ps +++      "\n\n Variables = "   ++ show vs +++      "\n\n Events = "      ++ (intercalate "\n " $ map (displayEvent g) es) ++ "\n" +++      "\n\n Outputs = "     ++ (intercalate "\n " $ map (displayOutput g) os) ++ "\n" +++      "\n\n Victory = "     ++ show (getVictorious g) +++      "\n\n currentTime = " ++ show t ++ "\n" +++      "\n\n logs = " ++ show l ++ "\n"   displayEvent :: Game -> EventInfo -> String@@ -463,6 +475,14 @@    ", rule num: " ++ (show rn) ++    ", event fields: " ++ (show $ getEventFields ei g) ++ --TODO: display also event result?    ", envs: " ++ (show env) +++   ", status: " ++ (show s)++displayOutput :: Game -> Output -> String+displayOutput g o@(Output on rn mpn _ s) =+   "output num: " ++ (show on) +++   ", rule num: " ++ (show rn) +++   ", by pn: " ++ (show mpn) +++   ", output: " ++ (show $ evalOutput g o) ++    ", status: " ++ (show s)  displayEvent' :: EventInfo -> EvaluateNE String
src/Nomyx/Core/Engine/GameEvents.hs view
@@ -20,8 +20,7 @@ import Data.Maybe  -- | a list of possible events affecting a game-data GameEvent = GameSettings      GameName GameDesc UTCTime-               | JoinGame          PlayerNumber PlayerName+data GameEvent = JoinGame          PlayerNumber PlayerName                | LeaveGame         PlayerNumber                | ProposeRuleEv     PlayerNumber SubmitRule                | InputResult       PlayerNumber EventNumber FieldAddress FormField InputData@@ -47,7 +46,6 @@  -- | perform a game event enactEvent :: GameEvent -> Maybe (RuleCode -> IO Rule) -> StateT Game IO ()-enactEvent (GameSettings name desc date) _    = mapStateIO $ gameSettings name desc date enactEvent (JoinGame pn name) _               = mapStateIO $ joinGame name pn enactEvent (LeaveGame pn) _                   = mapStateIO $ leaveGame pn enactEvent (ProposeRuleEv pn sr) (Just inter) = void $ proposeRule sr pn inter@@ -76,7 +74,7 @@  execGameEvent' :: Maybe (RuleCode -> IO Rule) -> GameEvent -> StateT LoggedGame IO () execGameEvent' inter ge = do-   t <- access $ game >>> currentTime+   t <- access (game >>> currentTime)    let te = TimedEvent t ge    gameLog %= \gl -> gl ++ [te]    focus game $ enactTimedEvent inter te@@ -87,14 +85,6 @@    g' <- execStateT a g    return $ LoggedGame g' tes --- | initialize the game.-gameSettings :: GameName -> GameDesc -> UTCTime -> State Game ()-gameSettings name desc date = do-   gameName ~= name-   gameDesc ~= desc-   currentTime ~= date-   return ()- -- | join the game. joinGame :: PlayerName -> PlayerNumber -> State Game () joinGame name pn = do@@ -152,7 +142,7 @@ getTime (SomeField (Time t)) = Just t getTime _                    = Nothing --- | A helper function to use the state transformer GameState.+-- | A helper function to run the game state. -- It additionally sets the current time. execWithGame :: UTCTime -> State LoggedGame () -> LoggedGame -> LoggedGame execWithGame t gs g = execState gs $ (game >>> currentTime) `setL` t $ g
src/Nomyx/Core/Engine/Test.hs view
@@ -24,6 +24,7 @@ import Control.Applicative import Control.Category hiding ((.)) import Control.Shortcut+import System.Random  date1 = parse822Time "Tue, 02 Sep 1997 09:00:00 -0400" date2 = parse822Time "Tue, 02 Sep 1997 10:00:00 -0400"@@ -38,16 +39,17 @@                   _outputs       = [],                   _victory       = Nothing,                   _logs          = [],-                  _currentTime   = date1}+                  _currentTime   = date1,+                  _randomGen     = mkStdGen 0}  testRule = RuleInfo  { _rNumber       = 0,-                      _rName         = "test",-                      _rDescription  = "test",-                      _rProposedBy   = 0,-                      _rRuleCode     = "",-                      _rRule         = return (),-                      _rStatus       = Pending,-                      _rAssessedBy   = Nothing}+                       _rName         = "test",+                       _rDescription  = "test",+                       _rProposedBy   = 0,+                       _rRuleCode     = "",+                       _rRule         = return (),+                       _rStatus       = Pending,+                       _rAssessedBy   = Nothing}  execRuleEvent :: (Show e, Typeable e) => Nomex a -> Field e -> e -> Game execRuleEvent r f d = execState (runSystemEval' $ evalNomex r >> triggerEvent f d) testGame@@ -115,6 +117,7 @@          ("test composed event prod 2", testProdComposeEx2),          ("test two separate events", testTwoEventsEx),          ("test monadic event", testMonadicEventEx),+         ("test monadic event2", testMonadicEventEx2),          ("test shortcut event", testShorcutEventEx)          ] @@ -170,7 +173,7 @@       Just (a::[Int]) -> void $ writeVar var (2:a)       Nothing         -> void $ newOutput (Just 1) (return "nok") -testVarEx5 = True --_variables (execRuleFunc testVar5) == [(Var 0 "toto" ([2,1]::[Int]))]+testVarEx5 = (show $ head $ _variables $ execRule testVar5) == "Rule number = 0, Name = \"toto\", Value = [2,1]\n"  data Choice = Holland | Sarkozy deriving (Enum, Typeable, Show, Eq, Bounded) @@ -246,6 +249,14 @@  testAutoActivateEx = _rStatus (head $ _rules (execRuleEventGame autoActivate (RuleEv Proposed) testRule (testGame {_rules=[testRule]})))  == Active +--testAutoDelete :: Rule+--testAutoDelete = do+--   outputAll_ "before"+--   autoDelete+--   outputAll_ "after"+--+--testAutoDeleteEx = isOutput "ok" (execRuleGame testAutoDelete testGame {_rules=[testRule {_rNumber = 1}]})+ --Time tests  testTimeEvent :: Rule@@ -399,6 +410,22 @@  testMonadicEventEx = isOutput "coco2" g where    g = execRuleInputs testMonadicEvent 1 [([BindL], (TextField 1 ""), TextData "coco1"), ([BindR, BindR], (TextField 1 ""), TextData "coco2")]++testMonadicEvent2 :: Rule+testMonadicEvent2 = do+   let displayMsg a = void $ newOutput_ Nothing a+   let e = do+       playerEvent Arrive+       inputText 1 ""+   void $ onEvent_ e displayMsg++testMonadicEvent2PlayerArrive :: Game+testMonadicEvent2PlayerArrive = flip execState testGame {_players = []} $ runSystemEval' $ do+    addActivateRule testMonadicEvent2 1+    addPlayer (PlayerInfo 1 "coco 1" Nothing)+    triggerInput 1 [BindR] (TextField 1 "") (TextData "coco2")++testMonadicEventEx2 = isOutput "coco2" testMonadicEvent2PlayerArrive  testShorcutEvent :: Rule testShorcutEvent = do
src/Nomyx/Core/Engine/Types.hs view
@@ -19,6 +19,7 @@ import Control.Monad.State import Control.Monad.Reader import GHC.Generics+import System.Random  -- * Evaluation @@ -44,7 +45,8 @@                    _outputs     :: [Output],                    _victory     :: Maybe VictoryInfo,                    _logs        :: [Log],-                   _currentTime :: UTCTime}+                   _currentTime :: UTCTime,+                   _randomGen   :: StdGen}                    deriving (Typeable)  data GameDesc = GameDesc { _desc :: String, _agora :: String} deriving (Eq, Show, Read, Ord)@@ -55,7 +57,7 @@ instance Ord Game where    compare (Game {_gameName=gn1}) (Game {_gameName=gn2}) = compare gn1 gn2 -emptyGame name desc date = Game {+emptyGame name desc date gen = Game {    _gameName      = name,    _gameDesc      = desc,    _rules         = [],@@ -65,6 +67,7 @@    _outputs       = [],    _victory       = Nothing,    _logs          = [],+   _randomGen     = gen,    _currentTime   = date}  @@ -106,6 +109,12 @@                        _output        :: NomexNE String,       -- output string                        _oStatus       :: Status}               -- status of the output                        deriving (Show)++instance Eq Output where+   (Output {_outputNumber=on1}) == (Output {_outputNumber=on2}) = on1 == on2++instance Ord Output where
+     (Output {_outputNumber=r1}) <= (Output {_outputNumber=r2}) = r1 <= r2  -- * Logs
src/Nomyx/Core/Engine/Utils.hs view
@@ -1,6 +1,15 @@ 
-module Nomyx.Core.Engine.Utils where
-+module Nomyx.Core.Engine.Utils(+   (===),+   replaceWith,+   tracePN,+   traceData,+   parse822Time,+   sndMaybe,+   mapStateIO, 
+   getFreeNumber,+   sel,+   module Debug.Trace) where  import Data.Time import Data.Typeable (cast, Typeable)
src/Nomyx/Core/Mail.hs view
@@ -72,8 +72,9 @@ sendMailsNewRule :: Session -> SubmitRule -> PlayerNumber -> IO () sendMailsNewRule s sr pn = when (_sendMails $ _mSettings $ _multi s) $ do    putStrLn "Sending mails"-   gn <- fromJustNote "sendMailsNewRule" <$> getPlayersGame pn s-   let sendMailsTo = delete pn (map _playerNumber (_players $ _game $ _loggedGame gn))+   gi <- fromJustNote "sendMailsNewRule" <$> getPlayersGame pn s+   guard (_isPublic gi)+   let sendMailsTo = delete pn (map _playerNumber (_players $ _game $ _loggedGame gi))    proposer <- Nomyx.Core.Profile.getPlayerName pn s    profiles <- mapM (getProfile s) sendMailsTo    mapM_ (send proposer (_net $ _mSettings $ _multi s) sr) (_pPlayerSettings <$> catMaybes profiles)
src/Nomyx/Core/Multi.hs view
@@ -18,6 +18,7 @@ import Nomyx.Core.Types import Nomyx.Core.Interpret import Nomyx.Core.Quotes (cr)+import System.Random  triggerTimeEvent :: UTCTime -> StateT Multi IO () triggerTimeEvent t = do@@ -62,7 +63,8 @@  initialGameInfo :: GameName -> GameDesc -> Bool -> Maybe PlayerNumber -> UTCTime -> ServerHandle -> IO GameInfo initialGameInfo name desc isPublic mpn date sh = do-   let lg = GameInfo { _loggedGame = LoggedGame (emptyGame name desc date) [],+   let gen = mkStdGen 0+   let lg = GameInfo { _loggedGame = LoggedGame (emptyGame name desc date gen) [],                        _ownedBy    = mpn,                        _forkedFromGame = Nothing,                        _isPublic = isPublic,
src/Nomyx/Core/Quotes.hs view
@@ -22,7 +22,7 @@ import Nomyx.Core.Context  --- This quasi quoter allows to type check a string as a Nomyx rule (a RuleFunc).+-- This quasi quoter allows to type check a string as a Nomyx rule. -- this gives additionnal safety at compile time. #ifdef NO_INTERPRET_QUOTES cr :: QuasiQuoter
src/Nomyx/Core/Serialize.hs view
@@ -19,6 +19,7 @@ import Nomyx.Core.Interpret import Nomyx.Core.Engine import Nomyx.Core.Engine.GameEvents+import System.Random  save :: Multi -> IO () save m = BL.writeFile (getSaveFile $ _mSettings m) (encode m)@@ -52,7 +53,7 @@ time0 = posixSecondsToUTCTime 0  instance ToJSON Game where-   toJSON (Game name desc _ _ _ _ _ _ _ _) =+   toJSON (Game name desc _ _ _ _ _ _ _ _ _) =       object ["gameName" .= name,               "gameDesc" .= desc] @@ -67,8 +68,8 @@       pure [] <*>       pure Nothing <*>       pure [] <*>-      pure time0-   -- A non-Object value is of the wrong type, so fail.+      pure time0  <*>+      pure (mkStdGen 0)    parseJSON _ = mzero  @@ -84,4 +85,5 @@ $(deriveJSON defaultOptions ''InputData) $(deriveJSON defaultOptions ''SubmitRule) $(deriveJSON defaultOptions ''GameDesc)+$(deriveJSON defaultOptions ''StdGen)
src/Nomyx/Core/Session.hs view
@@ -11,6 +11,7 @@ import Data.Time as T import Data.List import qualified Data.Acid.Advanced as A (update', query')+import Happstack.Auth.Core.Auth import Control.Category hiding ((.)) import Control.Monad.State import Control.Concurrent.STM@@ -28,6 +29,7 @@ newPlayer :: PlayerNumber -> PlayerSettings -> StateT Session IO () newPlayer uid ms = do    s <- get+   void $ A.update' (acidAuth $ _profiles s) (SetDefaultSessionTimeout $ 3600 * 24 * 7 *25)    void $ A.update' (acidProfileData $ _profiles s) (NewProfileData uid ms)  -- | starts a new game