gameServer/Utils.hs
changeset 3500 af8390d807d6
parent 3297 0c59b991007e
child 3501 a3159a410e5c
--- 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)