diff --git a/Nomyx.cabal b/Nomyx.cabal
--- a/Nomyx.cabal
+++ b/Nomyx.cabal
@@ -1,5 +1,5 @@
 name: Nomyx
-version: 0.0.3
+version: 0.1.0
 cabal-version: >=1.6
 build-type: Simple
 license: BSD3
@@ -18,22 +18,24 @@
  
 executable Nomyx
     build-depends: DebugTraceHelpers -any, MonadCatchIO-mtl -any,
-                   Nomyx-Rules ==0.0.3, QuickCheck -any, base <5, binary -any,
-                   blaze-html ==0.5.*, blaze-markup -any, bytestring -any,
-                   containers -any, directory -any, eprocess -any,
-                   extensible-exceptions -any, filepath -any, happstack-server ==7.*,
-                   hdaemonize -any, hint -any, hint-server -any, hslogger -any,
-                   monad-loops -any, mtl ==2.*, mueval -any, network -any,
-                   process -any, reform -any, reform-blaze -any,
-                   reform-happstack -any, regular -any, safe -any, stm -any,
-                   text -any, time -any, unix -any, utf8-string -any,
-                   web-routes ==0.27.*, web-routes-happstack ==0.23.*,
-                   web-routes-regular ==0.19.*, web-routes-th -any
+                   Nomyx-Rules ==0.1.0, QuickCheck -any, acid-state -any, base <5,
+                   binary -any, blaze-html ==0.5.*, blaze-markup -any,
+                   bytestring -any, containers -any, data-accessor-transformers -any,
+                   directory -any, eprocess -any, extensible-exceptions -any,
+                   filepath -any, happstack-server ==7.*, hdaemonize -any, hint -any,
+                   hint-server -any, hslogger -any, mime-mail -any, monad-loops -any,
+                   mtl ==2.*, mueval -any, network -any, process -any, reform -any,
+                   reform-blaze -any, reform-happstack -any, regular -any, safe -any,
+                   stm -any, template-haskell -any, text -any, time -any, unix -any,
+                   utf8-string -any, web-routes ==0.27.*,
+                   web-routes-happstack ==0.23.*, web-routes-regular ==0.19.*,
+                   web-routes-th -any
     main-is: Main.hs
     buildable: True
     extensions: CPP
-    hs-source-dirs: src 
-    other-modules: Help Game Forms Multi Server Utils Interpret Web
-                   Commands
-    ghc-options: -W
- 
+    hs-source-dirs: src
+    other-modules: Quotes Types Mail Game Test Multi Server Serialize
+                   Utils Interpret Commands Web.Common Web.Help Web.Game Web.Login
+                   Web.Settings Web.MainPage Web.NewGame
+    ghc-options: -W 
+    -- no-omit-yield
diff --git a/TODO b/TODO
--- a/TODO
+++ b/TODO
@@ -4,28 +4,30 @@
 Features to add:
 
 - interpreter (like tryhaskell.org) on the web page to debug rules
-- store state in DB
 - make a command line client
-- make a clear login/session system
+- make a session system with cookie
 - colorize code
 - make code instructions in the active rules table clickable to access haddock documentation
-- mail server to send notices/events when other players played.
 
+
 Improves:
 
 - refresh web page when new event (currently, player needs to hit F5)
-- keep the rule in the field if compile error
 - input sanitization and error reporting
-- avoid unrecoverable "error" in variables
-- add tests in main Nomyx
 - secure interpreter with mueval: time limits, no unsafe instructions, memory limits...
+- add a name to events to be able to delete categories of them
+- add "back to main page" links
+- recognize array vars to display them properly on HCI
+- add command to rm save file
 
 Futur Nomic:
 - ability to analyse rules, proof system
 
 BUGS
-- fix moneyTransfer: accept new players, check balance is positive
 - fix rule number for variables
-- schedule: drop 1 is wrong, protect head
-- time events: some events are triggered 2 times
-- self proposed victory not working
+- check when error on parameters (for victory for example)
+- concurrent access to log file
+- sendmail is blocking the game
+- delete invalid events
+- events may be triggered twice if not deleted (in case of exception)
+
diff --git a/data/static/css/nomyx.css b/data/static/css/nomyx.css
--- a/data/static/css/nomyx.css
+++ b/data/static/css/nomyx.css
@@ -121,11 +121,9 @@
 }
 
 
