--- a/gameServer/Actions.hs Sat Jun 05 20:49:51 2010 +0000
+++ b/gameServer/Actions.hs Sun Jun 06 15:29:33 2010 +0000
@@ -1,4 +1,4 @@
-
+{-# LANGUAGE OverloadedStrings #-}
module Actions where
import Control.Concurrent
@@ -11,7 +11,7 @@
import Maybe
import Control.Monad.Reader
import Control.Monad.State
-
+import Data.ByteString.Char8 as B
-----------------------------
import CoreTypes
import Utils
@@ -19,27 +19,27 @@
import ServerState
data Action =
- AnswerClients [ClientChan] [String]
+ AnswerClients [ClientChan] [ByteString]
| SendServerMessage
| SendServerVars
| RoomAddThisClient RoomIndex -- roomID
- | RoomRemoveThisClient String
- | RemoveTeam String
+ | RoomRemoveThisClient ByteString
+ | RemoveTeam ByteString
| RemoveRoom
| UnreadyRoomClients
| MoveToLobby
- | ProtocolError String
- | Warning String
- | ByeClient String
+ | ProtocolError ByteString
+ | Warning ByteString
+ | ByeClient ByteString
| KickClient ClientIndex -- clID
| KickRoomClient ClientIndex -- clID
- | BanClient String -- nick
+ | BanClient ByteString -- nick
| RemoveClientTeams ClientIndex -- clID
| ModifyClient (ClientInfo -> ClientInfo)
| ModifyClient2 ClientIndex (ClientInfo -> ClientInfo)
| ModifyRoom (RoomInfo -> RoomInfo)
| ModifyServerInfo (ServerInfo -> ServerInfo)
- | AddRoom String String
+ | AddRoom ByteString ByteString
| CheckRegistered
| ClearAccountsCache
| ProcessAccountInfo AccountInfo
@@ -48,7 +48,7 @@
| PingAll
| StatsAction
-type CmdHandler = [String] -> Reader (ClientIndex, IRnC) [Action]
+type CmdHandler = [ByteString] -> Reader (ClientIndex, IRnC) [Action]
processAction :: Action -> StateT ServerState IO ()
@@ -96,13 +96,13 @@
rnc <- gets roomsClients
ri <- clientRoomA
when (ri /= lobbyId) $ do
- processAction $ RoomRemoveThisClient ("quit: " ++ msg)
+ processAction $ RoomRemoveThisClient ("quit: " `B.append` msg)
return ()
chan <- clients sendChan
liftIO $ do
- infoM "Clients" (show ci ++ " quits: " ++ msg)
+ infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg))
--mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom
@@ -370,8 +370,8 @@
si <- gets serverInfo
liftIO $ do
ci <- addClient rnc client
- forkIO $ clientRecvLoop (clientHandle client) (coreChan si) ci
- forkIO $ clientSendLoop (clientHandle client) (coreChan si) (sendChan client) ci
+ forkIO $ clientRecvLoop (clientSocket client) (coreChan si) ci
+ forkIO $ clientSendLoop (clientSocket client) (coreChan si) (sendChan client) ci
infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client))
writeChan (sendChan client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]
--- a/gameServer/ClientIO.hs Sat Jun 05 20:49:51 2010 +0000
+++ b/gameServer/ClientIO.hs Sun Jun 06 15:29:33 2010 +0000
@@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
module ClientIO where
import qualified Control.Exception as Exception
@@ -6,53 +6,71 @@
import Control.Concurrent
import Control.Monad
import System.IO
-import qualified Data.ByteString.UTF8 as BUTF8
-import qualified Data.ByteString as B
+import Network
+import Network.Socket.ByteString
+import qualified Data.ByteString.Char8 as B
----------------
import CoreTypes
import RoomsAndClients
-
-listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> ClientIndex -> IO ()
-listenLoop handle linesNumber buf chan clientID = do
- putStrLn $ show handle ++ show buf ++ show clientID
- str <- liftM BUTF8.toString $ B.hGetLine handle
- if (linesNumber > 50) || (length str > 450) then
- protocolViolationMsg >> freeClient
- else
- if str == "" then do
- writeChan chan $ ClientMessage (clientID, reverse buf)
- yield
- listenLoop handle 0 [] chan clientID
- else
- listenLoop handle (linesNumber + 1) (str : buf) chan clientID
- where
- protocolViolationMsg = writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"])
- freeClient = writeChan chan $ FreeClient clientID
+import Utils
-clientRecvLoop :: Handle -> Chan CoreMessage -> ClientIndex -> IO ()
-clientRecvLoop handle chan clientID =
- listenLoop handle 0 [] chan clientID
- `catch` (\e -> clientOff (show e) >> freeClient >> return ())
+pDelim :: B.ByteString
+pDelim = B.pack "\n\n"
+
+bs2Packets :: B.ByteString -> ([[B.ByteString]], B.ByteString)
+bs2Packets buf = unfoldrE extractPackets buf
+ where
+ extractPackets :: B.ByteString -> Either B.ByteString ([B.ByteString], B.ByteString)
+ extractPackets buf =
+ let buf' = until (not . B.isPrefixOf pDelim) (B.drop 2) buf in
+ let (bsPacket, bufTail) = B.breakSubstring pDelim buf' in
+ if B.null bufTail then
+ Left bsPacket
+ else
+ if B.null bsPacket then
+ Left bufTail
+ else
+ Right (B.splitWith (== '\n') bsPacket, bufTail)
+
+
+listenLoop :: Socket -> Chan CoreMessage -> ClientIndex -> IO ()
+listenLoop sock chan ci = recieveWithBufferLoop B.empty
+ where
+ recieveWithBufferLoop recvBuf = do
+ recvBS <- recv sock 4096
+ putStrLn $ show sock ++ " got smth: " ++ (show $ B.length recvBS)
+ unless (B.null recvBS) $ do
+ let (packets, newrecvBuf) = bs2Packets $ B.append recvBuf recvBS
+ forM_ packets sendPacket
+ recieveWithBufferLoop newrecvBuf
+
+ sendPacket packet = writeChan chan $ ClientMessage (ci, packet)
+
+
+clientRecvLoop :: Socket -> Chan CoreMessage -> ClientIndex -> IO ()
+clientRecvLoop s chan ci = do
+ msg <- (listenLoop s chan ci >> return "Connection closed") `catch` (return . B.pack . show)
+ clientOff msg
where
- clientOff msg = writeChan chan $ ClientMessage (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message
- freeClient = writeChan chan $ FreeClient clientID
+ clientOff msg = writeChan chan $ ClientMessage (ci, ["QUIT", msg])
+
-clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> ClientIndex -> IO()
-clientSendLoop handle coreChan chan clientID = do
+
+clientSendLoop :: Socket -> Chan CoreMessage -> Chan [B.ByteString] -> ClientIndex -> IO()
+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
- B.hPutStrLn handle $ BUTF8.fromString $ unlines answer
- hFlush handle
+ sendAll s $ (B.unlines answer) `B.append` (B.singleton '\n')
return $ isQuit answer
if doClose then
- Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on hClose") $ hClose handle
+ Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on sClose") $ sClose s
else
- clientSendLoop handle coreChan chan clientID
+ clientSendLoop s coreChan chan ci
where
- sendQuit e = writeChan coreChan $ ClientMessage (clientID, ["QUIT", show e])
+ sendQuit e = writeChan coreChan $ ClientMessage (ci, ["QUIT", B.pack $ show e])
isQuit ("BYE":xs) = True
isQuit _ = False
--- a/gameServer/CoreTypes.hs Sat Jun 05 20:49:51 2010 +0000
+++ b/gameServer/CoreTypes.hs Sun Jun 06 15:29:33 2010 +0000
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
module CoreTypes where
import System.IO
@@ -10,20 +11,21 @@
import Data.Time
import Network
import Data.Function
+import Data.ByteString.Char8 as B
import RoomsAndClients
-type ClientChan = Chan [String]
+type ClientChan = Chan [B.ByteString]
data ClientInfo =
ClientInfo
{
sendChan :: ClientChan,
- clientHandle :: Handle,
- host :: String,
+ clientSocket :: Socket,
+ host :: B.ByteString,
connectTime :: UTCTime,
- nick :: String,
- webPassword :: String,
+ nick :: B.ByteString,
+ webPassword :: B.ByteString,
logonPassed :: Bool,
clientProto :: !Word16,
roomID :: !Int,
@@ -31,46 +33,46 @@
isMaster :: Bool,
isReady :: Bool,
isAdministrator :: Bool,
- clientClan :: String,
+ clientClan :: B.ByteString,
teamsInGame :: Word
}
instance Show ClientInfo where
- show ci = " nick: " ++ (nick ci) ++ " host: " ++ (host ci)
+ show ci = " nick: " ++ (unpack $ nick ci) ++ " host: " ++ (unpack $ host ci)
instance Eq ClientInfo where
- (==) = (==) `on` clientHandle
+ (==) = (==) `on` clientSocket
data HedgehogInfo =
- HedgehogInfo String String
+ HedgehogInfo B.ByteString B.ByteString
data TeamInfo =
TeamInfo
{
teamownerId :: !Int,
- teamowner :: String,
- teamname :: String,
- teamcolor :: String,
- teamgrave :: String,
- teamfort :: String,
- teamvoicepack :: String,
- teamflag :: String,
+ teamowner :: B.ByteString,
+ teamname :: B.ByteString,
+ teamcolor :: B.ByteString,
+ teamgrave :: B.ByteString,
+ teamfort :: B.ByteString,
+ teamvoicepack :: B.ByteString,
+ teamflag :: B.ByteString,
difficulty :: Int,
hhnum :: Int,
hedgehogs :: [HedgehogInfo]
}
instance Show TeamInfo where
- show ti = "owner: " ++ (teamowner ti)
- ++ "name: " ++ (teamname ti)
- ++ "color: " ++ (teamcolor ti)
+ show ti = "owner: " ++ (unpack $ teamowner ti)
+ ++ "name: " ++ (unpack $ teamname ti)
+ ++ "color: " ++ (unpack $ teamcolor ti)
data RoomInfo =
RoomInfo
{
masterID :: !Int,
- name :: String,
- password :: String,
+ name :: B.ByteString,
+ password :: B.ByteString,
roomProto :: Word16,
teams :: [TeamInfo],
gameinprogress :: Bool,
@@ -79,10 +81,10 @@
playersIDs :: IntSet.IntSet,
isRestrictedJoins :: Bool,
isRestrictedTeams :: Bool,
- roundMsgs :: Seq String,
- leftTeams :: [String],
+ roundMsgs :: Seq B.ByteString,
+ leftTeams :: [B.ByteString],
teamsAtStart :: [TeamInfo],
- params :: Map.Map String [String]
+ params :: Map.Map B.ByteString [B.ByteString]
}
instance Show RoomInfo where
@@ -123,14 +125,14 @@
{
isDedicated :: Bool,
serverMessage :: String,
- serverMessageForOldVersions :: String,
+ serverMessageForOldVersions :: B.ByteString,
latestReleaseVersion :: Word16,
listenPort :: PortNumber,
nextRoomID :: Int,
- dbHost :: String,
- dbLogin :: String,
- dbPassword :: String,
- lastLogins :: [(String, UTCTime)],
+ dbHost :: B.ByteString,
+ dbLogin :: B.ByteString,
+ dbPassword :: B.ByteString,
+ lastLogins :: [(B.ByteString, UTCTime)],
stats :: TMVar StatisticsInfo,
coreChan :: Chan CoreMessage,
dbQueries :: Chan DBQuery
@@ -155,20 +157,20 @@
)
data AccountInfo =
- HasAccount String Bool
+ HasAccount B.ByteString Bool
| Guest
| Admin
deriving (Show, Read)
data DBQuery =
- CheckAccount ClientIndex String String
+ CheckAccount ClientIndex B.ByteString B.ByteString
| ClearCache
| SendStats Int Int
deriving (Show, Read)
data CoreMessage =
Accept ClientInfo
- | ClientMessage (ClientIndex, [String])
+ | ClientMessage (ClientIndex, [B.ByteString])
| ClientAccountInfo (ClientIndex, AccountInfo)
| TimerAction Int
| FreeClient ClientIndex
--- a/gameServer/HWProtoCore.hs Sat Jun 05 20:49:51 2010 +0000
+++ b/gameServer/HWProtoCore.hs Sun Jun 06 15:29:33 2010 +0000
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
module HWProtoCore where
import qualified Data.IntMap as IntMap
--- a/gameServer/HWProtoInRoomState.hs Sat Jun 05 20:49:51 2010 +0000
+++ b/gameServer/HWProtoInRoomState.hs Sun Jun 06 15:29:33 2010 +0000
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
module HWProtoInRoomState where
import qualified Data.Foldable as Foldable
--- a/gameServer/HWProtoLobbyState.hs Sat Jun 05 20:49:51 2010 +0000
+++ b/gameServer/HWProtoLobbyState.hs Sun Jun 06 15:29:33 2010 +0000
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
module HWProtoLobbyState where
import qualified Data.Map as Map
--- a/gameServer/HWProtoNEState.hs Sat Jun 05 20:49:51 2010 +0000
+++ b/gameServer/HWProtoNEState.hs Sun Jun 06 15:29:33 2010 +0000
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
module HWProtoNEState where
import qualified Data.IntMap as IntMap
@@ -5,6 +6,7 @@
import Data.List
import Data.Word
import Control.Monad.Reader
+import qualified Data.ByteString.Char8 as B
--------------------------------------
import CoreTypes
import Actions
@@ -16,7 +18,7 @@
handleCmd_NotEntered ["NICK", newNick] = do
(ci, irnc) <- ask
let cl = irnc `client` ci
- if not . null $ nick cl then return [ProtocolError "Nickname already chosen"]
+ if not . B.null $ nick cl then return [ProtocolError "Nickname already chosen"]
else
if haveSameNick irnc then return [AnswerClients [sendChan cl] ["WARNING", "Nickname already in use"], ByeClient ""]
else
@@ -38,10 +40,12 @@
else
return $
ModifyClient (\c -> c{clientProto = parsedProto}) :
- AnswerClients [sendChan cl] ["PROTO", show parsedProto] :
- [CheckRegistered | (not . null) (nick cl)]
+ AnswerClients [sendChan cl] ["PROTO", B.pack $ show parsedProto] :
+ [CheckRegistered | not . B.null $ nick cl]
where
- parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16)
+ parsedProto = case B.readInt protoNum of
+ Just (i, t) | B.null t -> fromIntegral i
+ otherwise -> 0
{-
--- a/gameServer/HandlerUtils.hs Sat Jun 05 20:49:51 2010 +0000
+++ b/gameServer/HandlerUtils.hs Sun Jun 06 15:29:33 2010 +0000
@@ -1,6 +1,7 @@
module HandlerUtils where
import Control.Monad.Reader
+import qualified Data.ByteString.Char8 as B
import RoomsAndClients
import CoreTypes
@@ -11,7 +12,7 @@
(ci, rnc) <- ask
return $ rnc `client` ci
-clientNick :: Reader (ClientIndex, IRnC) String
+clientNick :: Reader (ClientIndex, IRnC) B.ByteString
clientNick = liftM nick thisClient
roomOthersChans :: Reader (ClientIndex, IRnC) [ClientChan]
@@ -25,5 +26,5 @@
(ci, rnc) <- ask
return $ [sendChan (rnc `client` ci)]
-answerClient :: [String] -> Reader (ClientIndex, IRnC) [Action]
+answerClient :: [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
answerClient msg = thisClientChans >>= return . (: []) . flip AnswerClients msg
--- a/gameServer/NetRoutines.hs Sat Jun 05 20:49:51 2010 +0000
+++ b/gameServer/NetRoutines.hs Sun Jun 06 15:29:33 2010 +0000
@@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
module NetRoutines where
import Network.Socket
@@ -18,8 +18,6 @@
do
(sock, sockAddr) <- Network.Socket.accept servSock
- cHandle <- socketToHandle sock ReadWriteMode
- hSetBuffering cHandle LineBuffering
clientHost <- sockAddr2String sockAddr
currentTime <- getCurrentTime
@@ -29,7 +27,7 @@
let newClient =
(ClientInfo
sendChan'
- cHandle
+ sock
clientHost
currentTime
""
--- a/gameServer/OfficialServer/DBInteraction.hs Sat Jun 05 20:49:51 2010 +0000
+++ b/gameServer/OfficialServer/DBInteraction.hs Sun Jun 06 15:29:33 2010 +0000
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, ScopedTypeVariables #-}
+{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-}
module OfficialServer.DBInteraction
(
startDBConnection
--- a/gameServer/Opts.hs Sat Jun 05 20:49:51 2010 +0000
+++ b/gameServer/Opts.hs Sun Jun 06 15:29:33 2010 +0000
@@ -7,6 +7,8 @@
import System.Console.GetOpt
import Network
import Data.Maybe ( fromMaybe )
+import qualified Data.ByteString.Char8 as B
+
import CoreTypes
import Utils
@@ -30,9 +32,9 @@
where
readDedicated = fromMaybe True (maybeRead str :: Maybe Bool)
-readDbLogin str opts = opts{dbLogin = str}
-readDbPassword str opts = opts{dbPassword = str}
-readDbHost str opts = opts{dbHost = str}
+readDbLogin str opts = opts{dbLogin = B.pack str}
+readDbPassword str opts = opts{dbPassword = B.pack str}
+readDbHost str opts = opts{dbHost = B.pack str}
getOpts :: ServerInfo -> IO ServerInfo
getOpts opts = do
--- a/gameServer/ServerCore.hs Sat Jun 05 20:49:51 2010 +0000
+++ b/gameServer/ServerCore.hs Sun Jun 06 15:29:33 2010 +0000
@@ -8,6 +8,7 @@
import System.Log.Logger
import Control.Monad.Reader
import Control.Monad.State
+import qualified Data.ByteString.Char8 as B
--------------------------------------
import CoreTypes
import NetRoutines
@@ -21,7 +22,7 @@
timerLoop tick messagesChan = threadDelay (30 * 10^6) >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan
-reactCmd :: [String] -> StateT ServerState IO ()
+reactCmd :: [B.ByteString] -> StateT ServerState IO ()
reactCmd cmd = do
(Just ci) <- gets clientIndex
rnc <- gets roomsClients
--- a/gameServer/Utils.hs Sat Jun 05 20:49:51 2010 +0000
+++ b/gameServer/Utils.hs Sun Jun 06 15:29:33 2010 +0000
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
module Utils where
import Control.Concurrent
@@ -16,33 +17,30 @@
import Maybe
-------------------------------------------------
import qualified Codec.Binary.Base64 as Base64
-import qualified Data.ByteString.UTF8 as BUTF8
-import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString as BW
import CoreTypes
-sockAddr2String :: SockAddr -> IO String
-sockAddr2String (SockAddrInet _ hostAddr) = inet_ntoa hostAddr
+sockAddr2String :: SockAddr -> IO B.ByteString
+sockAddr2String (SockAddrInet _ hostAddr) = liftM B.pack $ inet_ntoa hostAddr
sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) =
- return $ (foldr1 (.)
+ return $ B.pack $ (foldr1 (.)
$ List.intersperse (\a -> ':':a)
$ concatMap (\n -> (\(a, b) -> [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) []
-toEngineMsg :: String -> String
-toEngineMsg msg = Base64.encode (fromIntegral (B.length encodedMsg) : (B.unpack encodedMsg))
- where
- encodedMsg = BUTF8.fromString msg
+toEngineMsg :: B.ByteString -> B.ByteString
+toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : (BW.unpack msg))
-fromEngineMsg :: String -> Maybe String
-fromEngineMsg msg = liftM (map w2c) (Base64.decode msg >>= removeLength)
+fromEngineMsg :: B.ByteString -> Maybe B.ByteString
+fromEngineMsg msg = Base64.decode (B.unpack msg) >>= removeLength >>= return . BW.pack
where
removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing
removeLength _ = Nothing
-checkNetCmd :: String -> (Bool, Bool)
-checkNetCmd msg = check decoded
+checkNetCmd :: B.ByteString -> (Bool, Bool)
+checkNetCmd = check . liftM B.unpack . fromEngineMsg
where
- decoded = fromEngineMsg msg
check Nothing = (False, False)
check (Just (m:ms)) = (m `Set.member` legalMessages, m == '+')
check _ = (False, False)
@@ -54,29 +52,27 @@
[(x, rest)] | all isSpace rest -> Just x
_ -> Nothing
-teamToNet :: Word16 -> TeamInfo -> [String]
+teamToNet :: Word16 -> TeamInfo -> [B.ByteString]
teamToNet protocol team
- | protocol < 30 = [
- "ADD_TEAM",
- teamname team,
- teamgrave team,
- teamfort team,
- teamvoicepack team,
- teamowner team,
- show $ difficulty team
- ]
- ++ hhsInfo
- | otherwise = [
- "ADD_TEAM",
- teamname team,
- teamgrave team,
- teamfort team,
- teamvoicepack team,
- teamflag team,
- teamowner team,
- show $ difficulty team
- ]
- ++ hhsInfo
+ | protocol < 30 =
+ "ADD_TEAM"
+ : teamname team
+ : teamgrave team
+ : teamfort team
+ : teamvoicepack team
+ : teamowner team
+ : (B.pack $ show $ difficulty team)
+ : hhsInfo
+ | otherwise =
+ "ADD_TEAM"
+ : teamname team
+ : teamgrave team
+ : teamfort team
+ : teamvoicepack team
+ : teamflag team
+ : teamowner team
+ : (B.pack $ show $ difficulty team)
+ : hhsInfo
where
hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team
@@ -90,10 +86,10 @@
else
t : replaceTeam team teams
-illegalName :: String -> Bool
-illegalName = all isSpace
+illegalName :: B.ByteString -> Bool
+illegalName = all isSpace . B.unpack
-protoNumber2ver :: Word16 -> String
+protoNumber2ver :: Word16 -> B.ByteString
protoNumber2ver 17 = "0.9.7-dev"
protoNumber2ver 19 = "0.9.7"
protoNumber2ver 20 = "0.9.8-dev"
@@ -116,3 +112,10 @@
putStr msg
hFlush stdout
getLine
+
+
+unfoldrE :: (b -> Either b (a, b)) -> b -> ([a], b)
+unfoldrE f b =
+ case f b of
+ Right (a, new_b) -> let (a', b') = unfoldrE f new_b in (a : a', b')
+ Left new_b -> ([], new_b)
--- a/gameServer/hedgewars-server.hs Sat Jun 05 20:49:51 2010 +0000
+++ b/gameServer/hedgewars-server.hs Sun Jun 06 15:29:33 2010 +0000
@@ -5,11 +5,7 @@
import Network
import Control.Concurrent.STM
import Control.Concurrent.Chan
-#if defined(NEW_EXCEPTIONS)
-import qualified Control.OldException as Exception
-#else
import qualified Control.Exception as Exception
-#endif
import System.Log.Logger
-----------------------------------
import Opts