- burp's patch cleaning up module dependancies + cabal file
authorunc0rr
Sun, 25 Jul 2010 18:55:54 +0400
changeset 3671 a94d1dc4a8d9
parent 3669 19be65b12c43
child 3673 45778b16b224
child 3674 10f3099b497c
- burp's patch cleaning up module dependancies + cabal file - mixed with some changes by me trying to fight a bug
gameServer/Actions.hs
gameServer/ClientIO.hs
gameServer/HWProtoCore.hs
gameServer/HWProtoNEState.hs
gameServer/OfficialServer/DBInteraction.hs
gameServer/Opts.hs
gameServer/ServerCore.hs
gameServer/Store.hs
gameServer/Utils.hs
gameServer/hedgewars-server.cabal
gameServer/stresstest3.hs
--- a/gameServer/Actions.hs	Sun Jul 25 10:16:34 2010 -0400
+++ b/gameServer/Actions.hs	Sun Jul 25 18:55:54 2010 +0400
@@ -7,9 +7,9 @@
 import qualified Data.Set as Set
 import qualified Data.Sequence as Seq
 import System.Log.Logger
-import Monad
+import Control.Monad
 import Data.Time
-import Maybe
+import Data.Maybe
 import Control.Monad.Reader
 import Control.Monad.State
 import qualified Data.ByteString.Char8 as B
@@ -116,11 +116,11 @@
                         readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r
                         }) ri
 
-        removeClient rnc ci
-
     modify (\s -> s{removedClients = ci `Set.insert` removedClients s})
 
 processAction (DeleteClient ci) = do
+    rnc <- gets roomsClients
+    liftIO $ removeClient rnc ci
     modify (\s -> s{removedClients = ci `Set.delete` removedClients s})
 
 {-
--- a/gameServer/ClientIO.hs	Sun Jul 25 10:16:34 2010 -0400
+++ b/gameServer/ClientIO.hs	Sun Jul 25 18:55:54 2010 +0400
@@ -61,7 +61,7 @@
 clientSendLoop s coreChan chan ci = do
     answer <- readChan chan
     doClose <- Exception.handle
-        (\(e :: Exception.IOException) -> if isQuit answer then return True else sendQuit e >> return False) $ do
+        (\(e :: Exception.IOException) -> if isQuit answer then return True else sendQuit e >> return True) $ do
             sendAll s $ (B.unlines answer) `B.append` (B.singleton '\n')
             return $ isQuit answer
 
--- a/gameServer/HWProtoCore.hs	Sun Jul 25 10:16:34 2010 -0400
+++ b/gameServer/HWProtoCore.hs	Sun Jul 25 18:55:54 2010 +0400
@@ -3,7 +3,7 @@
 
 import qualified Data.IntMap as IntMap
 import Data.Foldable
-import Maybe
+import Data.Maybe
 import Control.Monad.Reader
 --------------------------------------
 import CoreTypes
--- a/gameServer/HWProtoNEState.hs	Sun Jul 25 10:16:34 2010 -0400
+++ b/gameServer/HWProtoNEState.hs	Sun Jul 25 18:55:54 2010 +0400
@@ -2,7 +2,7 @@
 module HWProtoNEState where
 
 import qualified Data.IntMap as IntMap
-import Maybe
+import Data.Maybe
 import Data.List
 import Data.Word
 import Control.Monad.Reader
--- a/gameServer/OfficialServer/DBInteraction.hs	Sun Jul 25 10:16:34 2010 -0400
+++ b/gameServer/OfficialServer/DBInteraction.hs	Sun Jul 25 18:55:54 2010 +0400
@@ -11,8 +11,7 @@
 import qualified Control.Exception as Exception
 import Control.Monad
 import qualified Data.Map as Map
-import Monad
-import Maybe
+import Data.Maybe
 import System.Log.Logger
 import Data.Time
 ------------------------
--- a/gameServer/Opts.hs	Sun Jul 25 10:16:34 2010 -0400
+++ b/gameServer/Opts.hs	Sun Jul 25 18:55:54 2010 +0400
@@ -3,7 +3,7 @@
     getOpts,
 ) where
 
-import System
+import System.Environment
 import System.Console.GetOpt
 import Network
 import Data.Maybe ( fromMaybe )