-#code {
+.code {
    width:100%;
-   height:150px;
-   rows:20;
-   cols:80;
+  /* height:150px;*/
 }
 
 input[type="file"]{
diff --git a/src/Commands.hs b/src/Commands.hs
--- a/src/Commands.hs
+++ b/src/Commands.hs
@@ -1,8 +1,8 @@
 
-
 -- | This module handles intrepreting players' commands.
+-- DEPRECATED
 module Commands where
-{-
+
 import Text.ParserCombinators.Parsec
 import Data.List
 import Utils
@@ -13,7 +13,7 @@
 -- | All commands issuable.
 data Command = ListGame
 --             | Name
-			    | NewGame
+             | NewGame
              | JoinGame
              | LeaveGame
              | SubscribeGame
diff --git a/src/Forms.hs b/src/Forms.hs
deleted file mode 100644
--- a/src/Forms.hs
+++ /dev/null
@@ -1,83 +0,0 @@
-
-{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleContexts, FlexibleInstances, TemplateHaskell,
-   EmptyDataDecls, TypeFamilies, MultiParamTypeClasses, DeriveDataTypeable, PackageImports, GADTs,
-   ScopedTypeVariables, NamedFieldPuns, Rank2Types, DoAndIfThenElse, ExtendedDefaultRules#-}
-
-
-
-module Forms where
-
-import Prelude hiding (div)
-import Text.Blaze.Html5 hiding (map, label)
-import qualified Text.Blaze.Html5.Attributes as A
-import Text.Reform
-import Text.Reform.Blaze.String hiding (form)
-import Happstack.Server
-import Multi
-import Language.Nomyx.Expression
-import qualified Data.ByteString.Char8 as C
-import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
-import Control.Applicative
-import Data.Text hiding (map, zip, concatMap)
-import Data.List
-import Data.Maybe
-import Text.Reform.Happstack()
-import qualified Text.Reform.Generalized as G
-import qualified Text.Blaze.Html5  as H
-default (Integer, Double, Data.Text.Text)
-
-data LoginPass = LoginPass { login :: PlayerName,
-                             password :: PlayerPassword}
-                             deriving (Show, Eq)
-
-data NewRuleForm = NewRuleForm { ruleName :: String,
-                         ruleText :: String,
-                         ruleCode :: String,
-                         pn :: PlayerNumber }
-
-data NewGameForm = NewGameForm { newGameName :: String,
-                                 gamePn :: PlayerNumber }
-
-type NomyxForm a = Form (ServerPartT IO) [Input] String Html () a
-
-instance FormError String where
-    type ErrorInputType String = [Input]
-    commonFormError _ = "common error"
-
-
-loginForm :: NomyxForm LoginPass
-loginForm = pure LoginPass <*> label "Login: " ++> (inputText "") <*> label "    Password: " ++> (inputText "") <++ label " "
-
-inputChoiceForm :: String -> [String] -> String -> NomyxForm Int
-inputChoiceForm title choices def = label (title ++ " ") ++> inputRadio' (zip [0..] choices) ((==) $ fromJust $ elemIndex def choices)
-
-inputStringForm :: String -> NomyxForm String
-inputStringForm title = label (title ++ " ") ++> inputText ""
-
-uploadForm :: NomyxForm (FilePath, FilePath, ContentType)
-uploadForm = inputFile
-
-blazeResponse :: Html -> Response
-blazeResponse html = toResponseBS (C.pack "text/html;charset=UTF-8") $ renderHtml html
-
-blazeForm :: Html -> Text -> Html
-blazeForm html link =
-    form ! A.action (toValue link)
-         ! A.method "POST"
-         ! A.enctype "multipart/form-data" $
-            do html
-               input ! A.type_ "submit" ! A.value "Submit"
-
--- | Create a group of radio elements without BR between elements
-inputRadio' :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToMarkup lbl) =>
-              [(a, lbl)]  -- ^ value, label, initially checked
-           -> (a -> Bool) -- ^ isDefault
-           -> Form m input error Html () a
-inputRadio' choices isDefault =
-    G.inputChoice isDefault choices mkRadios
-    where
-      mkRadios nm choices' = mconcat $ concatMap (mkRadio nm) choices'
-      mkRadio nm (i, val, lbl, checked) =
-          [ ((if checked then (! A.checked "checked") else id) $
-             input ! A.type_ "radio" ! A.id (toValue i) ! A.name (toValue nm) ! A.value (toValue val))
-          ,  H.label ! A.for (toValue i) $ toHtml lbl]
diff --git a/src/Game.hs b/src/Game.hs
--- a/src/Game.hs
+++ b/src/Game.hs
@@ -14,33 +14,21 @@
 import Data.List
 import Language.Nomyx.Expression
 import Language.Nomyx.Evaluation
-import Examples
-import Data.Time.Clock as T
-
+import Language.Nomyx.Examples
 
 -- | the initial rule set for a game.
-rApplicationMetaRule = Rule  {
-    rNumber       = 1,
-    rName         = "Evaluate rule using meta-rules",
-    rDescription  = "a proposed rule will be activated if all active metarules return true",
-    rProposedBy   = 0,
-    rRuleCode     = "applicationMetaRule",
-    rRuleFunc     = applicationMetaRule,
-    rStatus       = Active,
-    rAssessedBy   = Nothing}
-
 rVoteUnanimity = Rule  {
-    rNumber       = 2,
-    rName         = "Vote Unanimity",
-    rDescription  = "meta-rule: return true if all players vote positively for a rule",
+    rNumber       = 1,
+    rName         = "Unanimity Vote",
+    rDescription  = "A proposed rule will be activated if all players vote for it",
     rProposedBy   = 0,
-    rRuleCode     = "vote unanimity",
-    rRuleFunc     = vote unanimity,
+    rRuleCode     = "onRuleProposed $ voteWith unanimity",
+    rRuleFunc     = onRuleProposed $ voteWith unanimity,
     rStatus       = Active,
     rAssessedBy   = Nothing}
 
 rVictory5Rules = Rule  {
-    rNumber       = 3,
+    rNumber       = 2,
     rName         = "Victory 5 accepted rules",
     rDescription  = "Victory is achieved if you have 5 active rules",
     rProposedBy   = 0,
@@ -49,31 +37,38 @@
     rStatus       = Active,
     rAssessedBy   = Nothing}
 
-emptyGame name date = Game { gameName      = name,
-                          rules         = [],
-                          players       = [],
-                          variables     = [],
-                          events        = [],
-                          outputs       = [],
-                          victory       = [],
-                          currentTime   = date}
+emptyGame name desc date = Game { gameName      = name,
+                             gameDesc      = desc,
+                             rules         = [],
+                             players       = [],
+                             variables     = [],
+                             events        = [],
+                             outputs       = [],
+                             victory       = [],
+                             currentTime   = date}
 
---initialGame :: Game
-initialGame name date = flip execState (emptyGame name date) $ do
+initialGame :: GameName -> String -> UTCTime -> Game
+initialGame name desc date = flip execState (emptyGame name desc date) $ do
     evAddRule rVoteUnanimity
     evActivateRule (rNumber rVoteUnanimity) 0
-    evAddRule rApplicationMetaRule
-    evActivateRule (rNumber rApplicationMetaRule) 0
     evAddRule rVictory5Rules
     evActivateRule (rNumber rVictory5Rules) 0
 
+-- | the initial rule set for a game.
+rApplicationMetaRule = Rule  {
+    rNumber       = 0,
+    rName         = "Evaluate rule using meta-rules",
+    rDescription  = "a proposed rule will be activated if all active metarules return true",
+    rProposedBy   = 0,
+    rRuleCode     = "applicationMetaRule",
+    rRuleFunc     = onRuleProposed checkWithMetarules,
+    rStatus       = Active,
+    rAssessedBy   = Nothing}
 
 -- | An helper function to use the state transformer GameState.
-execWithGame :: StateT Game IO () -> Game -> IO Game
-execWithGame gs g = do
-    t <- T.getCurrentTime
-    let g' = g {currentTime = t}
-    execStateT gs g'
+-- It additionally sets the current time.
+execWithGame :: UTCTime -> State Game () -> Game -> Game
+execWithGame t gs g = execState gs g {currentTime = t}
 
 
 --accessors
@@ -86,13 +81,6 @@
 
 rejectedRules :: Game -> [Rule]
 rejectedRules = sort . filter (\(Rule {rStatus=rs}) -> rs==Reject) . rules
-
-instance Eq Game where
-   (Game name1 _ _ _ _ _ _ _) == (Game name2 _ _ _ _ _ _ _) = name1 == name2
-
-instance Ord Game where
-   compare (Game name1 _ _ _ _ _ _ _) (Game name2 _ _ _ _ _ _ _) = compare name1 name2
-
 
 instance Ord PlayerInfo where
    h <= g = (playerNumber h) <= (playerNumber g)
diff --git a/src/Help.hs b/src/Help.hs
deleted file mode 100644
--- a/src/Help.hs
+++ /dev/null
@@ -1,23 +0,0 @@
------------------------------------------------------------------------------
---
--- Module      :  Help
--- Copyright   :
--- License     :  OtherLicense
---
--- Maintainer  :  corentin.dupont@gmail.com
--- Stability   :
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-
-module Help where
-upload = "You can upload your file containing custom rules here. File must be a haskell .hs file containing a module. Once correctly loaded, you will be able to propose the functions in the file as new rules."
-code = "This is where you type in your new rule. Its type must be \"RuleFunc\". As a first rule, you can try to type \"nothing\", which is a rule that does nothing. Other examples can be found in the file Examples.hs accessible on the left tab."
-actives = "Those rules are active and control the game. Usually, initial rules define how to propose and activate new rules (for example, a democratic vote) and how to win. Of course, this can be changed!"
-pendings = "Rules are pending after being proposed by a player. Only another, active rule can activate those rules with instruction \"activateRule\"."
-inputs = "Rules can trigger an input to gather data from the player, for example with the instruction \"onInputChoice\"."
-events = "Rules can register on events, in order to be triggered when the event happens, for example with the instruction \"onEvent\"."
-variables = "Rules can create variables to store data. For example, a rule creating a bank account with instruction \"newVar\" will make a new variable appear here."
-outputs = "Rules can display text on players screen, with instruction \"output\"."
diff --git a/src/Interpret.hs b/src/Interpret.hs
--- a/src/Interpret.hs
+++ b/src/Interpret.hs
@@ -1,5 +1,5 @@
 -- | This module starts a Interpreter server that will read our strings representing rules to convert them to plain Rules.
-module Interpret(startInterpreter, readNamedRule, interpretRule, loadModule) where
+module Interpret where
 
 import Language.Haskell.Interpreter
 import Language.Haskell.Interpreter.Server
@@ -10,10 +10,12 @@
 import System.FilePath
 import System.Posix.Files
 import Control.Monad
-
+import System.Posix.Resource
 
 modDir = "modules"
-
+importList = ["Prelude", "Language.Nomyx.Rule", "Language.Nomyx.Expression", "Language.Nomyx.Test",
+              "Language.Nomyx.Examples", "GHC.Base", "Data.Maybe"]
+              
 -- | the server handle
 startInterpreter :: IO ServerHandle
 startInterpreter = do
@@ -42,28 +44,25 @@
    loadModules fmods
    setTopLevelModules $ map (dropExtension . takeFileName) fmods
    dataDir <- liftIO getDataDir
-   set [searchPath := [dataDir]]
-   setImports ["Prelude", "Language.Nomyx.Rule", "Language.Nomyx.Expression", "Test", "Examples", "GHC.Base", "Data.Maybe"]
+   set [searchPath := [dataDir], languageExtensions := [GADTs, ScopedTypeVariables]] --, languageExtensions := [], installedModulesInScope := False
+   --TODO: get all exported modules of Nomyx library
+   setImports importList
    return ()
 
--- | reads maybe a Rule out of a string.
+---- | reads maybe a Rule out of a string.
 interpretRule :: String -> ServerHandle -> IO (Either InterpreterError RuleFunc)
-interpretRule s sh = do
-   liftIO $ runIn sh (interpret s (as :: RuleFunc))
-
-
--- | reads a Rule. May produce an error if badly formed.
-readRule :: String -> ServerHandle -> IO RuleFunc
-readRule sr sh = do
-   ir <- interpretRule sr sh
-   case ir of
-      Right r -> return r
-      Left e -> error $ "errReadRule: Rule is ill-formed. Shouldn't have happened.\n" ++ show e
+interpretRule s sh = liftIO $ runIn sh $ do
+      liftIO $ mapM_ (uncurry setResourceLimit) limits
+      interpret s (as :: RuleFunc)
+      
+cpuTimeLimitSoft = ResourceLimit 4
+cpuTimeLimitHard = ResourceLimit 5
 
--- | reads a NamedRule. May produce an error if badly formed.
-readNamedRule :: Rule -> ServerHandle -> IO RuleFunc
-readNamedRule r sh = readRule (rRuleCode r) sh
 
+limits :: [(Resource, ResourceLimits)]
+limits = [ (ResourceCPUTime,      ResourceLimits cpuTimeLimitSoft cpuTimeLimitHard)]
+         
+
 -- | check an uploaded file and reload
 loadModule :: FilePath -> FilePath -> ServerHandle -> IO (Either InterpreterError ())
 loadModule dir name sh = do
@@ -78,7 +77,7 @@
             runIn sh $ initializeInterpreter
             return $ Left e
 
--- | check if a module is valid. Context will be reset.
+---- | check if a module is valid. Context will be reset.
 checkModule :: FilePath -> ServerHandle -> IO (Either InterpreterError ())
 checkModule dir sh = runIn sh $ do
    fmods <- liftIO getUploadModules
diff --git a/src/Mail.hs b/src/Mail.hs
new file mode 100644
--- /dev/null
+++ b/src/Mail.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules, OverloadedStrings, NamedFieldPuns#-}
+
+
+module Mail where
+
+import Text.Blaze.Html5 hiding (map, label, br)
+import qualified Text.Blaze.Html5 as H
+import Text.Blaze.Html.Renderer.String
+import Network.Mail.Mime hiding (mailTo)
+import Prelude hiding (div)
+import Text.Reform.Happstack()
+import Control.Monad
+import Types
+import Language.Nomyx.Expression
+import Data.Text(Text, pack)
+import Control.Concurrent
+import Data.Maybe
+import Utils
+import Control.Exception
+import qualified Data.Text.Lazy as B
+default (Integer, Double, Data.Text.Text)
+
+
+sendMail :: String -> String -> String -> IO()
+sendMail to object body = do
+   putStrLn $ "sending a mail to " ++ to
+   forkIO $ simpleMail (Address Nothing (pack to)) (Address (Just "Nomyx Game") "corentin.dupont@gmail.com") (pack object) "" (B.pack body) [] >>= renderSendMail
+   putStrLn $ "done"
+   return ()
+
+newRuleBody :: PlayerName -> SubmitRule -> PlayerName -> Network -> Html
+newRuleBody playerName (SubmitRule name desc code) prop net = docTypeHtml $ do
+   (toHtml $ "Dear " ++ playerName ++ ",") >> H.br
+   (toHtml $ "a new rule has been proposed by player " ++ prop ++ ".") >> H.br
+   (toHtml $ "Name: " ++ name) >> H.br
+   (toHtml $ "Description: " ++ desc) >> H.br
+   (toHtml $ "Code: " ++ code) >> H.br >> H.br
+   (toHtml $ "Please login into Nomyx for actions on this rule:") >> H.br
+   (toHtml $ nomyxURL net ++ "/Nomyx") >> H.br >> H.br
+   (toHtml $ "You received this mail because you subscribed to Nomyx. To stop receiving mails, login to Nomyx with the above address, go to Settings and uncheck the corresponding box.") >> H.br
+
+newRuleObject :: PlayerName -> String
+newRuleObject name = "[Nomyx] New rule posted by player " ++ name ++ "!"
+
+sendMailsNewRule :: Multi -> SubmitRule -> PlayerNumber -> IO()
+sendMailsNewRule m sr pn = do
+   evaluate m
+   let gn = gameName $ fromJust $ getPlayersGame pn m
+   let proposer = getPlayersName pn m
+   forM_ (mPlayers m) $ send proposer gn
+   where send prop gn pm = when ((Just gn == inGame pm) && (mailNewRule $ mMail pm)) $ \
+      sendMail (mailTo $ mMail pm) (newRuleObject prop) (renderHtml $ newRuleBody (mPlayerName pm) sr prop (net m))
+
+   
+mapMaybeM :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m [b]
+mapMaybeM f = liftM catMaybes . mapM f
+
+getOutputs :: Multi -> [Output]
+getOutputs m = concatMap outputs $ games m
+
+newRulebody :: Rule -> String
+newRulebody (Rule {rNumber, rProposedBy}) = "Rule number " ++ (show rNumber) ++ " has been proposed by player " ++ (show rProposedBy)
+
+
+
diff --git a/src/Main.hs b/src/Main.hs
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -11,24 +11,39 @@
 -- |
 --
 -----------------------------------------------------------------------------
-
+{-# LANGUAGE GADTs, DoAndIfThenElse #-}
+    
 module Main (main) where
-
+
+import Prelude hiding (catch)
 import System.Console.GetOpt 
 import System.Environment 
-import Web
-import Multi
+import Web.MainPage
 import Control.Concurrent
 import Interpret
 import Control.Concurrent.STM
 import qualified System.Posix.Signals as S
-import Control.Monad.CatchIO
+import Control.Monad.CatchIO hiding (catch)
 import Control.Monad.Trans
-import Test
+import Language.Nomyx.Test as LT
 import Data.Maybe
 import Safe
 import Network.BSD
+import System.Posix.Daemonize
+import Types
+import Serialize
+import Paths_Nomyx as PN
+import Language.Haskell.Interpreter.Server hiding (start)
+import System.Directory
+import Data.Time.Clock
+import Language.Nomyx.Expression
+import Control.Monad
+import Control.Exception hiding (bracket)
+import Test
+import Utils
 
+defaultLogFile :: FilePath
+defaultLogFile = "Nomyx.save"
 
 -- | Entry point of the program.
 main :: IO Bool
@@ -38,45 +53,73 @@
    (flags, _) <- nomyxOpts args
    --parseActions flags
    --let verbose = Verbose `elem` flags
-   if Test `elem` flags
-      then do
-         putStrLn $ "Tests result: " ++ show allTests
-         return allTests
-      else do
-         serverCommandUsage
-         multi <- newTVarIO defaultMulti
-         --start the haskell interpreter
-         sh <- protectHandlers startInterpreter
-         --start the web server
-         port <- case (findPort flags) of
-            Just p -> return $ read p
-            Nothing -> return $ read "8000"
-         host <- case (findHost flags) of
-            Just h -> return h
-            Nothing -> getHostName >>= return
-         forkIO $ launchWebServer sh multi host port
-         forkIO $ launchTimeEvents multi
-         --loop
-         serverLoop multi
-         return True
+   case (Daemon `elem` flags) of
+       True -> (daemonize $ start flags) >> return True
+       False -> start flags >> return True
 
+start :: [Flag] -> IO ()
+start flags = do
+   serverCommandUsage
+   --start the haskell interpreter
+   sh <- protectHandlers startInterpreter
+   if Test `elem` flags then do
+      putStrLn $ "\nNomyx Language Tests results:\n" ++ (concatMap (\(a,b) -> a ++ ": " ++ (show b) ++ "\n") LT.tests)
+      ts <- playTests sh
+      putStrLn $ "\nNomyx Game Tests results:\n" ++ (concatMap (\(a,b) -> a ++ ": " ++ (show b) ++ "\n") ts)
+   else do
+      --creating game structures
+      logFile <- case (findSaveFile flags) of
+         Just f -> return f
+         Nothing -> return defaultLogFile
+      port <- case (findPort flags) of
+         Just p -> return $ read p
+         Nothing -> return $ 8000
+      host <- case (findHost flags) of
+         Just h -> return h
+         Nothing -> getHostName >>= return
+      logFilePath <- getDataFileName logFile
+      multi <- case (findLoadTest flags) of
+         Just testName -> loadTestName logFilePath sh (Network host port) testName
+         Nothing -> loadMulti logFilePath sh (Network host port)
+      tvMulti <- atomically $ newTVar multi
+      --start the web server
+      forkIO $ launchWebServer tvMulti (Network host port)
+      forkIO $ launchTimeEvents tvMulti
+      --main loop
+      serverLoop tvMulti logFile
+
+loadMulti :: FilePath -> ServerHandle -> Network -> IO Multi
+loadMulti fp sh net = do
+   fileExists <- doesFileExist fp
+   t <- getCurrentTime
+   multi <- case fileExists of
+      True -> do
+         putStrLn "Loading previous game"
+         (loadEvents fp sh net) `catch`
+            (\e -> (putStrLn $ "Error while loading logged events, log file discarded\n" ++ (show (e::ErrorCall))) >> (return $ defaultMulti sh fp net t))
+      False -> return $ defaultMulti sh fp net t
+   return multi
+
+
 -- | a loop that will handle server commands
-serverLoop :: TVar Multi -> IO ()
-serverLoop tm = do
+serverLoop :: TVar Multi -> FilePath -> IO ()
+serverLoop tm f = do
    s <- getLine
    case s of
       "d" -> do
          m <- atomically $ readTVar tm
          putStrLn $ show m
-         serverLoop tm
+         serverLoop tm f
       "s" -> do
          putStrLn "saving state..."
-         --createCheckpoint c
-         serverLoop tm
+         m <- atomically $ readTVar tm
+         fp <- getDataFileName f
+         save fp $ logEvents $ logs m
+         serverLoop tm f
       "q" -> return ()
       _ -> do
          putStrLn "command not recognized"
-         serverLoop tm
+         serverLoop tm f
 
 serverCommandUsage :: IO ()
 serverCommandUsage = do
@@ -87,17 +130,20 @@
 
 -- | Launch mode 
 data Flag 
-     = Verbose | Version | Test | HostName String | Port String
+     = Verbose | Version | Test | HostName String | Port String | LogFile FilePath | Daemon | LoadTest String
        deriving (Show, Eq)
 
 -- | launch options description
 options :: [OptDescr Flag]
 options =
-     [ Option ['v']     ["verbose"] (NoArg Verbose)       "chatty output on stderr"
-     , Option ['V','?'] ["version"] (NoArg Version)       "show version number"
-     , Option ['t']     ["tests"]   (NoArg Test)          "perform routine check"
-     , Option ['h']     ["host"]    (ReqArg HostName "Hostname")      "specify host name"
-     , Option ['p']     ["port"]    (ReqArg Port "Port")           "specify port"
+     [ Option ['v']     ["verbose"]  (NoArg Verbose)              "chatty output on stderr"
+     , Option ['V','?'] ["version"]  (NoArg Version)              "show version number"
+     , Option ['t']     ["tests"]    (NoArg Test)                 "perform routine check"
+     , Option ['h']     ["host"]     (ReqArg HostName "Hostname") "specify host name"
+     , Option ['p']     ["port"]     (ReqArg Port "Port")         "specify port"
+     , Option ['r']     ["read"]     (ReqArg LogFile "SaveFile")  "specify save file"
+     , Option ['d']     ["daemon"]   (NoArg Daemon)               "run in daemon mode"
+     , Option ['l']     ["loadtest"] (ReqArg LoadTest "TestName") "specify name of test to load"
      ]
     
 nomyxOpts :: [String] -> IO ([Flag], [String])
@@ -117,6 +163,16 @@
     isHost (HostName a) = Just a
     isHost _ = Nothing
 
+findLoadTest :: [Flag] -> Maybe String
+findLoadTest fs = headMay $ catMaybes $ map isLoadTest fs where
+    isLoadTest (LoadTest a) = Just a
+    isLoadTest _ = Nothing
+
+findSaveFile :: [Flag] -> Maybe FilePath
+findSaveFile fs = headMay $ catMaybes $ map isSaveFile fs where
+    isSaveFile (LogFile a) = Just a
+    isSaveFile _ = Nothing
+
 helper :: MonadCatchIO m => S.Handler -> S.Signal -> m S.Handler
 helper handler signal = liftIO $ S.installHandler signal handler Nothing
 
@@ -136,3 +192,34 @@
 
 protectHandlers :: MonadCatchIO m => m a -> m a
 protectHandlers a = bracket saveHandlers restoreHandlers $ const a
+
+triggerTimeEvent :: TVar Multi -> UTCTime -> IO()
+triggerTimeEvent tm t = do
+    m <- atomically $ readTVar tm
+    m' <- execWithMulti t (update (TE t (MultiTimeEvent t)) Nothing) m
+    atomically $ writeTVar tm m'
+
+
+-- | get all events that has not been triggered yet
+getTimeEvents :: UTCTime -> TVar Multi -> IO([UTCTime])
+getTimeEvents now tm = do
+    m <- atomically $ readTVar tm
+    let times = catMaybes $ map getTimes $ concatMap events $ games m
+    return $ filter (\t -> t <= now && t > (-2) `addUTCTime` now) times
+
+
+launchTimeEvents :: TVar Multi -> IO()
+launchTimeEvents tm = do
+    now <- getCurrentTime
+    --putStrLn $ "tick " ++ (show now)
+    timeEvents <- getTimeEvents now tm
+    when (length timeEvents /= 0) $ putStrLn "found time event(s)"
+    mapM_ (triggerTimeEvent tm) timeEvents
+    --sleep 1 second roughly
+    threadDelay 1000000
+    launchTimeEvents tm
+
+
+getTimes :: EventHandler -> Maybe UTCTime
+getTimes (EH _ _ (Time t) _) = Just t
+getTimes _ = Nothing
diff --git a/src/Multi.hs b/src/Multi.hs
--- a/src/Multi.hs
+++ b/src/Multi.hs
@@ -1,6 +1,6 @@
-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, GeneralizedNewtypeDeriving,
+{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, ScopedTypeVariables,
     MultiParamTypeClasses, TemplateHaskell, TypeFamilies, TypeOperators,
-    TypeSynonymInstances, FlexibleInstances, GADTs #-}
+    TypeSynonymInstances, FlexibleInstances, GADTs, NamedFieldPuns, DoAndIfThenElse #-}
 
 -- | This module manages multi-player games and commands.
 module Multi where
@@ -17,320 +17,286 @@
 import Game
 import Utils
 import Interpret
-import Data.Typeable
-import Data.Function (on)
 import Debug.Trace.Helpers()
 import Language.Nomyx.Expression
 import Data.Time
-import Language.Haskell.Interpreter.Server
+import Language.Haskell.Interpreter.Server (ServerHandle)
 import Language.Nomyx.Evaluation
-import Control.Concurrent.STM
 import Data.Maybe
-import Control.Concurrent
-
-
-type PlayerPassword = String
-
-data PlayerMulti = PlayerMulti   { mPlayerNumber :: PlayerNumber,
-                                   mPlayerName :: PlayerName,
-                                   mPassword :: PlayerPassword,
-                                   inGame :: Maybe GameName}
-                                   deriving (Eq, Show, Typeable)
-
---- | A structure to hold the active games and players
-data Multi = Multi { games   :: [Game],
-                     mPlayers :: [PlayerMulti]}
-                     deriving (Eq, Typeable)
-
-instance Show Multi where
-   show Multi{games=gs, mPlayers=mps} = show (sort gs) ++ "\n" ++ show (sort mps)
-
-defaultMulti :: Multi
-defaultMulti = Multi [] []
+import Types
+import Control.Applicative
+import Control.Exception
+import Debug.Trace.Helpers
 
 -- | helper function to change a player's ingame status.
 mayJoinGame :: Maybe GameName -> PlayerNumber -> [PlayerMulti] -> [PlayerMulti]
-mayJoinGame maybename pn pl = case find (\(PlayerMulti mypn _ _ _) -> mypn == pn) pl of
+mayJoinGame maybename pn pl = case find (\(PlayerMulti mypn _ _ _ _ _) -> mypn == pn) pl of
                      Just o -> replace o o{ inGame = maybename} pl
                      Nothing -> pl
 
-newPlayerU :: PlayerMulti -> StateT Multi IO ()
+newPlayerU :: PlayerMulti -> State Multi ()
 newPlayerU pm = do
    pms <- gets mPlayers
    modify (\multi -> multi { mPlayers = pm : pms})
 
-findPlayer :: PlayerName -> StateT Multi IO (Maybe PlayerMulti)
-findPlayer name =  fmap (find (\PlayerMulti {mPlayerName = pn} -> pn==name)) (gets mPlayers)
 
-getNewPlayerNumber :: StateT Multi IO PlayerNumber
+getNewPlayerNumber :: State Multi PlayerNumber
 getNewPlayerNumber = do
    ps <- gets mPlayers
    return $ length ps + 1
 
 
-addNewGame :: Game -> StateT Multi IO ()
+addNewGame :: Game -> State Multi ()
 addNewGame new = modify (\multi@Multi {games=gs} -> multi {games =  new:gs})
 
-getGameByName :: GameName -> StateT Multi IO (Maybe Game)
+getGameByName :: GameName -> State Multi (Maybe Game)
 getGameByName gn =  fmap (find (\(Game {gameName = n}) -> n==gn)) (gets games)
 
-joinGamePlayer :: PlayerNumber -> GameName -> StateT Multi IO ()
+joinGamePlayer :: PlayerNumber -> GameName -> State Multi ()
 joinGamePlayer pn game = modify (\multi -> multi {mPlayers = mayJoinGame (Just game) pn (mPlayers multi)})
 
 
-leaveGameU :: PlayerNumber -> StateT Multi IO ()
+leaveGameU :: PlayerNumber -> State Multi ()
 leaveGameU pn = modify (\multi -> multi {mPlayers = mayJoinGame Nothing pn (mPlayers multi)})
 
 -- | list the active games
-listGame :: PlayerNumber -> StateT Multi IO ()
+listGame :: PlayerNumber -> State Multi ()
 listGame _ = do
    gs <- gets games
    case length gs of
-      0 -> say "No active games"
+      0 -> traceM "No active games"
       _ -> do
-         say "Active games:"
-         say $ concatMap (\g -> gameName g ++ "\n") gs
+         traceM "Active games:"
+         traceM $ concatMap (\g -> gameName g ++ "\n") gs
 
 -- | starts a new game
-newGame :: String -> PlayerNumber -> StateT Multi IO ()
-newGame name _ = do
+newGame :: GameName -> String -> PlayerNumber -> State Multi ()
+newGame name desc _ = do
    gs <- gets games
    case null $ filter (\p -> gameName p == name) gs of
       True -> do
-         say $ "Creating a new game of name: " ++ name
-         t <- liftIO getCurrentTime
+         traceM $ "Creating a new game of name: " ++ name
+         t <- gets mCurrentTime
          -- create a game with zero players
-         modify (\m -> m {games = (initialGame name t):gs})
-      False -> say $ "this name is already used"
+         modify (\m -> m {games = (initialGame name desc t):gs})
+      False -> traceM $ "this name is already used"
 
 uniqueGame :: String -> [Game] -> Bool
 uniqueGame s gs = null $ filter (\p -> gameName p == s) gs
 
 -- | join a game.
-joinGame :: GameName -> PlayerNumber -> StateT Multi IO ()
+joinGame :: GameName -> PlayerNumber -> State Multi ()
 joinGame game pn = do
    mg <- getGameByName game
    case mg of
-      Nothing -> say $ "No game by that name"
+      Nothing -> traceM $ "No game by that name"
       Just g -> do
-         say "subscribing first."
+         traceM "subscribing first."
          subscribeGame (gameName g) pn
-         say $ "Joining game: " ++ game
+         traceM $ "Joining game: " ++ game
          joinGamePlayer pn game
 
 
 -- | leave a game (you remain subscribed).
-leaveGame :: PlayerNumber -> StateT Multi IO  ()
+leaveGame :: PlayerNumber -> State Multi ()
 leaveGame pn = do
    leaveGameU pn
-   say "You left the game (you remain subscribed)."
+   traceM "You left the game (you remain subscribed)."
 
 
 -- | subcribe to a game.
-subscribeGame :: GameName -> PlayerNumber -> StateT Multi IO ()
+subscribeGame :: GameName -> PlayerNumber -> State Multi ()
 subscribeGame game pn = do
    m <- get
    inGameDo game $ do
       g <- get
       case find (\(PlayerInfo  { playerNumber=mypn}) -> mypn == pn ) (players g) of
-         Just _ -> say "Already subscribed!"
+         Just _ -> traceM "Already subscribed!"
          Nothing -> do
-            say $ "Subscribing to game: " ++ game
+            traceM $ "Subscribing to game: " ++ game
             let player = PlayerInfo { playerNumber = pn, playerName = getPlayersName pn m}
             put g {players = player : (players g)}
-            liftT $ triggerEvent (Player Arrive) (PlayerData player)
+            triggerEvent (Player Arrive) (PlayerData player)
 
 
 -- | subcribe to a game.
-unsubscribeGame :: GameName -> PlayerNumber -> StateT Multi IO ()
+unsubscribeGame :: GameName -> PlayerNumber -> State Multi ()
 unsubscribeGame game pn = inGameDo game $ do
    g <- get
    case find (\(PlayerInfo  { playerNumber=mypn}) -> mypn == pn ) (players g) of
-      Nothing -> say "Not subscribed!"
+      Nothing -> traceM "Not subscribed!"
       Just _ -> do
-         say $ "Unsubscribing to game: " ++ game
+         traceM $ "Unsubscribing to game: " ++ game
          let player = PlayerInfo { playerNumber = pn, playerName = getPlayersName' g pn}
          put g {players = filter (\PlayerInfo { playerNumber = mypn} -> mypn /= pn) (players g)}
-         liftT $ triggerEvent (Player Leave) (PlayerData player)
+         triggerEvent (Player Leave) (PlayerData player)
 
 
-showSubGame :: GameName -> PlayerNumber -> StateT Multi IO  ()
+showSubGame :: GameName -> PlayerNumber -> State Multi ()
 showSubGame g _ = inGameDo g $ do
    ps <- gets players
-   say $ concatMap show ps
+   traceM $ concatMap show ps
 
-showSubscribtion :: PlayerNumber -> StateT Multi IO  ()
-showSubscribtion pn = inPlayersGameDo pn $ do
+showSubscribtion :: PlayerNumber -> State Multi ()
+showSubscribtion pn = inPlayersGameDo_ pn $ do
    ps <- gets players
-   say $ concatMap show ps
+   traceM $ concatMap show ps
 
 
+
+
 -- | insert a rule in pending rules.
-submitRule :: String -> String -> String -> PlayerNumber -> ServerHandle -> StateT Multi IO  ()
-submitRule name text rule pn sh = inPlayersGameDo pn $ do
-   --input the new rule (may fail if ill-formed)
-   rs <- gets rules
-   let rn = getFreeNumber $ map rNumber rs
-   mnr <- enterRule rn name text rule pn sh
+submitRule :: SubmitRule -> PlayerNumber -> ServerHandle -> StateT Multi IO ()
+submitRule sr pn sh = do
+   mnr <- enterRule sr pn sh
    case mnr of
       Just nr -> do
-         r <- liftT $ evProposeRule nr
-         if r == True then say $ "Your rule has been added to pending rules."
-             else say $ "Error: Rule could not be proposed"
-         return ()
-      Nothing -> say $ "Please try again."
+         inPlayersGameDo' pn $ do
+            r <- evProposeRule nr
+            if r == True then traceM $ "Your rule has been added to pending rules."
+            else traceM $ "Error: Rule could not be proposed"
+         liftT $ updateLastRule Nothing pn
+      Nothing -> liftT $ updateLastRule (Just sr) pn
 
-inputChoiceResult :: EventNumber -> Int -> PlayerNumber -> StateT Multi IO  ()
-inputChoiceResult eventNumber choiceIndex pn = inPlayersGameDo pn $ liftT $ triggerChoice eventNumber choiceIndex
 
-inputStringResult :: Event InputString -> String -> PlayerNumber -> StateT Multi IO  ()
-inputStringResult event input pn = inPlayersGameDo pn $ liftT $ triggerEvent event (InputStringData input)
+-- | reads a rule.
+enterRule :: SubmitRule -> PlayerNumber -> ServerHandle -> StateT Multi IO (Maybe Rule)
+enterRule (SubmitRule name desc code) pn sh = do
+   mrr <- lift $ interpretRule code sh
+   join <$> (inPlayersGameDo' pn $ do
+      rs <- gets rules
+      let rn = getFreeNumber $ map rNumber rs
 
-inputUpload :: PlayerNumber -> FilePath -> String -> ServerHandle -> StateT Multi IO  ()
-inputUpload pn dir mod sh = inPlayersGameDo pn $ do
+      case mrr of
+         Right ruleFunc -> return $ Just Rule {rNumber = rn,
+                      rName = name,
+                      rDescription = desc,
+                      rProposedBy = pn,
+                      rRuleCode = code,
+                      rRuleFunc = ruleFunc,
+                      rStatus = Pending,
+                      rAssessedBy = Nothing}
+         Left e -> do
+            output ("Compiler error: " ++ show e ++ "\n") pn
+            return Nothing)
+
+updateLastRule :: Maybe SubmitRule -> PlayerNumber -> State Multi ()
+updateLastRule msr pn = do
+   pm <- fromJust <$> findPlayer' pn
+   pls <- gets mPlayers
+   let pls' = replace pm (pm {lastRule = msr}) pls
+   modify (\m -> m{mPlayers = pls'})
+
+--cpuTimeLimitSoft = ResourceLimit 4
+--cpuTimeLimitHard = ResourceLimit 5
+--limits :: [(Resource, ResourceLimits)]
+--limits = [ (ResourceCPUTime,      ResourceLimits cpuTimeLimitSoft cpuTimeLimitHard)]
+
+inputChoiceResult :: EventNumber -> Int -> PlayerNumber -> State Multi ()
+inputChoiceResult eventNumber choiceIndex pn = inPlayersGameDo_ pn $ triggerChoice eventNumber choiceIndex
+
+-- TODO maybe homogeneise both inputs event
+inputStringResult :: Event InputString -> String -> PlayerNumber -> State Multi ()
+inputStringResult event input pn = inPlayersGameDo_ pn $ triggerEvent event (InputStringData input)
+
+inputUpload :: PlayerNumber -> FilePath -> String -> ServerHandle -> StateT Multi IO ()
+inputUpload pn dir mod sh = do
     m <- lift $ loadModule dir mod sh
     case m of
       Right _ -> do
-         output pn $ "File loaded: " ++ show dir ++ " Module " ++ show mod ++"\n"
+         inPlayersGameDo'_ pn $ output ("File loaded: " ++ show dir ++ " Module " ++ show mod ++"\n") pn
          return ()
       Left e -> do
-         output pn $ "Compiler error: " ++ show e ++ "\n"
+         inPlayersGameDo'_ pn $ output ("Compiler error: " ++ show e ++ "\n") pn
          return ()
 
-output :: PlayerNumber -> String -> StateT Game IO ()
-output pn s = modify (\game -> game { outputs = (pn, s) : (outputs game)})
 
--- | finds the corresponding game in the multistate and replaces it.
-modifyGame :: Game -> StateT Multi IO  ()
-modifyGame g = do
-   Multi gs ps <- get
-   case find (\myg -> gameName g == gameName myg) gs of
-      Nothing -> error "modifyGame: No game by that name"
-      Just oldg -> do
-         let newgs = replace oldg g gs
-         put $ Multi newgs ps
-
--- | reads a rule.
-enterRule :: RuleNumber -> String -> String -> String -> PlayerNumber -> ServerHandle -> StateT Game IO (Maybe Rule)
-enterRule num name text ruleText pn sh = do
-   mrr <- lift $ interpretRule ruleText sh
-   case mrr of
-      Right ruleFunc -> return $ Just Rule {rNumber = num,
-                      rName = name,
-                      rDescription = text,
-                      rProposedBy = pn,
-                      rRuleCode = ruleText,
-                      rRuleFunc = ruleFunc,
-                      rStatus = Pending,
-                      rAssessedBy = Nothing}
-      Left e -> do
-         output pn $ "Compiler error: " ++ show e ++ "\n"
-         return Nothing
-
+mailSettings :: MailSettings -> PlayerNumber -> State Multi ()
+mailSettings mailSettings pn = do
+   mps <- gets mPlayers
+   case find (\(PlayerMulti {mPlayerNumber}) -> pn==mPlayerNumber) mps of
+      Nothing -> traceM "settings not modified!"
+      Just pm -> do
+         let newmps = replace pm pm{mMail=mailSettings} mps
+         modify (\m -> m{mPlayers = newmps})
 
 -- | show the constitution.
-showConstitution :: PlayerNumber -> StateT Multi IO ()
-showConstitution pn = inPlayersGameDo pn $ get >>= (say  .  show  .  activeRules)
+showConstitution :: PlayerNumber -> State Multi ()
+showConstitution pn = inPlayersGameDo_ pn $ get >>= (traceM  .  show  .  activeRules)
 
 
 -- | show every rules (including pendings and deleted)
-showAllRules :: PlayerNumber -> StateT Multi IO ()	
-showAllRules pn = inPlayersGameDo pn $ get >>= (say . show . rules)
+showAllRules :: PlayerNumber -> State Multi ()	
+showAllRules pn = inPlayersGameDo_ pn $ get >>= (traceM . show . rules)
 
 displayPlayer :: PlayerMulti -> String
-displayPlayer (PlayerMulti pn name _ (Just game)) = show pn ++ ": " ++ name ++ " in game: " ++ game ++ "\n"
-displayPlayer (PlayerMulti pn name _ Nothing)     = show pn ++ ": " ++ name ++ "\n"
+displayPlayer (PlayerMulti pn name _ _ (Just game) _) = show pn ++ ": " ++ name ++ " in game: " ++ game ++ "\n"
+displayPlayer (PlayerMulti pn name _ _ Nothing _)     = show pn ++ ": " ++ name ++ "\n"
 
 
--- | quit the game
-quit :: PlayerNumber -> IO ()
-quit _ = putStrLn "quit"
-
 -- | Utility functions
 
 -- | replace the player's name in the list
 setName :: String -> PlayerNumber -> [PlayerMulti] -> [PlayerMulti]
-setName name pn pl = case find (\(PlayerMulti h _ _ _) -> h == pn) pl of
+setName name pn pl = case find (\(PlayerMulti h _ _ _ _ _) -> h == pn) pl of
                         Just o -> replace o o{ mPlayerName = name} pl
                         Nothing -> pl
 
 
--- | returns the game the player is in						
-getPlayersGame :: PlayerNumber -> Multi -> Maybe Game
-getPlayersGame pn multi = do
-        pi <- find (\(PlayerMulti n _ _ _) -> n==pn) (mPlayers multi)
-        gn <- inGame pi
-        find (\(Game {gameName=name}) -> name==gn) (games multi)
 
-getPlayersName :: PlayerNumber -> Multi -> PlayerName
-getPlayersName pn multi = do
-   case find (\(PlayerMulti n _ _ _) -> n==pn) (mPlayers multi) of
-      Nothing -> error "getPlayersName: No player by that number"
-      Just pm -> mPlayerName pm
-
-getPlayersName' :: Game -> PlayerNumber -> PlayerName
-getPlayersName' g pn = do
-   case find (\(PlayerInfo n _) -> n==pn) (players g) of
-      Nothing -> error "getPlayersName: No player by that number in that game"
-      Just pm -> playerName pm
-
 -- | this function apply the given game actions to the game the player is in.
-inPlayersGameDo :: PlayerNumber -> StateT Game IO () -> StateT Multi IO ()
+inPlayersGameDo :: PlayerNumber -> State Game a -> State Multi (Maybe a)
 inPlayersGameDo pn action = do
    multi <- get
+   t <- gets mCurrentTime
    let mg = getPlayersGame pn multi
    case mg of
-      Nothing -> say "You must be in a game"
+      Nothing -> traceM "You must be in a game" >> return Nothing
       Just g -> do
-         myg <- lift $ execWithGame action g
+         (a, myg) <- lift $ runStateT action (g { currentTime = t})
          modifyGame myg
+         return (Just a)
 
-inGameDo :: GameName -> StateT Game IO () -> StateT Multi IO ()
+inPlayersGameDo_ :: PlayerNumber -> State Game a -> State Multi ()
+inPlayersGameDo_ pn action = inPlayersGameDo pn action >> return ()
+
+inPlayersGameDo' :: PlayerNumber -> State Game a -> StateT Multi IO (Maybe a)
+inPlayersGameDo' pn gs = do
+    m <- get
+    let (a, m') = runState (inPlayersGameDo pn gs) m
+    put m'
+    return a
+
+inPlayersGameDo'_ :: PlayerNumber -> State Game a -> StateT Multi IO ()
+inPlayersGameDo'_ pn action = inPlayersGameDo' pn action >> return ()
+
+inGameDo :: GameName -> State Game () -> State Multi ()
 inGameDo game action = do
    gs <- gets games
    case find (\(Game {gameName =n}) -> n==game) gs of
-      Nothing -> say "No game by that name"
+      Nothing -> traceM "No game by that name"
       Just g -> do
-         myg <- lift $ execWithGame action g
+         t <- gets mCurrentTime
+         let myg = execWithGame t action g
          modifyGame myg
 
-instance Ord PlayerMulti where
-  (<=) = (<=) `on` mPlayerNumber
 
+triggerTimeEvent :: UTCTime -> StateT Multi IO ()
+triggerTimeEvent t = do
+   gs <- gets games
+   gs' <- lift $ mapM (\g -> trig t g `catch` timeExceptionHandler t g) gs
+   modify(\m -> m{games = gs'})
 
-triggerTimeEvent :: TVar Multi -> UTCTime -> IO()
-triggerTimeEvent tm t = do
-    m <- atomically $ readTVar tm
-    gs' <- mapM (trig t) (games m)
-    let m' = m {games = gs'}
-    atomically $ writeTVar tm m'
-       where trig t g =  execWithGame (liftT $ evTriggerTime t) g
 
-execGame :: State Game () -> Game -> Game
-execGame s g = execState s g
-
--- | get all events within time and time + 2 second
-getTimeEvents :: UTCTime -> TVar Multi -> IO([UTCTime])
-getTimeEvents time tm = do
-    m <- atomically $ readTVar tm
-    let times = catMaybes $ map getTimes $ concatMap events $ games m
-    return $ filter (\t-> t >= time && t < addUTCTime 2 time) times
-
---TODO: fix this
-launchTimeEvents :: TVar Multi -> IO()
-launchTimeEvents tm = do
-    now <- getCurrentTime
-    --putStrLn $ "tick " ++ (show now)
-    schedule <- getTimeEvents now tm
-    when (length schedule /= 0) $ putStrLn "found time event"
-    mapM_ (triggerTimeEvent tm) schedule
-    after <- getCurrentTime
-    --sleep 1 second minus rough delay of execution
-    threadDelay $ truncate(1000000 - 1000000*(diffUTCTime after now))
-    launchTimeEvents tm
-
+trig :: UTCTime -> Game -> IO Game
+trig t g =  do
+   let g' = execWithGame t (evTriggerTime t) g
+   evaluate g'
+   return g'
 
-getTimes :: EventHandler -> Maybe UTCTime
-getTimes (EH _ _ (Time t) _) = Just t
-getTimes _ = Nothing
+timeExceptionHandler :: UTCTime -> Game -> ErrorCall -> IO Game
+timeExceptionHandler t g e = do
+   putStrLn $ "Error in triggerTimeEvent: " ++ (show e)
+   return $ execWithGame t (outputAll $ "Error while triggering a time event: " ++ (show e) ++
+                           "\nThe event have been canceled. Please remove/fix the faulty rule.") g
 
diff --git a/src/Quotes.hs b/src/Quotes.hs
new file mode 100644
--- /dev/null
+++ b/src/Quotes.hs
@@ -0,0 +1,40 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Quotes
+-- Copyright   :
+-- License     :  BSD3
+--
+-- Maintainer  :  corentin.dupont@gmail.com
+-- Stability   :
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
+{-# LANGUAGE NamedFieldPuns, TemplateHaskell, QuasiQuotes #-}
+
+module Quotes where
+
+import Language.Haskell.TH as TH
+import Language.Haskell.TH.Quote
+import Language.Haskell.Interpreter hiding (get)
+import Interpret
+
+cr :: QuasiQuoter
+cr = QuasiQuoter { quoteExp = quoteRuleFunc,
+                   quotePat = undefined,
+                   quoteType = undefined,
+                   quoteDec = undefined}
+
+quoteRuleFunc :: String -> Q TH.Exp
+quoteRuleFunc s = do
+   res <- runIO $ runInterpreter $ do
+      setImports importList
+      typeOf s
+   case res of
+      Right "RuleFunc" -> [| s |]
+      Right _ -> fail $ "Rule doesn't typecheck"
+      Left e -> fail $ show e
+
+
+
diff --git a/src/Serialize.hs b/src/Serialize.hs
new file mode 100644
--- /dev/null
+++ b/src/Serialize.hs
@@ -0,0 +1,83 @@
+
+{-# LANGUAGE NamedFieldPuns, FlexibleInstances #-}
+
+module Serialize where
+
+import Prelude hiding (log, catch)
+import Language.Nomyx.Expression
+import Control.Monad.State
+import Types
+import Multi
+import Language.Haskell.Interpreter.Server
+import Control.Applicative
+import Data.Time.Clock
+import Utils
+import Control.Exception
+
+save :: FilePath -> [TimedEvent] -> IO()
+save fp ges = writeFile fp $ concatMap (\a -> show a ++ "\n") ges
+
+save' :: StateT Multi IO ()
+save' = do
+   lgs <- gets logs
+   lift $ save (logFilePath lgs) (logEvents lgs)
+
+load :: FilePath -> IO([TimedEvent])
+load fp = (map read . lines) <$> readFile fp
+
+logEvent :: TimedEvent -> StateT Multi IO ()
+logEvent le = do
+    m <- get
+    ls <- gets logs
+    put m { logs = ls { logEvents = (logEvents $ logs m) ++ [le]}}
+
+putTime :: UTCTime -> StateT Multi IO ()
+putTime t = modify (\m -> m{mCurrentTime = t})
+
+enactTimedEvent :: TimedEvent -> StateT Multi IO ()
+enactTimedEvent (TE t e) = do
+   putTime t
+   enactEvent e
+
+enactEvent :: MultiEvent -> StateT Multi IO ()
+enactEvent (MultiNewPlayer pm)                = liftT $ newPlayerU pm
+enactEvent (MultiNewGame s d pn)              = liftT $ newGame s d pn
+enactEvent (MultiJoinGame gn pn)              = liftT $ joinGame gn pn
+enactEvent (MultiLeaveGame pn)                = liftT $ leaveGame pn
+enactEvent (MultiSubscribeGame gn pn)         = liftT $ subscribeGame gn pn
+enactEvent (MultiUnsubscribeGame gn pn)       = liftT $ unsubscribeGame gn pn
+enactEvent (MultiSubmitRule sr pn)            = gets sh >>= submitRule sr pn
+enactEvent (MultiInputChoiceResult en ci pn)  = liftT $ inputChoiceResult en ci pn
+enactEvent (MultiInputStringResult ti res pn) = liftT $ inputStringResult (InputString pn ti) res pn
+enactEvent (MultiInputUpload pn dir mod)      = gets sh >>= inputUpload pn dir mod
+enactEvent (MultiTimeEvent t)                 = triggerTimeEvent t
+enactEvent (MultiMailSettings mms pn)         = liftT $ mailSettings mms pn
+
+update :: TimedEvent -> (Maybe PlayerNumber) -> StateT Multi IO ()
+update te mpn = logEvent te >> update' te mpn >> save'
+
+update' :: TimedEvent -> (Maybe PlayerNumber) -> StateT Multi IO ()
+update' te mpn = do
+   m <- get
+   m' <- lift $ (enactTimedEvent' te m) `catch` commandExceptionHandler mpn m
+   put m'
+
+enactTimedEvent' te m = do
+   m' <- (execStateT (enactTimedEvent te) m)
+   evaluate m'
+   return m'
+
+loadEvents :: FilePath -> ServerHandle -> Network -> IO Multi
+loadEvents fp sh net = do
+   t <- getCurrentTime
+   execStateT (loadEvents' fp) (defaultMulti sh fp net t)
+
+loadEvents' :: FilePath -> StateT Multi IO ()
+loadEvents' fp = do
+   les <- liftIO $ load fp
+   loadTimedEvents les
+
+loadTimedEvents :: [TimedEvent] -> StateT Multi IO ()
+loadTimedEvents les = do
+   modify(\m -> m { logs = (logs m) { logEvents = les}})
+   mapM_ (\a -> update' a (Just 1)) les --(lift $ putStrLn $ "loading " ++ (show a)) >>
diff --git a/src/Test.hs b/src/Test.hs
new file mode 100644
--- /dev/null
+++ b/src/Test.hs
@@ -0,0 +1,174 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Test
+-- Copyright   :
+-- License     :  BSD3
+--
+-- Maintainer  :  corentin.dupont@gmail.com
+-- Stability   :
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
+{-# LANGUAGE TupleSections, ScopedTypeVariables, TemplateHaskell, GADTs, QuasiQuotes #-}
+
+module Test where
+
+import Prelude hiding (catch)
+import Types
+import Data.Time hiding (getCurrentTime)
+import Control.Monad.State
+import Serialize
+import Language.Haskell.Interpreter.Server (ServerHandle)
+import Language.Nomyx.Expression
+import Control.Applicative
+import Control.Exception
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax as THS
+import System.IO.Unsafe
+import Quotes
+import Data.List
+import Data.Time.Clock
+
+playTests :: ServerHandle -> IO [(String, Bool)]
+playTests sh = mapM (\(title, t, cond) -> (title,) <$> test sh t cond) tests
+
+tests :: [(String, [TimedEvent], Multi -> Bool)]
+tests = [("hello World",           noTime gameHelloWorld,         condHelloWorld),
+         ("hello World 2 players", noTime gameHelloWorld2Players, condHelloWorld2Players),
+         ("Partial Function 1",    noTime gamePartialFunction1,   condPartialFunction1),
+         ("Partial Function 2",    gamePartialFunction2,          condPartialFunction2),
+         ("Partial Function 3",    noTime gamePartialFunction3,   condPartialFunction3),
+         ("Money transfer",        noTime gameMoneyTransfer,      condMoneyTransfer)]
+
+dayZero :: UTCTime
+dayZero = UTCTime (ModifiedJulianDay 0) 0
+
+noTime :: [MultiEvent] -> [TimedEvent]
+noTime mes = map (TE dayZero) mes
+
+test :: ServerHandle -> [TimedEvent] -> (Multi -> Bool) -> IO Bool
+test sh tes cond = do
+   --putStrLn $ "\n\n\nTEST"
+   let m = defaultMulti sh "" defaultNetwork dayZero
+   m' <- (loadTest tes m)
+   --putStrLn $ show m'
+   (return $ cond m') `catch` (\(e::IOError) -> (putStrLn $ show e) >> return False)
+
+loadTest ::  [TimedEvent] -> Multi -> IO Multi
+loadTest tes m = do
+   m' <- execStateT (loadTimedEvents tes) m
+   evaluate m'
+   return m'
+
+testException :: Multi -> SomeException -> IO Multi
+testException m e = do
+   putStrLn $ "Test Exception: " ++ show e
+   return m
+
+loadTestName :: FilePath -> ServerHandle -> Network -> String -> IO Multi
+loadTestName fp sh net testName = do
+   let mt = find (\(name, _, _) -> name == testName) tests
+   t <- getCurrentTime
+   let m = defaultMulti sh fp net t
+   case mt of
+      Just (n, t, _) -> putStrLn ("Loading test game: " ++ n)  >> loadTest t m
+      Nothing -> putStrLn "Test name not found" >> return m
+
+printRule :: Q THS.Exp -> String
+printRule r = unsafePerformIO $ do
+   expr <- runQ r
+   return $ pprint expr
+
+
+onePlayerOneGame :: [MultiEvent]
+onePlayerOneGame =
+   [MultiNewPlayer (PlayerMulti {mPlayerNumber = 1, mPlayerName = "coco", mPassword = "coco", mMail = MailSettings {mailTo = "", mailNewInput = False, mailNewRule = False, mailNewOutput = False, mailConfirmed = False}, inGame = Nothing, lastRule = Nothing}),
+    MultiMailSettings (MailSettings {mailTo = "c", mailNewInput = True, mailNewRule = True, mailNewOutput = True, mailConfirmed = True}) 1,
+    MultiNewGame "test" "" 1,
+    MultiJoinGame "test" 1]
+
+twoPlayersOneGame :: [MultiEvent]
+twoPlayersOneGame = onePlayerOneGame ++
+   [MultiNewPlayer (PlayerMulti {mPlayerNumber = 2, mPlayerName = "bat", mPassword = "bat", mMail = MailSettings {mailTo = "", mailNewInput = False, mailNewRule = False, mailNewOutput = False, mailConfirmed = False}, inGame = Nothing, lastRule = Nothing}),
+    MultiMailSettings (MailSettings {mailTo = "c", mailNewInput = True, mailNewRule = True, mailNewOutput = True, mailConfirmed = True}) 2,
+    MultiJoinGame "test" 2]
+
+submitRule ::  String -> [MultiEvent]
+submitRule r = onePlayerOneGame ++
+   [MultiSubmitRule (SubmitRule "" "" r) 1,
+    MultiInputChoiceResult 4 0 1]
+
+
+
+gameHelloWorld :: [MultiEvent]
+gameHelloWorld = onePlayerOneGame ++ submitRule [cr|helloWorld|]
+
+condHelloWorld :: Multi -> Bool
+condHelloWorld m = (head $ outputs $ head $ games m) == (1, "hello, world!")
+
+gameHelloWorld2Players :: [MultiEvent]
+gameHelloWorld2Players = twoPlayersOneGame ++
+   [MultiSubmitRule (SubmitRule "" "" [cr|helloWorld|]) 1,
+   MultiInputChoiceResult 5 0 1,
+   MultiInputChoiceResult 4 0 2]
+
+condHelloWorld2Players :: Multi -> Bool
+condHelloWorld2Players m = (head $ outputs $ head $ games m) == (1, "hello, world!")
+
+partialFunction1 :: String
+partialFunction1 = [cr|VoidRule $ readVar_ (V "toto1")|]
+
+gamePartialFunction1 :: [MultiEvent]
+gamePartialFunction1 = onePlayerOneGame ++ (submitRule partialFunction1)
+
+-- rule has not been accepted due to exception
+condPartialFunction1 :: Multi -> Bool
+condPartialFunction1 m = (rStatus $ head $ rules $ head $ games m) == Pending &&
+                         (take 5 $ snd $ head $ outputs $ head $ games m) == "Error"
+
+partialFunction2 :: String
+partialFunction2 = [cr|VoidRule $ do
+   t <- getCurrentTime
+   onEventOnce_ (Time $ addUTCTime 5 t) $ const $ readVar_ (V "toto2")|]
+
+gamePartialFunction2 :: [TimedEvent]
+gamePartialFunction2 = noTime onePlayerOneGame ++ (noTime $ submitRule partialFunction2) ++
+    [TE (5 `addUTCTime` dayZero) $  (MultiTimeEvent $ 5 `addUTCTime` dayZero)]
+
+-- rule has been accepted but exception happened later
+condPartialFunction2 :: Multi -> Bool
+condPartialFunction2 m = (rStatus $ head $ rules $ head $ games m) == Active &&
+                         (take 5 $ snd $ head $ outputs $ head $ games m) == "Error"
+
+--This rule blocks the game: the exception (variable not existing) is triggered during a "rule proposed" event,
+--thus preventing to propose any new rule to the game.
+partialFunction3 :: String
+partialFunction3 = [cr|VoidRule $ do
+   onEvent_ (RuleEv Proposed) $ const $ readVar_ (V "toto3")|]
+
+gamePartialFunction3 :: [MultiEvent]
+gamePartialFunction3 = onePlayerOneGame ++ (submitRule partialFunction3) ++ (submitRule [cr|nothing|])
+
+-- rule has been accepted but no more rule can be proposed
+condPartialFunction3 :: Multi -> Bool
+condPartialFunction3 m = (length $ rules $ head $ games m) == 3
+
+--Create bank accounts, win 100 Ecu on rule accepted (so 100 Ecu is won for each player), transfer 50 Ecu
+gameMoneyTransfer :: [MultiEvent]
+gameMoneyTransfer = twoPlayersOneGame ++
+   [MultiSubmitRule (SubmitRule "" "" [cr|createBankAccount|]) 1,
+   (MultiInputChoiceResult 5 0 1),
+   (MultiInputChoiceResult 4 0 2),
+   (MultiSubmitRule (SubmitRule "" "" [cr|winXEcuOnRuleAccepted 100|]) 1),
+   (MultiInputChoiceResult 7 0 1),
+   (MultiInputChoiceResult 6 0 2),
+   (MultiSubmitRule (SubmitRule "" "" [cr|moneyTransfer|]) 2),
+   (MultiInputChoiceResult 8 0 1),
+   (MultiInputChoiceResult 7 0 2),
+   (MultiInputChoiceResult 7 0 1),
+   (MultiInputStringResult "Select Amount to transfert to player: 2" "50" 1)]
+
+condMoneyTransfer :: Multi -> Bool
+condMoneyTransfer m = (vName $ head $ variables $ head $ games m) == "Accounts"
diff --git a/src/Types.hs b/src/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Types.hs
@@ -0,0 +1,91 @@
+
+{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances, TypeFamilies,
+             NamedFieldPuns #-}
+
+module Types where
+import Language.Nomyx.Expression
+import Data.Typeable
+import Data.List
+import Data.Function
+import Language.Haskell.Interpreter.Server (ServerHandle)
+import Text.Blaze.Html5 hiding (map, label)
+import Text.Reform
+import Happstack.Server
+import Text.Reform.Happstack()
+import Network.BSD
+import Data.Time
+
+
+type PlayerPassword = String
+type Port = Int
+data Network = Network {host :: HostName, port :: Port}
+defaultNetwork = Network "" 0
+
+data PlayerMulti = PlayerMulti   { mPlayerNumber :: PlayerNumber,
+                                   mPlayerName :: PlayerName,
+                                   mPassword :: PlayerPassword,
+                                   mMail :: MailSettings,
+                                   inGame :: Maybe GameName,
+                                   lastRule :: Maybe SubmitRule}
+                                   deriving (Eq, Show, Read, Typeable)
+
+--- | A structure to hold the active games and players
+data Multi = Multi { games   :: [Game],
+                     mPlayers :: [PlayerMulti],
+                     logs ::  Log,
+                     sh :: ServerHandle,
+                     net :: Network,
+                     mCurrentTime :: UTCTime}
+                     deriving (Typeable)
+
+instance Show Multi where
+   show Multi{games, mPlayers} = "Games: " ++ show (sort games) ++ "\n" ++
+                                 "Players: " ++ show (sort mPlayers) ++ "\n"
+
+defaultMulti :: ServerHandle -> FilePath -> Network -> UTCTime -> Multi
+defaultMulti sh fp net t = Multi [] [] (defaultLog fp) sh net t
+
+data Log = Log { logEvents :: [TimedEvent],
+                 logFilePath :: FilePath } deriving (Eq)
+
+defaultLog :: FilePath ->Log
+defaultLog fp = Log [] fp
+
+data SubmitRule = SubmitRule RuleName String RuleCode deriving (Show, Read, Eq)
+
+data TimedEvent = TE UTCTime MultiEvent deriving (Show, Read, Eq)
+
+data MultiEvent =  MultiNewPlayer         PlayerMulti
+                 | MultiNewGame           GameName String PlayerNumber
+                 | MultiJoinGame          GameName PlayerNumber
+                 | MultiLeaveGame         PlayerNumber
+                 | MultiSubscribeGame     GameName PlayerNumber
+                 | MultiUnsubscribeGame   GameName PlayerNumber
+                 | MultiSubmitRule        SubmitRule PlayerNumber
+                 | MultiInputChoiceResult EventNumber Int PlayerNumber
+                 | MultiInputStringResult String String PlayerNumber
+                 | MultiInputUpload       PlayerNumber FilePath String
+                 | MultiTimeEvent         UTCTime
+                 | MultiMailSettings      MailSettings PlayerNumber
+                   deriving (Show, Read, Eq)
+
+
+instance Ord PlayerMulti where
+  (<=) = (<=) `on` mPlayerNumber
+
+type NomyxForm a = Form (ServerPartT IO) [Input] String Html () a
+
+
+data MailSettings = MailSettings { mailTo :: String,
+                   mailNewInput :: Bool,
+                   mailNewRule :: Bool,
+                   mailNewOutput :: Bool,
+                   mailConfirmed :: Bool } deriving (Eq, Show, Read)
+
+defaultMailSettings :: MailSettings
+defaultMailSettings = MailSettings "" False False False False
+
+instance FormError String where
+    type ErrorInputType String = [Input]
+    commonFormError _ = "common error"
+
diff --git a/src/Utils.hs b/src/Utils.hs
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -11,12 +11,22 @@
 -- |
 --
 -----------------------------------------------------------------------------
-
+
+{-# LANGUAGE NamedFieldPuns #-}
+    
 module Utils where
 
 import Data.Maybe
 import Data.Char
-import Control.Monad.State
+import Control.Monad.State
+import Types
+import Language.Nomyx.Expression
+import Data.List
+import Control.Applicative
+import Control.Exception
+import Data.Time
+
+
          
 -- | this function will return just a if it can cast it to an a.
 maybeRead :: Read a => String -> Maybe a
@@ -31,12 +41,6 @@
         -> [a] -- ^ Output list
 replace x y = map (\z -> if z == x then y else z)
 
--- | 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)
 
 
 yes = ["o", "oui", "y", "yes", "v", "vrai", "true"]
@@ -51,8 +55,75 @@
 liftT st = do
     s1 <- get
     let (a, s) = runState st s1
-    --lift $ putStrLn $ "putting " ++ show s
     put s
     return a
+
+
+findPlayer :: PlayerName -> State Multi (Maybe PlayerMulti)
+findPlayer name = find (\PlayerMulti {mPlayerName = pname} -> pname==name) <$> gets mPlayers
+
+findPlayer' :: PlayerNumber -> State Multi (Maybe PlayerMulti)
+findPlayer' pn = find (\PlayerMulti {mPlayerNumber} -> pn==mPlayerNumber) <$> gets mPlayers
+
+nomyxURL :: Network -> String
+nomyxURL (Network host port) = "http://" ++ host ++ ":" ++ (show port)
+
+getPlayersName :: PlayerNumber -> Multi -> PlayerName
+getPlayersName pn multi = do
+   case find (\(PlayerMulti n _ _ _ _ _) -> n==pn) (mPlayers multi) of
+      Nothing -> error "getPlayersName: No player by that number"
+      Just pm -> mPlayerName pm
+
+getPlayersName' :: Game -> PlayerNumber -> PlayerName
+getPlayersName' g pn = do
+   case find (\(PlayerInfo n _) -> n==pn) (players g) of
+      Nothing -> error "getPlayersName: No player by that number in that game"
+      Just pm -> playerName pm
+
+-- | returns the game the player is in
+getPlayersGame :: PlayerNumber -> Multi -> Maybe Game
+getPlayersGame pn multi = do
+        pi <- find (\(PlayerMulti n _ _ _ _ _) -> n==pn) (mPlayers multi)
+        gn <- inGame pi
+        find (\(Game {gameName=name}) -> name==gn) (games multi)
+
+getPlayersNameMay :: Game -> PlayerNumber -> Maybe PlayerName
+getPlayersNameMay g pn = do
+   case find (\(PlayerInfo n _) -> n==pn) (players g) of
+      Nothing -> Nothing
+      Just pm -> Just $ playerName pm
+
+commandExceptionHandler :: Maybe PlayerNumber -> Multi -> ErrorCall -> IO Multi
+commandExceptionHandler mpn m e = do
+   putStrLn $ "Exception in rule: " ++ (show e)
+   case mpn of
+      Just pn -> do
+         let g = fromJust $ getPlayersGame pn m
+         let g' = execState (output ("Error in command: " ++ (show e)) pn) g
+         return $ execState (modifyGame g') m
+      Nothing -> return m
+
+
+-- | finds the corresponding game in the multistate and replaces it.
+modifyGame :: Game -> State Multi ()
+modifyGame g = do
+   m@(Multi {games=gs}) <- get
+   case find (\myg -> gameName g == gameName myg) gs of
+      Nothing -> error "modifyGame: No game by that name"
+      Just oldg -> do
+         let newgs = replace oldg g gs
+         put (m {games=newgs})
+
+output :: String -> PlayerNumber -> State Game ()
+output s pn = modify (\game -> game { outputs = (pn, s) : (outputs game)})
+
+outputAll :: String -> State Game ()
+outputAll s = gets players >>= mapM_ ((output s) . playerNumber)
+
+
+execWithMulti :: UTCTime -> StateT Multi IO () -> Multi -> IO Multi
+execWithMulti t ms m = do
+   let m' = m { games = map (\g -> g {currentTime = t}) (games m)}
+   execStateT ms m'
 
 
diff --git a/src/Web.hs b/src/Web.hs
deleted file mode 100644
--- a/src/Web.hs
+++ /dev/null
@@ -1,502 +0,0 @@
-
-{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleContexts, FlexibleInstances, TemplateHaskell,
-   EmptyDataDecls, TypeFamilies, MultiParamTypeClasses, DeriveDataTypeable, PackageImports, GADTs,
-   ScopedTypeVariables, NamedFieldPuns, Rank2Types, DoAndIfThenElse, StandaloneDeriving, OverloadedStrings#-}
-
-module Web (launchWebServer) where
-
-import Prelude hiding (div)
-import Text.Blaze.Html5 hiding (map)
-import Text.Blaze.Html5.Attributes hiding (dir)
-import qualified Text.Blaze.Html5 as H
-import qualified Text.Blaze.Html5.Attributes as A
-import Web.Routes.Site
-import Web.Routes.PathInfo
-import Web.Routes.Happstack
-import Web.Routes.RouteT
-import Web.Routes.TH (derivePathInfo)
-import Text.Blaze.Internal
-import Game
-import Multi
-import Control.Monad
-import Paths_Nomyx as PN
-import Paths_Nomyx_Rules as PNR
-import Control.Monad.State
-import Data.Monoid
-import Data.String
-import Control.Concurrent.STM
-import Language.Haskell.Interpreter.Server
-import Language.Nomyx.Expression
-import Language.Nomyx.Evaluation
-import Utils
-import Data.Maybe
-import Text.Reform.Happstack
-import Text.Reform
-import Forms
-import Data.Text hiding (concat, map, filter, concatMap, length, intersperse)
-import Happstack.Server
-import Data.List
-import System.Directory
-import System.FilePath
-import System.Posix.Files
-import qualified Help
-import Network.BSD
-
--- | associate a player number with a handle
-data PlayerClient = PlayerClient PlayerNumber deriving (Eq, Show)
-
--- | A structure to hold the active games and players
-data Server = Server [PlayerClient] deriving (Eq, Show)
-type Port = Int
-
-data PlayerCommand = Login
-                   | PostLogin
-                   | Noop            PlayerNumber
-                   | JoinGame        PlayerNumber GameName
-                   | LeaveGame       PlayerNumber
-                   | SubscribeGame   PlayerNumber GameName
-                   | UnsubscribeGame PlayerNumber GameName
-                   | DoInputChoice   PlayerNumber EventNumber
-                   | DoInputString   PlayerNumber String
-                   | NewRule
-                   | NewGame
-                   | Upload PlayerNumber
-                   deriving (Show)
-
-$(derivePathInfo ''PlayerCommand)
-
-instance PathInfo Bool where
-  toPathSegments i = [pack $ show i]
-  fromPathSegments = pToken (const "bool") (checkBool . show)
-   where checkBool str =
-           case reads str of
-             [(n,[])] -> Just n
-             _ ->        Nothing
-
-modDir = "modules"
-
-type NomyxServer       = ServerPartT IO
-type RoutedNomyxServer = RouteT PlayerCommand NomyxServer
-
-
-nomyxSite :: ServerHandle -> (TVar Multi) -> Site PlayerCommand (ServerPartT IO Html)
-nomyxSite sh tm = setDefault Login $ mkSitePI (runRouteT $ routedNomyxCommands sh tm)
-
-viewGame :: Game -> PlayerNumber -> RoutedNomyxServer Html
-viewGame g pn = do
-   rf <- ruleForm pn
-   vi <- viewInputs pn $ events g
-   ok $ table $ do
-      td ! A.id "gameCol" $ do
-         table $ do
-            tr $ td $ h3 $ string $ "Viewing game: " ++ gameName g  --div ! A.id "gameName"
-            tr $ td $ viewPlayers $ players g -- div ! A.id "citizens"
-            tr $ td $ viewVictory g --  div ! A.id "victory"
-      td ! A.id "gameElem" $ do
-         table $ do
-         tr $ td $ div ! A.id "rules" $ viewAllRules g
-         tr $ td $ div ! A.id "inputs" ! A.title (toValue Help.inputs) $ vi
-         tr $ td $ div ! A.id "events" ! A.title (toValue Help.events) $ viewEvents $ events g
-         tr $ td $ div ! A.id "variables" ! A.title (toValue Help.variables)$ viewVars $ variables g
-         tr $ td $ div ! A.id "newRule" $ rf
-         tr $ td $ div ! A.id "outputs" ! A.title (toValue Help.outputs)$ viewOutput (outputs g) pn
-
-viewPlayers :: [PlayerInfo] -> Html
-viewPlayers pis = do
-   h5 "Players in game:"
-   table $ mapM_ viewPlayer (sort pis)
-
-
-viewPlayer :: PlayerInfo -> Html
-viewPlayer pi = tr $ do
-    td $ string $ show $ playerNumber pi
-    td $ string $ playerName pi
-
-viewVictory :: Game -> Html
-viewVictory g = do
-    let vs = map (getPlayersName' g) (victory g)
-    case length vs of
-        0 -> br
-        _ -> h3 $ string $ "Player(s) " ++ (concat $ intersperse " " $ vs) ++ " won the game!"
-
-viewAllRules :: Game -> Html
-viewAllRules g = do
-   h3 "Rules"
-   viewRules "Active rules:" (activeRules g) ! (A.title $ toValue Help.actives)
-   viewRules "Pending rules:" (pendingRules g) ! (A.title $ toValue Help.pendings)
-   viewRules "Suppressed rules:" $ rejectedRules g
-
-viewRules :: Html -> [Rule] -> Html
-viewRules _ [] = return ()
-viewRules title nrs = do
-   table ! A.class_ "table" $ do
-      caption $ h4 title
-      thead $ do
-         td ! A.class_ "td" $ text "Number"
-         td ! A.class_ "td" $ text "Name"
-         td ! A.class_ "td" $ text "Description"
-         td ! A.class_ "td" $ text "Proposed by"
-         td ! A.class_ "td" $ text "Code of the rule"
-         td ! A.class_ "td" $ text "Assessed by"
-      forM_ nrs viewRule
-
-viewRule :: Rule -> Html
-viewRule nr = tr $ do
-   td ! A.class_ "td" $ string . show $ rNumber nr
-   td ! A.class_ "td" $ string $ rName nr
-   td ! A.class_ "td" $ string $ rDescription nr
-   td ! A.class_ "td" $ string $ if rProposedBy nr == 0 then "System" else "Player " ++ (show $ rProposedBy nr)
-   td ! A.class_ "td" $ string $ rRuleCode nr
-   td ! A.class_ "td" $ string $ case rAssessedBy nr of
-      Nothing -> "Not assessed"
-      Just 0  -> "System"
-      Just a  -> "Rule " ++ (show $ a)
-
-viewEvents :: [EventHandler] -> Html
-viewEvents [] = h3 "Events" >> h5 "No Events"
-viewEvents ehs = do
-   h3 "Events"
-   table ! A.class_ "table" $ do
-      thead $ do
-         td ! A.class_ "td" $ text "Event Number"
-         td ! A.class_ "td" $ text "By Rule"
-         td ! A.class_ "td" $ text "Event"
-      mapM_ viewEvent $ sort ehs
-
-viewEvent :: EventHandler -> Html
-viewEvent (EH eventNumber ruleNumber event _) = tr $ do
-   td ! A.class_ "td" $ string . show $ eventNumber
-   td ! A.class_ "td" $ string . show $ ruleNumber
-   td ! A.class_ "td" $ string . show $ event
-
-viewInputs :: PlayerNumber -> [EventHandler] -> RoutedNomyxServer Html
-viewInputs pn ehs = do
-   mis <- mapM (viewInput pn) $ sort ehs
-   let is = catMaybes mis
-   case length is of
-      0 -> ok $ h3 "Inputs" >> h5 "No Inputs"
-      _ -> ok $ do
-         h3 "Inputs"
-         table $ do
-            mconcat is
-
-viewInput :: PlayerNumber -> EventHandler -> RoutedNomyxServer (Maybe Html)
-viewInput me (EH eventNumber _ (InputChoice pn title choices def) _) | me == pn = do
-    link <- showURL (DoInputChoice pn eventNumber)
-    lf  <- lift $ viewForm "user" $ inputChoiceForm title (map show choices) (show def)
-    return $ Just $ tr $ td $ blazeForm lf (link)
-viewInput me (EH _ _ (InputString pn title) _) | me == pn = do
-    link <- showURL (DoInputString pn title)
-    lf  <- lift $ viewForm "user" $ inputStringForm title
-    return $ Just $ tr $ td $ blazeForm lf (link)
-viewInput _ _ = return Nothing
-
-viewVars :: [Var] -> Html
-viewVars [] = h3 "Variables" >> h5 "No Variables"
-viewVars vs = do
-   h3 "Variables"
-   table ! A.class_ "table" $ do
-      thead $ do
-         td ! A.class_ "td" $ text "Rule number"
-         td ! A.class_ "td" $ text "Name"
-         td ! A.class_ "td" $ text "Value"
-      mapM_ viewVar vs
-
-viewVar :: Var -> Html
-viewVar (Var vRuleNumber vName vData) = tr $ do
-   td ! A.class_ "td" $ string . show $ vRuleNumber
-   td ! A.class_ "td" $ string . show $ vName
-   td ! A.class_ "td" $ string . show $ vData
-
-
-ruleForm :: PlayerNumber -> RoutedNomyxServer Html
-ruleForm pn = do
-   link <- showURL NewRule
-   ok $ do
-      h3 "Propose a new rule:"
-      H.form ! A.method "POST" ! A.action (toValue link) ! enctype "multipart/form-data;charset=UTF-8"  $ do
-      H.label ! A.for "name" $ "Name: "
-      input ! type_ "text" ! name "name" ! A.id "name" ! tabindex "1" ! accesskey "N"
-      H.label ! A.for "text" $ "      Short description: "
-      input ! type_ "text" ! name "description" ! A.id "description" ! tabindex "2" ! accesskey "T"
-      H.br
-      H.label ! A.for "text" $ "Code: "
-      textarea ! name "code" ! A.id "code" ! tabindex "3" ! accesskey "C" ! A.placeholder "Enter here your rule" !
-       A.title (toValue Help.code) $ ""
-      input ! type_ "hidden" ! name "pn" ! value (fromString $ show pn)
-      input ! type_  "submit" ! tabindex "4" ! accesskey "S" ! value "Submit rule!"
-
-viewOutput :: [Output] -> PlayerNumber -> Html
-viewOutput [] _ = h3 "Output" >> h5 "No Output"
-viewOutput os pn = do
-   h3 "Output"
-   let myos = map snd $ filter (\o -> fst o == pn) os
-   mapM_ viewMessages [myos]
-
-viewMessages :: [String] -> Html
-viewMessages = mapM_ (\s -> string s >> br)
-
-
-viewMulti :: PlayerNumber -> Multi -> RoutedNomyxServer Html
-viewMulti pn m = do
-   gns <- viewGamesTab pn (games m)
-   g <- case getPlayersGame pn m of
-            Just g -> viewGame g pn
-            Nothing -> ok $ h3 "Not in game"
-   ok $ do
-      div ! A.id "gameList" $ gns
-      div ! A.id "game" $ g
-
-viewGamesTab :: PlayerNumber -> [Game] -> RoutedNomyxServer Html
-viewGamesTab pn gs = do
-   gns <- mapM (viewGameName pn) gs
-   ng <- newGameForm pn
-   link <- showURL (Upload pn)
-   up  <- lift $ viewForm "user" uploadForm
-   dd <- lift $ lift $ PN.getDataDir
-   mods <- lift $ lift $ getDirectoryContents $ dd </> modDir
-   fmods <- lift $ lift $ filterM (getFileStatus . (\f -> joinPath [dd, modDir, f]) >=> return . isRegularFile) $ mods
-   ok $ do
-      h3 "Games:"
-      table $ do
-         case gs of
-            [] -> tr $ td "No Games"
-            _ ->  sequence_ gns
-      br >> "Create a new game:"
-      ng
-      br >> "Rule language files:" >> br
-      H.a "Rules examples" ! (href $ "/examples/Examples.hs") >> br
-      H.a "Rules definitions" ! (href $ "/src/Language/Nomyx/Rule.hs") >> br
-      H.a "Rules types" ! (href $ "/src/Language/Nomyx/Expression.hs") >> br
-      mapM_ (\f -> (H.a $ toHtml f ) ! (href $ toValue (pathSeparator : modDir </> f)) >> br) fmods
-      br >> "Upload new rules file:" >> br
-      blazeForm up (link) ! (A.title $ toValue Help.upload)
-
-viewGameName :: PlayerNumber -> Game -> RoutedNomyxServer Html
-viewGameName pn g = do
-   let gn = gameName g
-   join <- showURL (JoinGame pn gn)
-   leave <- showURL (LeaveGame pn)
-   --subscribe <- showURL (SubscribeGame pn gn)
-   unsubscribe <- showURL (UnsubscribeGame pn gn)
-   ok $ do
-      tr $ do
-         td $ string $ gn
-         td $ H.a "Join" ! (href $ toValue join)
-         td $ H.a "Leave" ! (href $ toValue leave)
-         --td $ H.a "Subscribe" ! (href $ toValue subscribe)
-         td $ H.a "Unsubscribe" ! (href $ toValue unsubscribe)
-
-newGameForm :: PlayerNumber -> RoutedNomyxServer Html
-newGameForm pn = do
-   link <- showURL NewGame
-   ok $ H.form ! A.method "POST" ! A.action (toValue link) ! enctype "multipart/form-data;charset=UTF-8"  $ do
-      input ! type_ "text" ! name "name" ! A.id "name" ! tabindex "1" ! accesskey "G" ! A.title "Game name"
-      input ! type_ "hidden" ! name "pn" ! value (fromString $ show pn)
-      input ! type_  "submit" ! tabindex "2" ! accesskey "S" ! value "Create New Game!"
-
-
-nomyxPage :: Multi -> PlayerNumber -> RoutedNomyxServer Html
-nomyxPage multi pn = do
-   m <- viewMulti pn multi
-   ok $ do
-      H.html $ do
-        H.head $ do
-          H.title "Welcome to Nomyx!"
-          H.link ! rel "stylesheet" ! type_ "text/css" ! href "/static/css/nomyx.css"
-          H.meta ! A.httpEquiv "Content-Type" ! content "text/html;charset=utf-8"
-          H.meta ! A.name "keywords" ! A.content "Nomyx, game, rules, Haskell, auto-reference"
-          --H.meta ! A.httpEquiv "refresh" ! A.content "3"
-        H.body $ do
-          H.div ! A.id "container" $ do
-             H.div ! A.id "header" $ string $ "Welcome to Nomyx, " ++ (getPlayersName pn multi) ++ "!"
-             H.div ! A.id "multi" $ m
-
-
-loginPage :: RoutedNomyxServer Html
-loginPage = do
-   link <- showURL PostLogin
-   lf  <- lift $ viewForm "user" loginForm
-   ok $ H.html $ do
-      H.head $ do
-        H.title "Login to Nomyx"
-        H.link ! rel "stylesheet" ! type_ "text/css" ! href "/static/css/nomyx.css"
-        H.meta ! A.httpEquiv "Content-Type" ! content "text/html;charset=utf-8"
-        H.meta ! A.name "keywords" ! A.content "Nomyx, game, rules, Haskell, auto-reference"
-      H.body $ do
-        H.div ! A.id "container" $ do
-           H.div ! A.id "header" $ "Login to Nomyx"
-           H.div ! A.id "login" $ blazeForm lf (link)
-           H.div ! A.id "footer" $ string "Copyright Corentin Dupont 2012"
-
-
-routedNomyxCommands :: ServerHandle -> (TVar Multi) -> PlayerCommand -> RoutedNomyxServer Html
-routedNomyxCommands _ _  (Login)                     = loginPage
-routedNomyxCommands _ tm (PostLogin)                 = postLogin tm
-routedNomyxCommands _ tm (Noop pn)                   = nomyxPageComm pn tm (return ())
-routedNomyxCommands _ tm (JoinGame pn game)          = nomyxPageComm pn tm (joinGame game pn)
-routedNomyxCommands _ tm (LeaveGame pn)              = nomyxPageComm pn tm (leaveGame pn)
-routedNomyxCommands _ tm (SubscribeGame pn game)     = nomyxPageComm pn tm (subscribeGame game pn)
-routedNomyxCommands _ tm (UnsubscribeGame pn game)   = nomyxPageComm pn tm (unsubscribeGame game pn)
-routedNomyxCommands sh tm (NewRule)                  = newRule sh tm
-routedNomyxCommands _ tm (NewGame)                   = newGameWeb tm
-routedNomyxCommands _ tm (DoInputChoice pn en)       = newInputChoice pn en tm
-routedNomyxCommands _ tm (DoInputString pn en)       = newInputString pn en tm
-routedNomyxCommands sh tm (Upload pn)                = newUpload pn sh tm
-
---execute the given instructions (Comm) and embed the result in a web page
-nomyxPageComm :: PlayerNumber -> (TVar Multi) -> StateT Multi IO () -> RoutedNomyxServer Html
-nomyxPageComm pn tm comm = execCommand tm comm >> nomyxPageServer pn tm
-
-execCommand :: (TVar Multi) -> StateT Multi IO a -> RoutedNomyxServer a
-execCommand tm sm = do
-    m <- liftRouteT $ lift $ atomically $ readTVar tm
-    (a, m') <- liftRouteT $ lift $ runStateT sm m
-    liftRouteT $ lift $ atomically $ writeTVar tm m'
-    return a
-
-
-newRule :: ServerHandle -> (TVar Multi) -> RoutedNomyxServer Html
-newRule sh tm = do
-   methodM POST -- only accept a post method
-   mbEntry <- getData -- get the data
-   case mbEntry of
-      Left a -> error $ "error: newRule " ++ (concat a)
-      Right (NewRuleForm name text code pn) -> do
-         --debugM ("Rule submitted: name =" ++ name ++ "\ntext=" ++ text ++ "\ncode=" ++ code ++ "\npn=" ++ (show pn))
-         nomyxPageComm pn tm (submitRule name text code pn sh)
-
-
-newGameWeb :: (TVar Multi) -> RoutedNomyxServer Html
-newGameWeb tm = do
-   methodM POST
-   mbEntry <- getData
-   case mbEntry of
-      Left a                      -> error $ "error: newGame" ++ (concat a)
-      Right (NewGameForm name pn) -> nomyxPageComm pn tm (newGame name pn)
-
-newInputChoice :: PlayerNumber -> EventNumber -> (TVar Multi) -> RoutedNomyxServer Html
-newInputChoice pn en tm = do
-    multi <- liftRouteT $ lift $ atomically $ readTVar tm
-    let mg = fromJust $ getPlayersGame pn multi
-    let eventHandler = fromJust $ findEvent en (events mg)
-    methodM POST
-    let (title, choices, def) = getChoices eventHandler
-    r <- liftRouteT $ eitherForm environment "user" (inputChoiceForm title choices def)
-    link <- showURL $ Noop pn
-    case r of
-       (Right c) -> do
-          liftRouteT $ lift $ putStrLn $ "choice:" ++ (show c)
-          execCommand tm $ inputChoiceResult en c pn
-          seeOther link $ string "Redirecting..."
-       (Left _) -> do
-          liftRouteT $ lift $ putStrLn $ "cannot retrieve form data"
-          seeOther link $ string "Redirecting..."
-
-getChoices :: EventHandler -> (String, [String], String)
-getChoices (EH _ _ (InputChoice _ title choices def) _) = (title, map show choices, show def)
-getChoices _ = error "InputChoice event expected"
-
-newInputString :: PlayerNumber -> String -> (TVar Multi) -> RoutedNomyxServer Html
-newInputString pn title tm = do
-    methodM POST
-    r <- liftRouteT $ eitherForm environment "user" (inputStringForm title)
-    link <- showURL $ Noop pn
-    case r of
-       (Right c) -> do
-          liftRouteT $ lift $ putStrLn $ "entered:" ++ (show c)
-          execCommand tm $ inputStringResult (InputString pn title) c pn
-          seeOther link $ string "Redirecting..."
-       (Left _) -> do
-          liftRouteT $ lift $ putStrLn $ "cannot retrieve form data"
-          seeOther link $ string "Redirecting..."
-
-newUpload :: PlayerNumber -> ServerHandle -> (TVar Multi) -> RoutedNomyxServer Html
-newUpload pn sh tm = do
-    methodM POST
-    r <- liftRouteT $ eitherForm environment "user" uploadForm
-    link <- showURL $ Noop pn
-    case r of
-       (Right (path,name,content)) -> do
-          lift $ lift $ putStrLn $ "Upload entered:" ++ (show path) ++ " " ++ (show name) ++ " " ++ (show content)
-          execCommand tm $ inputUpload pn path name sh
-          seeOther link $ string "Redirecting..."
-       (Left _) -> do
-          liftRouteT $ lift $ putStrLn $ "cannot retrieve form data"
-          seeOther link $ string "Redirecting..."
-
-nomyxPageServer :: PlayerNumber -> (TVar Multi) -> RoutedNomyxServer Html
-nomyxPageServer pn tm = do
-   multi <- liftRouteT $ lift $ atomically $ readTVar tm
-   nomyxPage multi pn
-
-
-postLogin :: (TVar Multi) -> RoutedNomyxServer Html
-postLogin tm = do
-    methodM POST
-    r <- liftRouteT $ eitherForm environment "user" loginForm
-    case r of
-       (Right (LoginPass login password)) -> do
-          liftRouteT $ lift $ putStrLn $ "login:" ++ login
-          liftRouteT $ lift $ putStrLn $ "password:" ++ password
-          mpn <- execCommand tm $ newPlayerWeb login password
-          case mpn of
-             Just pn -> do
-                link <- showURL $ Noop pn
-                seeOther link $ string "Redirecting..."
-             Nothing -> error "cannot login"
-       (Left _) -> seeOther ("/Login?status=fail" :: String) $ string "Redirecting..."
-
-
-newPlayerWeb :: PlayerName -> PlayerPassword -> StateT Multi IO (Maybe PlayerNumber)
-newPlayerWeb name pwd = do
-   --find that name among the list
-   mpn <- findPlayer name
-   case mpn of
-      Just pl -> do
-         say $ "Trying name:" ++ mPlayerName pl
-         case pwd == mPassword pl of
-            True -> do
-               say "password OK"
-               return $ Just $ mPlayerNumber pl
-            False -> do
-               say "password false"
-               return Nothing
-      Nothing -> do
-         say "New player"
-         --add the new player to the list
-         pn <- getNewPlayerNumber
-         newPlayerU PlayerMulti { mPlayerNumber = pn, mPlayerName = name, mPassword = pwd, inGame = Nothing}
-         return (Just pn)
-
-
-launchWebServer :: ServerHandle -> (TVar Multi) -> HostName -> Port -> IO ()
-launchWebServer sh tm host portNumber = do
-   putStrLn $ "Starting web server...\nTo connect, drive your browser to \"http://" ++ host ++ ":" ++ (show portNumber) ++ "/Login\""
-   d <- PN.getDataDir
-   d' <- PNR.getDataDir
-   simpleHTTP nullConf {port=portNumber} $ server d d' sh tm host portNumber
-
---serving Nomyx web page as well as data from this package and the language library package
-server :: FilePath -> FilePath -> ServerHandle -> (TVar Multi) -> HostName -> Port -> NomyxServer Response
-server d d' sh tm host port = mconcat [
-    serveDirectory EnableBrowsing [] d,
-    serveDirectory EnableBrowsing [] d', do
-       decodeBody (defaultBodyPolicy "/tmp/" 102400 4096 4096)
-       html <- implSite (pack ("http://" ++ host ++ ":" ++ (show port))) "/Login" (nomyxSite sh tm)
-       return $ toResponse html]
-
-instance FromData NewRuleForm where
-  fromData = do
-    name  <- look "name" `mplus` (error "need rule name")
-    text <-  look "description" `mplus` (error "need rule text")
-    code <-  look "code" `mplus` (error "need rule code")
-    pn <- lookRead "pn" `mplus` (error "need player number")
-    return $ NewRuleForm name text code pn
-
-instance FromData NewGameForm where
-  fromData = do
-    name  <- look "name" `mplus` (error "need rule name")
-    pn <- lookRead "pn" `mplus` (error "need player number")
-    return $ NewGameForm name pn
-
diff --git a/src/Web/Common.hs b/src/Web/Common.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Common.hs
@@ -0,0 +1,133 @@
+{-# LANGUAGE TemplateHaskell, OverloadedStrings, GADTs, ScopedTypeVariables#-}
+
+module Web.Common where
+
+
+import Prelude hiding (div, catch)
+import Text.Blaze.Html5 hiding (map, output)
+import Text.Blaze.Html5.Attributes hiding (dir, id)
+import qualified Text.Blaze.Html5 as H
+import qualified Text.Blaze.Html5.Attributes as A
+import Web.Routes.PathInfo
+import Web.Routes.RouteT
+import Web.Routes.TH (derivePathInfo)
+import Control.Monad.State
+import Control.Concurrent.STM
+import Language.Nomyx.Expression
+import Happstack.Server
+import Types
+import qualified Data.ByteString.Char8 as C
+import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
+import Text.Reform.Happstack()
+import Text.Reform
+import Text.Reform.Blaze.String()
+import Text.Reform.Happstack()
+import qualified Text.Reform.Generalized as G
+import Data.Text(Text, pack)
+import Web.Routes.Happstack()
+import Data.Time
+import Serialize
+default (Integer, Double, Data.Text.Text)
+
+
+data LoginPass = LoginPass { login :: PlayerName,
+                             password :: PlayerPassword}
+                             deriving (Show, Eq)
+
+
+-- | associate a player number with a handle
+data PlayerClient = PlayerClient PlayerNumber deriving (Eq, Show)
+
+-- | A structure to hold the active games and players
+data Server = Server [PlayerClient] deriving (Eq, Show)
+
+
+data PlayerCommand = Login
+                   | PostLogin
+                   | NewPlayer       LoginPass
+                   | NewPlayerLogin  LoginPass
+                   | Noop            PlayerNumber
+                   | JoinGame        PlayerNumber GameName
+                   | LeaveGame       PlayerNumber
+                   | SubscribeGame   PlayerNumber GameName
+                   | UnsubscribeGame PlayerNumber GameName
+                   | DoInputChoice   PlayerNumber EventNumber
+                   | DoInputString   PlayerNumber String
+                   | NewRule         PlayerNumber
+                   | NewGame         PlayerNumber
+                   | SubmitNewGame   PlayerNumber
+                   | Upload          PlayerNumber
+                   | Settings        PlayerNumber
+                   | SubmitSettings  PlayerNumber
+                   deriving (Show)
+
+$(derivePathInfo ''PlayerCommand)
+$(derivePathInfo ''LoginPass)
+
+instance PathInfo Bool where
+  toPathSegments i = [pack $ show i]
+  fromPathSegments = pToken (const "bool") (checkBool . show)
+   where checkBool str =
+           case reads str of
+             [(n,[])] -> Just n
+             _ ->        Nothing
+
+modDir :: FilePath
+modDir = "modules"
+
+type NomyxServer       = ServerPartT IO
+type RoutedNomyxServer = RouteT PlayerCommand NomyxServer
+
+
+evalCommand :: (TVar Multi) -> State Multi a -> RoutedNomyxServer a
+evalCommand tm sm = do
+    m <- liftRouteT $ lift $ atomically $ readTVar tm
+    return $ evalState sm m
+
+
+webCommand :: (TVar Multi) -> PlayerNumber -> MultiEvent -> RoutedNomyxServer ()
+webCommand tm pn me = liftRouteT $ lift $ do
+   t <- getCurrentTime
+   m <- atomically $ readTVar tm
+   m' <- execStateT (update (TE t me) (Just pn)) m
+   atomically $ writeTVar tm m'
+
+
+blazeResponse :: Html -> Response
+blazeResponse html = toResponseBS (C.pack "text/html;charset=UTF-8") $ renderHtml html
+
+blazeForm :: Html -> Text -> Html
+blazeForm html link =
+    H.form ! A.action (toValue link)
+         ! A.method "POST"
+         ! A.enctype "multipart/form-data" $
+            do html
+               input ! A.type_ "submit" ! A.value "Submit"
+
+-- | Create a group of radio elements without BR between elements
+inputRadio' :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToMarkup lbl) =>
+              [(a, lbl)]  -- ^ value, label, initially checked
+           -> (a -> Bool) -- ^ isDefault
+           -> Form m input error Html () a
+inputRadio' choices isDefault =
+    G.inputChoice isDefault choices mkRadios
+    where
+      mkRadios nm choices' = mconcat $ concatMap (mkRadio nm) choices'
+      mkRadio nm (i, val, lbl, checked) =
+          [ ((if checked then (! A.checked "checked") else id) $
+             input ! A.type_ "radio" ! A.id (toValue i) ! A.name (toValue nm) ! A.value (toValue val))
+          , " ", H.label ! A.for (toValue i) $ toHtml lbl]
+
+mainPage :: Html -> Html -> Html -> Bool -> RoutedNomyxServer Html
+mainPage body title header footer = do
+   ok $ H.html $ do
+      H.head $ do
+        H.title title
+        H.link ! rel "stylesheet" ! type_ "text/css" ! href "/static/css/nomyx.css"
+        H.meta ! A.httpEquiv "Content-Type" ! content "text/html;charset=utf-8"
+        H.meta ! A.name "keywords" ! A.content "Nomyx, game, rules, Haskell, auto-reference"
+      H.body $ do
+        H.div ! A.id "container" $ do
+           H.div ! A.id "header" $ header
+           body
+           when footer $ H.div ! A.id "footer" $ "Copyright Corentin Dupont 2012-2013"
diff --git a/src/Web/Game.hs b/src/Web/Game.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Game.hs
@@ -0,0 +1,259 @@
+
+{-# LANGUAGE GADTs, OverloadedStrings, ExtendedDefaultRules#-}
+
+module Web.Game where
+
+import Prelude hiding (div)
+import Text.Blaze.Html5 hiding (map)
+import qualified Text.Blaze.Html5.Attributes as A
+import Web.Routes.RouteT
+import Text.Blaze.Internal
+import Game
+import Control.Monad
+import Control.Monad.State
+import Data.Monoid
+import Control.Concurrent.STM
+import Language.Nomyx.Expression
+import Language.Nomyx.Evaluation
+import Data.Maybe
+import Text.Reform.Happstack
+import Text.Reform
+import Happstack.Server
+import Data.List
+import qualified Web.Help as Help
+import Web.Common
+import Types
+import Web.Routes.Happstack()
+import qualified Text.Reform.Blaze.String as RB hiding (form)
+import Control.Applicative
+import Utils
+import Mail
+import Data.Text(Text)
+import qualified Text.Reform.Blaze.Common as RBC
+default (Integer, Double, Data.Text.Text)
+
+
+viewGame :: Game -> PlayerNumber -> (Maybe SubmitRule) -> RoutedNomyxServer Html
+viewGame g pn sr = do
+   rf <- viewRuleForm pn sr
+   vi <- viewInputs pn $ events g
+   ok $ table $ do
+      td ! A.id "gameCol" $ do
+         table $ do
+            tr $ td $ h3 $ string $ "Viewing game: " ++ gameName g
+            tr $ td $ (string $ "Description: " ++ gameDesc g ++ "\n\n") >> br >> br
+            tr $ td $ viewPlayers $ players g
+            tr $ td $ viewVictory g
+      td ! A.id "gameElem" $ do
+         table $ do
+         tr $ td $ div ! A.id "rules" $ viewAllRules g
+         tr $ td $ div ! A.id "inputs" ! A.title (toValue Help.inputs) $ vi
+         tr $ td $ div ! A.id "events" ! A.title (toValue Help.events) $ viewEvents $ events g
+         tr $ td $ div ! A.id "variables" ! A.title (toValue Help.variables)$ viewVars $ variables g
+         tr $ td $ div ! A.id "newRule" $ rf
+         tr $ td $ div ! A.id "outputs" ! A.title (toValue Help.outputs)$ viewOutput (outputs g) pn
+
+viewPlayers :: [PlayerInfo] -> Html
+viewPlayers pis = do
+   h5 "Players in game:"
+   table $ mapM_ viewPlayer (sort pis)
+
+
+viewPlayer :: PlayerInfo -> Html
+viewPlayer pi = tr $ do
+    td $ string $ show $ playerNumber pi
+    td $ string $ playerName pi
+
+viewVictory :: Game -> Html
+viewVictory g = do
+    let vs = mapMaybe (getPlayersNameMay g) (victory g)
+    case vs of
+        []   -> br
+        a:[] -> h3 $ string $ "Player " ++ (show a) ++ " won the game!"
+        a:bs -> h3 $ string $ "Players " ++ (concat $ intersperse ", " $ bs) ++ " and " ++ a ++ " won the game!"
+
+viewAllRules :: Game -> Html
+viewAllRules g = do
+   h3 "Rules"
+   viewRules "Active rules:" (activeRules g) ! (A.title $ toValue Help.actives)
+   viewRules "Pending rules:" (pendingRules g) ! (A.title $ toValue Help.pendings)
+   viewRules "Suppressed rules:" $ rejectedRules g
+
+viewRules :: Html -> [Rule] -> Html
+viewRules _ [] = return ()
+viewRules title nrs = do
+   table ! A.class_ "table" $ do
+      caption $ h4 title
+      thead $ do
+         td ! A.class_ "td" $ text "Number"
+         td ! A.class_ "td" $ text "Name"
+         td ! A.class_ "td" $ text "Description"
+         td ! A.class_ "td" $ text "Proposed by"
+         td ! A.class_ "td" $ text "Code of the rule"
+         td ! A.class_ "td" $ text "Assessed by"
+      forM_ nrs viewRule
+
+viewRule :: Rule -> Html
+viewRule nr = tr $ do
+   td ! A.class_ "td" $ string . show $ rNumber nr
+   td ! A.class_ "td" $ string $ rName nr
+   td ! A.class_ "td" $ string $ rDescription nr
+   td ! A.class_ "td" $ string $ if rProposedBy nr == 0 then "System" else "Player " ++ (show $ rProposedBy nr)
+   td ! A.class_ "td" $ string $ rRuleCode nr
+   td ! A.class_ "td" $ string $ case rAssessedBy nr of
+      Nothing -> "Not assessed"
+      Just 0  -> "System"
+      Just a  -> "Rule " ++ (show $ a)
+
+viewEvents :: [EventHandler] -> Html
+viewEvents [] = h3 "Events" >> h5 "No Events"
+viewEvents ehs = do
+   h3 "Events"
+   table ! A.class_ "table" $ do
+      thead $ do
+         td ! A.class_ "td" $ text "Event Number"
+         td ! A.class_ "td" $ text "By Rule"
+         td ! A.class_ "td" $ text "Event"
+      mapM_ viewEvent $ sort ehs
+
+viewEvent :: EventHandler -> Html
+viewEvent (EH eventNumber ruleNumber event _) = tr $ do
+   td ! A.class_ "td" $ string . show $ eventNumber
+   td ! A.class_ "td" $ string . show $ ruleNumber
+   td ! A.class_ "td" $ string . show $ event
+
+viewInputs :: PlayerNumber -> [EventHandler] -> RoutedNomyxServer Html
+viewInputs pn ehs = do
+   mis <- mapM (viewInput pn) $ sort ehs
+   let is = catMaybes mis
+   case length is of
+      0 -> ok $ h3 "Inputs" >> h5 "No Inputs"
+      _ -> ok $ do
+         h3 "Inputs"
+         table $ do
+            mconcat is
+
+viewInput :: PlayerNumber -> EventHandler -> RoutedNomyxServer (Maybe Html)
+viewInput me (EH eventNumber _ (InputChoice pn title choices def) _) | me == pn = do
+    link <- showURL (DoInputChoice pn eventNumber)
+    lf  <- lift $ viewForm "user" $ inputChoiceForm title (map show choices) (show def)
+    return $ Just $ tr $ td $ blazeForm lf (link)
+viewInput me (EH _ _ (InputString pn title) _) | me == pn = do
+    link <- showURL (DoInputString pn title)
+    lf  <- lift $ viewForm "user" $ inputStringForm title
+    return $ Just $ tr $ td $ blazeForm lf (link)
+viewInput _ _ = return Nothing
+
+viewVars :: [Var] -> Html
+viewVars [] = h3 "Variables" >> h5 "No Variables"
+viewVars vs = do
+   h3 "Variables"
+   table ! A.class_ "table" $ do
+      thead $ do
+         td ! A.class_ "td" $ text "Rule number"
+         td ! A.class_ "td" $ text "Name"
+         td ! A.class_ "td" $ text "Value"
+      mapM_ viewVar vs
+
+viewVar :: Var -> Html
+viewVar (Var vRuleNumber vName vData) = tr $ do
+   td ! A.class_ "td" $ string . show $ vRuleNumber
+   td ! A.class_ "td" $ string . show $ vName
+   td ! A.class_ "td" $ string . show $ vData
+
+
+newRuleForm :: (Maybe SubmitRule) -> NomyxForm SubmitRule
+newRuleForm (Just sr) = newRuleForm' sr
+newRuleForm Nothing = newRuleForm' (SubmitRule "" "" "")
+
+newRuleForm' :: SubmitRule -> NomyxForm SubmitRule
+newRuleForm' (SubmitRule name desc code) = pure SubmitRule  <*> RB.label "Name: " ++> (RB.inputText name)
+                               <*> RB.label "      Short description: " ++> RB.inputText desc
+                               <*> RB.label "      Code: " ++> RB.textarea 80 15 code
+                                   `RBC.setAttr` A.class_ "code" `RBC.setAttr` A.placeholder "Enter here your rule" `RBC.setAttr` (A.title (toValue Help.code))
+
+
+viewRuleForm :: PlayerNumber -> (Maybe SubmitRule) -> RoutedNomyxServer Html
+viewRuleForm pn sr = do
+   link <- showURL (NewRule pn)
+   lf  <- lift $ viewForm "user" $ newRuleForm sr
+   ok $ do
+      h3 "Propose a new rule:"
+      blazeForm lf (link)
+
+newRule :: PlayerNumber -> (TVar Multi) -> RoutedNomyxServer Html
+newRule pn tm = do
+   methodM POST
+   m <- liftRouteT $ lift $ readTVarIO tm
+   r <- liftRouteT $ eitherForm environment "user" (newRuleForm Nothing)
+   link <- showURL $ Noop pn
+   case r of
+       Right sr -> do
+          --t <- liftRouteT $ lift $ getCurrentTime
+          --liftRouteT $ lift $ putStrLn $ "before: " ++ (show m) ++"\n" ++ (show t) ++"\n"
+
+          --t' <- liftRouteT $ lift $ getCurrentTime
+          --liftRouteT $ lift $ putStrLn $ "after: " ++ (show m) ++"\n" ++ (show t') ++"\n"
+          webCommand tm pn $ MultiSubmitRule sr pn
+          m' <- liftRouteT $ lift $ readTVarIO tm
+          let rs = rules $ fromJust $ getPlayersGame pn m
+          let rs' = rules $ fromJust $ getPlayersGame pn m'
+          when (length rs' > length rs) $ liftRouteT $ lift $ sendMailsNewRule m' sr pn
+       (Left _) -> liftRouteT $ lift $ putStrLn $ "cannot retrieve form data"
+   seeOther link $ string "Redirecting..."
+
+
+viewOutput :: [Output] -> PlayerNumber -> Html
+viewOutput [] _ = h3 "Output" >> h5 "No Output"
+viewOutput os pn = do
+   h3 "Output"
+   let myos = map snd $ filter (\o -> fst o == pn) os
+   mapM_ viewMessages [myos]
+
+viewMessages :: [String] -> Html
+viewMessages = mapM_ (\s -> string s >> br)
+
+
+newInputChoice :: PlayerNumber -> EventNumber -> (TVar Multi) -> RoutedNomyxServer Html
+newInputChoice pn en tm = do
+    multi <- liftRouteT $ lift $ atomically $ readTVar tm
+    let mg = fromJust $ getPlayersGame pn multi
+    let eventHandler = fromJust $ findEvent en (events mg)
+    methodM POST
+    let (title, choices, def) = getChoices eventHandler
+    r <- liftRouteT $ eitherForm environment "user" (inputChoiceForm title choices def)
+    link <- showURL $ Noop pn
+    case r of
+       (Right c) -> do
+          liftRouteT $ lift $ putStrLn $ "choice:" ++ (show c)
+          webCommand tm pn $ MultiInputChoiceResult en c pn
+          seeOther link $ string "Redirecting..."
+       (Left _) -> do
+          liftRouteT $ lift $ putStrLn $ "cannot retrieve form data"
+          seeOther link $ string "Redirecting..."
+
+getChoices :: EventHandler -> (String, [String], String)
+getChoices (EH _ _ (InputChoice _ title choices def) _) = (title, map show choices, show def)
+getChoices _ = error "InputChoice event expected"
+
+newInputString :: PlayerNumber -> String -> (TVar Multi) -> RoutedNomyxServer Html
+newInputString pn title tm = do
+    methodM POST
+    r <- liftRouteT $ eitherForm environment "user" (inputStringForm title)
+    link <- showURL $ Noop pn
+    case r of
+       (Right c) -> do
+          liftRouteT $ lift $ putStrLn $ "entered:" ++ (show c)
+          webCommand tm pn $ MultiInputStringResult title c pn
+          seeOther link $ string "Redirecting..."
+       (Left _) -> do
+          liftRouteT $ lift $ putStrLn $ "cannot retrieve form data"
+          seeOther link $ string "Redirecting..."
+
+
+inputChoiceForm :: String -> [String] -> String -> NomyxForm Int
+inputChoiceForm title choices def = RB.label (title ++ " ") ++> inputRadio' (zip [0..] choices) ((==) $ fromJust $ elemIndex def choices)
+
+inputStringForm :: String -> NomyxForm String
+inputStringForm title = RB.label (title ++ " ") ++> RB.inputText ""
+
diff --git a/src/Web/Help.hs b/src/Web/Help.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Help.hs
@@ -0,0 +1,23 @@
+-----------------------------------------------------------------------------
+--
+-- Module      :  Help
+-- Copyright   :
+-- License     :  OtherLicense
+--
+-- Maintainer  :  corentin.dupont@gmail.com
+-- Stability   :
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
+
+module Web.Help where
+upload = "You can upload your file containing custom rules here. File must be a haskell .hs file containing a module. Once correctly loaded, you will be able to propose the functions in the file as new rules."
+code = "This is where you type in your new rule. Its type must be \"RuleFunc\". As a first rule, you can try to type \"nothing\", which is a rule that does nothing. Other examples can be found in the file Examples.hs accessible on the left tab."
+actives = "Those rules are active and control the game. Usually, initial rules define how to propose and activate new rules (for example, a democratic vote) and how to win. Of course, this can be changed!"
+pendings = "Rules are pending after being proposed by a player. Only another, active rule can activate those rules with instruction \"activateRule\"."
+inputs = "Rules can trigger an input to gather data from the player, for example with the instruction \"onInputChoice\"."
+events = "Rules can register on events, in order to be triggered when the event happens, for example with the instruction \"onEvent\"."
+variables = "Rules can create variables to store data. For example, a rule creating a bank account with instruction \"newVar\" will make a new variable appear here."
+outputs = "Rules can display text on players screen, with instruction \"output\"."
diff --git a/src/Web/Login.hs b/src/Web/Login.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Login.hs
@@ -0,0 +1,133 @@
+{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules#-}
+
+module Web.Login where
+
+
+import Prelude hiding (div)
+import Text.Blaze.Html5 hiding (map, label, br)
+import Text.Blaze.Html5.Attributes hiding (dir, label)
+import qualified Text.Blaze.Html5 as H
+import Web.Routes.RouteT
+import Text.Blaze.Internal
+import Control.Monad.State
+import Control.Concurrent.STM
+import Language.Nomyx.Expression
+import Utils
+import Text.Reform.Happstack
+import Text.Reform
+import Debug.Trace.Helpers
+import Happstack.Server
+import Types
+import Multi --TODO to remove
+import Web.Common
+import Web.Settings
+import Web.Routes.Happstack()
+import Control.Applicative
+import Text.Reform.Blaze.String hiding (form)
+import Data.Text hiding (map, zip, concatMap)
+default (Integer, Double, Data.Text.Text)
+
+
+loginForm :: Maybe LoginPass -> NomyxForm LoginPass
+loginForm (Just (LoginPass login _)) = loginForm' login
+loginForm Nothing = loginForm' ""
+
+loginForm' :: String -> NomyxForm LoginPass
+loginForm' login = LoginPass <$> br ++> label "Please enter your login and password (if you don't have one, just invent it):" ++> br ++> br
+                   ++>  label "Login: " ++> (inputText login) <*> label "    Password: " ++> inputPassword <++ label " "
+
+
+loginPage :: RoutedNomyxServer Html
+loginPage = do
+   link <- showURL PostLogin
+   lf  <- lift $ viewForm "user" $ loginForm Nothing
+   mainPage (blazeForm lf link)
+             "Login to Nomyx"
+             "Login to Nomyx"
+             True
+
+newPlayerPage :: LoginPass -> RoutedNomyxServer Html
+newPlayerPage lp = do
+   link <- showURL $ NewPlayerLogin lp
+   lf  <- lift $ viewForm "user" $ loginForm (Just lp)
+   mf  <- lift $ viewForm "user" $ settingsForm Nothing
+   mainPage (do
+                lf ! (disabled "")
+                H.br >> H.br
+                "New Player? Welcome!" >> H.br
+                (blazeForm mf link))
+             "Login to Nomyx"
+             "New Player"
+             True
+
+
+newPlayerLogin :: (TVar Multi) -> LoginPass -> RoutedNomyxServer Html
+newPlayerLogin tm (LoginPass login password) = do
+    methodM POST
+    liftRouteT $ lift $ putStrLn $ "newPlayerLogin"
+    r <- liftRouteT $ eitherForm environment "user" $ settingsForm Nothing
+    case r of
+       (Right ms) -> do
+          mpn <- evalCommand tm $ checkLoginWeb login password
+          case mpn of
+             LoginOK pn -> do
+                link <- showURL $ Noop pn
+                webCommand tm pn $ MultiMailSettings ms pn
+                seeOther link $ string "Redirecting..."
+             WrongPassword -> do
+                link <- showURL $ Login
+                seeOther link $ string "Redirecting..."
+             NewLogin -> do
+                pn <- evalCommand tm $ getNewPlayerNumber
+                link <- showURL $ Noop pn
+                webCommand tm pn $ MultiNewPlayer PlayerMulti { mPlayerNumber = pn, mPlayerName = login, mPassword = password, inGame = Nothing, mMail = defaultMailSettings, lastRule = Nothing}
+                webCommand tm pn $ MultiMailSettings ms pn
+                seeOther link $ string "Redirecting..."
+       (Left _) -> seeOther ("/Login?status=fail" :: String) $ string "Redirecting..."
+
+
+
+postLogin :: (TVar Multi) -> RoutedNomyxServer Html
+postLogin tm = do
+    methodM POST
+    r <- liftRouteT $ eitherForm environment "user" $ loginForm Nothing
+    case r of
+       (Right lp) -> checkLoginPassword lp tm
+       (Left _) -> seeOther ("/Login?status=fail" :: String) $ string "Redirecting..."
+
+checkLoginPassword :: LoginPass -> (TVar Multi) -> RoutedNomyxServer Html
+checkLoginPassword lp@(LoginPass login password) tm = do
+          liftRouteT $ lift $ putStrLn $ "login:" ++ login
+          liftRouteT $ lift $ putStrLn $ "password:" ++ password
+          mpn <- evalCommand tm $ checkLoginWeb login password
+          case mpn of
+             LoginOK pn -> do
+                link <- showURL $ Noop pn
+                seeOther link $ string "Redirecting..."
+             WrongPassword -> do
+                link <- showURL $ Login
+                seeOther link $ string "Redirecting..."
+             NewLogin -> do
+                link <- showURL $ NewPlayer lp
+                seeOther link $ string "Redirecting..."
+
+data LoginResult = LoginOK PlayerNumber | WrongPassword | NewLogin
+
+checkLoginWeb :: PlayerName -> PlayerPassword -> State Multi LoginResult
+checkLoginWeb name pwd = do
+   mpn <- findPlayer name
+   case mpn of
+      Just pl -> do
+         traceM $ "Trying name:" ++ mPlayerName pl
+         case pwd == mPassword pl of
+            True -> do
+               traceM "password OK"
+               return $ LoginOK $ mPlayerNumber pl
+            False -> do
+               traceM "password false"
+               return WrongPassword
+      Nothing -> do
+         traceM "New player"
+         return NewLogin
+
+
diff --git a/src/Web/MainPage.hs b/src/Web/MainPage.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/MainPage.hs
@@ -0,0 +1,208 @@
+
+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleContexts, FlexibleInstances, TemplateHaskell,
+   EmptyDataDecls, TypeFamilies, MultiParamTypeClasses, DeriveDataTypeable, PackageImports, GADTs,
+   ScopedTypeVariables, NamedFieldPuns, Rank2Types, DoAndIfThenElse, StandaloneDeriving, OverloadedStrings, ExtendedDefaultRules#-}
+
+module Web.MainPage (launchWebServer) where
+
+import Prelude hiding (div)
+import Text.Blaze.Html5 hiding (map)
+import Text.Blaze.Html5.Attributes hiding (dir)
+import qualified Text.Blaze.Html5 as H
+import qualified Text.Blaze.Html5.Attributes as A
+import Web.Routes.Site
+import Web.Routes.PathInfo
+import Web.Routes.Happstack
+import Web.Routes.RouteT
+import Text.Blaze.Internal
+import Control.Monad
+import Paths_Nomyx as PN
+import Paths_Nomyx_Rules as PNR
+import Control.Monad.State
+import Data.Monoid
+import Control.Concurrent.STM
+import Language.Nomyx.Expression
+import Text.Reform.Happstack
+import Text.Reform
+import Happstack.Server as HS
+import System.Directory
+import System.FilePath
+import System.Posix.Files
+import qualified Web.Help as Help
+import Types
+import Web.Game
+import Web.Common
+import Web.Login
+import Web.Settings
+import Web.NewGame
+import qualified Text.Reform.Blaze.String as RB
+import Utils
+import Data.Maybe
+import Data.List
+import Data.Text(Text, pack)
+default (Integer, Double, Data.Text.Text)
+
+
+viewMulti :: PlayerNumber -> Multi -> RoutedNomyxServer Html
+viewMulti pn m = do
+   let pl = fromJust $ find (\PlayerMulti {mPlayerNumber} -> pn==mPlayerNumber) (mPlayers m)
+   gns <- viewGamesTab pn (games m)
+   g <- case getPlayersGame pn m of
+            Just g -> viewGame g pn (lastRule pl)
+            Nothing -> ok $ h3 "Not in game"
+   ok $ do
+      div ! A.id "gameList" $ gns
+      div ! A.id "game" $ g
+
+viewGamesTab :: PlayerNumber -> [Game] -> RoutedNomyxServer Html
+viewGamesTab pn gs = do
+   gns <- mapM (viewGameName pn) gs
+   newGameLink <- showURL (NewGame pn)
+   uploadLink <- showURL (Upload pn)
+   settingsLink <- showURL (Settings pn)
+   up  <- lift $ viewForm "user" uploadForm
+   dd <- lift $ lift $ PN.getDataDir
+   mods <- lift $ lift $ getDirectoryContents $ dd </> modDir
+   fmods <- lift $ lift $ filterM (getFileStatus . (\f -> joinPath [dd, modDir, f]) >=> return . isRegularFile) $ mods
+   ok $ do
+      h3 "Main menu" >> br
+      "Active games:" >> br
+      table $ do
+         case gs of
+            [] -> tr $ td "No Games"
+            _ ->  sequence_ gns
+      br >> "Nomyx language files:" >> br
+      H.a "Rules examples" ! (href $ "/src/Language/Nomyx/Examples.hs") >> br
+      H.a "Rules definitions" ! (href $ "/src/Language/Nomyx/Rule.hs") >> br
+      H.a "Rules types" ! (href $ "/src/Language/Nomyx/Expression.hs") >> br
+      mapM_ (\f -> (H.a $ toHtml f ) ! (href $ toValue (pathSeparator : modDir </> f)) >> br) fmods
+      br >> "Upload new rules file:" >> br
+      blazeForm up (uploadLink) ! (A.title $ toValue Help.upload)
+      br >> "Settings:" >> br
+      H.a "Create a new game" ! (href $ toValue newGameLink) >> br
+      H.a "Player settings" ! (href $ toValue settingsLink) >> br
+
+
+viewGameName :: PlayerNumber -> Game -> RoutedNomyxServer Html
+viewGameName pn g = do
+   let gn = gameName g
+   join <- showURL (JoinGame pn gn)
+   leave <- showURL (LeaveGame pn)
+   --subscribe <- showURL (SubscribeGame pn gn)
+   unsubscribe <- showURL (UnsubscribeGame pn gn)
+   ok $ do
+      tr $ do
+         td $ string $ gn
+         td $ H.a "Join" ! (href $ toValue join)
+         td $ H.a "Leave" ! (href $ toValue leave)
+         --td $ H.a "Subscribe" ! (href $ toValue subscribe)
+         td $ H.a "Unsubscribe" ! (href $ toValue unsubscribe)
+
+
+
+nomyxPage :: Multi -> PlayerNumber -> RoutedNomyxServer Html
+nomyxPage multi pn = do
+   m <- viewMulti pn multi
+   mainPage (H.div ! A.id "multi" $ m)
+             "Welcome to Nomyx!"
+             (string $ "Welcome to Nomyx, " ++ (getPlayersName pn multi) ++ "!")
+             False
+
+nomyxPageServer :: PlayerNumber -> (TVar Multi) -> RoutedNomyxServer Html
+nomyxPageServer pn tm = do
+   multi <- liftRouteT $ lift $ atomically $ readTVar tm
+   nomyxPage multi pn
+
+nomyxSite :: (TVar Multi) -> Site PlayerCommand (ServerPartT IO Html)
+nomyxSite tm = setDefault Login $ mkSitePI (runRouteT $ routedNomyxCommands tm)
+
+routedNomyxCommands :: (TVar Multi) -> PlayerCommand -> RoutedNomyxServer Html
+routedNomyxCommands _  (Login)                     = loginPage
+routedNomyxCommands _  (NewPlayer lp)              = newPlayerPage lp
+routedNomyxCommands tm (NewPlayerLogin lp)         = newPlayerLogin tm lp
+routedNomyxCommands tm (PostLogin)                 = postLogin tm
+routedNomyxCommands tm (Noop pn)                   = nomyxPageServer pn tm
+routedNomyxCommands tm (JoinGame pn game)          = webCommand tm pn (MultiJoinGame game pn)        >> nomyxPageServer pn tm
+routedNomyxCommands tm (LeaveGame pn)              = webCommand tm pn (MultiLeaveGame pn)            >> nomyxPageServer pn tm
+routedNomyxCommands tm (SubscribeGame pn game)     = webCommand tm pn (MultiSubscribeGame game pn)   >> nomyxPageServer pn tm
+routedNomyxCommands tm (UnsubscribeGame pn game)   = webCommand tm pn (MultiUnsubscribeGame game pn) >> nomyxPageServer pn tm
+routedNomyxCommands tm (NewRule pn)                = newRule pn tm
+routedNomyxCommands _  (NewGame pn)                = newGamePage pn
+routedNomyxCommands tm (SubmitNewGame pn)          = newGame pn tm
+routedNomyxCommands tm (DoInputChoice pn en)       = newInputChoice pn en tm
+routedNomyxCommands tm (DoInputString pn en)       = newInputString pn en tm
+routedNomyxCommands tm (Upload pn)                 = newUpload pn tm
+routedNomyxCommands tm (Settings pn)               = settings pn tm
+routedNomyxCommands tm (SubmitSettings pn)         = newSettings pn tm
+
+
+
+{-
+nomyxPageComm' :: PlayerNumber -> (TVar Multi) -> StateT Multi IO () -> RoutedNomyxServer Html
+nomyxPageComm' pn tm comm = do
+    liftRouteT $ lift $ protectedExecCommand tm comm
+    nomyxPageServer pn tm
+
+protectedExecCommand :: (TVar Multi) -> StateT Multi IO a -> IO ()
+protectedExecCommand tm sm = do
+    --liftIO $ mapM_ (uncurry setResourceLimit) limits
+    mv <- newEmptyMVar
+    before <- atomically $ readTVar tm
+    id <- forkIO $ CE.catchJust  (\e -> if isUserError e then Just () else Nothing) (execBlocking sm before mv) (\e-> putStrLn $ show e)
+    forkIO $ watchDog' 10 id mv
+    getCurrentTime >>= (\a -> putStrLn $ "before takevar " ++ show a)
+    res <- takeMVar mv
+    case res of
+       Nothing -> (atomically $ writeTVar tm before) >> getCurrentTime >>= (\a -> putStrLn $ "writing before" ++ show a)
+       Just (_, after) -> (atomically $ writeTVar tm after) >> getCurrentTime >>= (\a -> putStrLn $ "writing after " ++ show a)
+
+watchDog' :: Int -> ThreadId -> MVar (Maybe x) -> IO ()
+watchDog' t tid mv = do
+   threadDelay $ t * 1000000
+   killThread tid
+   getCurrentTime >>= (\a -> putStrLn $ "process timeout " ++ show a)
+   tryPutMVar mv Nothing
+   return ()
+
+execBlocking :: StateT Multi IO a -> Multi -> MVar (Maybe (a, Multi)) -> IO ()
+execBlocking sm m mv = do
+   hSetBuffering stdout NoBuffering
+   getCurrentTime >>= (\a -> putStrLn $ "before runstate " ++ show a)
+   res@(_, m') <- runStateT sm m --runStateT (inPlayersGameDo 1 $ liftT $ evalExp (do let (a::Int) = a in outputAll $ show a) 1) m --
+   getCurrentTime >>= (\a -> putStrLn $ "after runstate " ++ show a)
+   res' <- evaluate res
+   putMVar mv (Just res')
+-}
+
+
+uploadForm :: NomyxForm (FilePath, FilePath, ContentType)
+uploadForm = RB.inputFile
+
+newUpload :: PlayerNumber -> (TVar Multi) -> RoutedNomyxServer Html
+newUpload pn tm = do
+    methodM POST
+    r <- liftRouteT $ eitherForm environment "user" uploadForm
+    link <- showURL $ Noop pn
+    case r of
+       (Right (path,name,_)) -> webCommand tm pn $ MultiInputUpload pn path name
+       (Left _) -> liftRouteT $ lift $ putStrLn $ "cannot retrieve form data"
+    seeOther link $ string "Redirecting..."
+
+
+launchWebServer :: (TVar Multi) -> Network -> IO ()
+launchWebServer tm net = do
+   putStrLn $ "Starting web server...\nTo connect, drive your browser to \"" ++ nomyxURL net ++ "/Nomyx\""
+   d <- PN.getDataDir
+   d' <- PNR.getDataDir
+   simpleHTTP nullConf {HS.port = Types.port net} $ server d d' tm net
+
+--serving Nomyx web page as well as data from this package and the language library package
+server :: FilePath -> FilePath -> (TVar Multi) -> Network -> NomyxServer Response
+server d d' tm net = mconcat [
+    serveDirectory EnableBrowsing [] d,
+    serveDirectory EnableBrowsing [] d', do
+       decodeBody (defaultBodyPolicy "/tmp/" 102400 4096 4096)
+       html <- implSite (pack (nomyxURL net)) "/Nomyx" (nomyxSite tm)
+       return $ toResponse html]
+
+
diff --git a/src/Web/NewGame.hs b/src/Web/NewGame.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/NewGame.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules, OverloadedStrings, NamedFieldPuns#-}
+
+
+module Web.NewGame where
+
+import Text.Blaze.Html5 hiding (map, label, br, textarea)
+import Prelude hiding (div)
+import Text.Reform
+import Text.Blaze.Html5.Attributes hiding (label)
+import Text.Reform.Blaze.String hiding (form)
+import qualified Text.Reform.Blaze.Common as RBC
+import Text.Reform.Happstack()
+import Control.Applicative
+import Types
+import Happstack.Server
+import Text.Reform.Happstack
+import Web.Common
+import Control.Monad.State
+import Language.Nomyx.Expression
+import Web.Routes.RouteT
+import Control.Concurrent.STM
+import Data.Text(Text)
+import Text.Blaze.Internal(string)
+default (Integer, Double, Data.Text.Text)
+
+
+data NewGameForm = NewGameForm GameName String
+
+newGameForm :: NomyxForm NewGameForm
+newGameForm = pure NewGameForm <*> br ++> label "Enter new game name: " ++> (inputText "") `RBC.setAttr` placeholder "Game name"  <++ br <++ br
+                               <*> label "Enter game description, including a link to a place (e.g. a forum, a mailing list...) where the players can discuss their rules: " ++> br
+                                   ++> (textarea 40 3 "") `RBC.setAttr` placeholder "Enter game description" `RBC.setAttr` class_ "gameDesc"
+
+
+newGamePage :: PlayerNumber -> RoutedNomyxServer Html
+newGamePage pn = do
+   newGameLink <- showURL (SubmitNewGame pn)
+   mf <- lift $ viewForm "user" $ newGameForm
+   mainPage (blazeForm mf newGameLink)
+             "New game"
+             "New game"
+             False
+
+newGame :: PlayerNumber -> (TVar Multi) -> RoutedNomyxServer Html
+newGame pn tm = do
+   methodM POST
+   r <- liftRouteT $ eitherForm environment "user" newGameForm
+   link <- showURL $ Noop pn
+   case r of
+      Left _ -> error $ "error: newGame"
+      Right (NewGameForm name desc) -> webCommand tm pn $ MultiNewGame name desc pn
+   seeOther link $ string "Redirecting..."
diff --git a/src/Web/Settings.hs b/src/Web/Settings.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/Settings.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules, OverloadedStrings, NamedFieldPuns#-}
+
+
+module Web.Settings where
+
+import Text.Blaze.Html5 hiding (map, label, br)
+
+import Prelude hiding (div)
+import Text.Reform
+import Text.Reform.Blaze.String hiding (form)
+import Text.Reform.Happstack()
+import Control.Applicative
+import Types
+import Happstack.Server
+import Text.Reform.Happstack
+import Web.Common
+import Control.Monad.State
+import Language.Nomyx.Expression
+import Web.Routes.RouteT
+import Utils
+import Control.Concurrent.STM
+import Data.Maybe
+import Data.Text(Text)
+import Text.Blaze.Internal(string)
+default (Integer, Double, Data.Text.Text)
+
+
+
+settingsForm :: (Maybe MailSettings) -> NomyxForm MailSettings
+settingsForm (Just (MailSettings {mailTo, mailNewRule})) = settingsForm' mailTo mailNewRule
+settingsForm Nothing = settingsForm' "" True
+
+settingsForm':: String -> Bool -> NomyxForm MailSettings
+settingsForm' mailTo mailNewRule = pure MailSettings <*> label "Please enter your mail: " ++> inputText mailTo <++ br
+                             <*> pure True --label " send mail on new input needed from you: " ++> inputCheckbox True <++ label " " <++ br
+                             <*> inputCheckbox mailNewRule <++ label " I want to be notified by email if a player proposes a new rule (recommended)" <++ br
+                             <*> pure True --label " send mail on new output: " ++> inputCheckbox True <++ label " "
+                             <*> pure True
+
+settingsPage :: PlayerNumber -> MailSettings -> RoutedNomyxServer Html
+settingsPage pn ms = do
+   settingsLink <- showURL (SubmitSettings pn)
+   mf <- lift $ viewForm "user" $ settingsForm (Just ms)
+   mainPage (blazeForm mf settingsLink)
+             "Player settings"
+             "Player settings"
+             False
+
+
+settings :: PlayerNumber -> (TVar Multi) -> RoutedNomyxServer Html
+settings pn tm  = do
+   pm <- evalCommand tm $ findPlayer' pn
+   settingsPage pn $ mMail $ fromJust pm
+
+
+newSettings :: PlayerNumber -> (TVar Multi) -> RoutedNomyxServer Html
+newSettings pn tm = do
+   methodM POST
+   r <- liftRouteT $ eitherForm environment "user" $ settingsForm Nothing
+   link <- showURL $ Noop pn
+   case r of
+       Right ms -> webCommand tm pn $ MultiMailSettings ms pn
+       (Left _) -> liftRouteT $ lift $ putStrLn $ "cannot retrieve form data"
+   seeOther link $ string "Redirecting..."