--- a/gameServer/ServerCore.hs	Sun Jul 25 10:16:34 2010 -0400
+++ b/gameServer/ServerCore.hs	Sun Jul 25 18:55:54 2010 +0400
@@ -74,7 +74,7 @@
 
     return ()
 
-    forkIO $ timerLoop 0 $ coreChan serverInfo
+    --forkIO $ timerLoop 0 $ coreChan serverInfo
 
     startDBConnection serverInfo
 
@@ -82,4 +82,4 @@
 
     forkIO $ evalStateT mainLoop (ServerState Nothing serverInfo Set.empty rnc)
 
-    forever $ threadDelay (60 * 60 * 10^6) >> putStrLn "***"
+    forever $ threadDelay (60 * 60 * 10^6)
--- a/gameServer/Store.hs	Sun Jul 25 10:16:34 2010 -0400
+++ b/gameServer/Store.hs	Sun Jul 25 18:55:54 2010 +0400
@@ -77,7 +77,7 @@
 removeElem :: MStore e -> ElemIndex -> IO ()
 removeElem (MStore ref) (ElemIndex n) = do
     (busyElems, freeElems, arr) <- readIORef ref
-    IOA.writeArray arr n undefined
+    IOA.writeArray arr n (error "Store: no element")
     writeIORef ref (IntSet.delete n busyElems, IntSet.insert n freeElems, arr)
 
 
--- a/gameServer/Utils.hs	Sun Jul 25 10:16:34 2010 -0400
+++ b/gameServer/Utils.hs	Sun Jul 25 18:55:54 2010 +0400
@@ -14,7 +14,7 @@
 import System.IO
 import qualified Data.List as List
 import Control.Monad
-import Maybe
+import Data.Maybe
 -------------------------------------------------
 import qualified Codec.Binary.Base64 as Base64
 import qualified Data.ByteString.Char8 as B
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gameServer/hedgewars-server.cabal	Sun Jul 25 18:55:54 2010 +0400
@@ -0,0 +1,32 @@
+Name:                hedgewars-server
+Version:             0.1
+Synopsis:            hedgewars server
+Description:         hedgewars server
+Homepage:            http://www.hedgewars.org/
+License:             GPL-2
+Author:              unC0Rr
+Maintainer:          unC0Rr@hedgewars.org
+Category:            Game
+Build-type:          Simple
+Cabal-version:       >=1.2
+
+
+Executable hedgewars-server
+  main-is: hedgewars-server.hs
+
+  Build-depends:
+    base >= 4,
+    unix,
+    containers,
+    array,
+    bytestring,
+    network-bytestring,
+    network,
+    time,
+    stm,
+    mtl,
+    dataenc,
+    hslogger,
+    process
+  
+  ghc-options: -O2
\ No newline at end of file
--- a/gameServer/stresstest3.hs	Sun Jul 25 10:16:34 2010 -0400
+++ b/gameServer/stresstest3.hs	Sun Jul 25 18:55:54 2010 +0400
@@ -19,7 +19,6 @@
 type SState = Handle
 io = liftIO
 
-        
 readPacket :: StateT SState IO [String]
 readPacket = do
     h <- get
@@ -45,22 +44,26 @@
 
 emulateSession :: StateT SState IO ()
 emulateSession = do
+    n <- io $ randomRIO (100000::Int, 100000)
     waitPacket "CONNECTED"
-    sendPacket ["NICK", "test"]
+    sendPacket ["NICK", "test" ++ (show n)]
     waitPacket "NICK"
     sendPacket ["PROTO", "31"]
     waitPacket "PROTO"
     b <- waitPacket "LOBBY:JOINED"
-    io $ print b
+    --io $ print b
+    return ()
 
 testing = Control.OldException.handle print $ do
-    putStrLn "Start"
+    putStr "+"
     sock <- connectTo "127.0.0.1" (PortNumber 46631)
     evalStateT emulateSession sock
-    putStrLn "Finish"
+    --hClose sock
+    putStr "-"
+    hFlush stdout
 
 forks = forever $ do
-    delay <- randomRIO (400000::Int, 600000)
+    delay <- randomRIO (20000::Int, 40000)
     threadDelay delay
     forkIO testing