author  nemo 
Fri, 12 Nov 2010 18:57:36 0500  
changeset 4295  1f5604cd99be 
parent 4242  5e3c5fe2cb14 
child 4309  a69c73c5d173 
permissions  rwrr 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

1 
{# LANGUAGE OverloadedStrings #} 
1804  2 
module Utils where 
3 

4 
import Control.Concurrent 

5 
import Control.Concurrent.STM 

6 
import Data.Char 

7 
import Data.Word 

8 
import qualified Data.Map as Map 

9 
import qualified Data.IntMap as IntMap 

2304  10 
import qualified Data.Set as Set 
2310  11 
import Data.ByteString.Internal (w2c) 
1917  12 
import Numeric 
13 
import Network.Socket 

1964  14 
import System.IO 
1917  15 
import qualified Data.List as List 
2349  16 
import Control.Monad 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

17 
import Data.Maybe 
1804  18 
 
19 
import qualified Codec.Binary.Base64 as Base64 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

20 
import qualified Data.ByteString.Char8 as B 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

21 
import qualified Data.ByteString as BW 
1804  22 
import CoreTypes 
23 

1917  24 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

25 
sockAddr2String :: SockAddr > IO B.ByteString 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

26 
sockAddr2String (SockAddrInet _ hostAddr) = liftM B.pack $ inet_ntoa hostAddr 
1917  27 
sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) = 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

28 
return $ B.pack $ (foldr1 (.) 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

29 
$ List.intersperse (\a > ':':a) 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

30 
$ concatMap (\n > (\(a, b) > [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) [] 
1917  31 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

32 
toEngineMsg :: B.ByteString > B.ByteString 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

33 
toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : (BW.unpack msg)) 
1804  34 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

35 
fromEngineMsg :: B.ByteString > Maybe B.ByteString 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

36 
fromEngineMsg msg = Base64.decode (B.unpack msg) >>= removeLength >>= return . BW.pack 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

37 
where 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

38 
removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

39 
removeLength _ = Nothing 
2304  40 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

41 
checkNetCmd :: B.ByteString > (Bool, Bool) 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

42 
checkNetCmd = check . liftM B.unpack . fromEngineMsg 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

43 
where 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

44 
check Nothing = (False, False) 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

45 
check (Just (m:ms)) = (m `Set.member` legalMessages, m == '+') 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

46 
check _ = (False, False) 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

47 
legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghb12345" ++ slotMessages 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

48 
slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" 
1804  49 

50 
maybeRead :: Read a => String > Maybe a 

51 
maybeRead s = case reads s of 

2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

52 
[(x, rest)]  all isSpace rest > Just x 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

53 
_ > Nothing 
1804  54 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

55 
teamToNet :: TeamInfo > [B.ByteString] 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

56 
teamToNet team = 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

57 
"ADD_TEAM" 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

58 
: teamname team 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

59 
: teamgrave team 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

60 
: teamfort team 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

61 
: teamvoicepack team 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

62 
: teamflag team 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

63 
: teamowner team 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

64 
: (B.pack $ show $ difficulty team) 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

65 
: hhsInfo 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

66 
where 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

67 
hhsInfo = concatMap (\(HedgehogInfo name hat) > [name, hat]) $ hedgehogs team 
1804  68 

69 
modifyTeam :: TeamInfo > RoomInfo > RoomInfo 

70 
modifyTeam team room = room{teams = replaceTeam team $ teams room} 

2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

71 
where 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

72 
replaceTeam _ [] = error "modifyTeam: no such team" 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

73 
replaceTeam team (t:teams) = 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

74 
if teamname team == teamname t then 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

75 
team : teams 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

76 
else 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

77 
t : replaceTeam team teams 
1804  78 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

79 
illegalName :: B.ByteString > Bool 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

80 
illegalName = all isSpace . B.unpack 
2150
45b695f3a7b9
Forbid room names and nicknames consisting only of space characters
unc0rr
parents:
2113
diff
changeset

81 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

82 
protoNumber2ver :: Word16 > B.ByteString 
1804  83 
protoNumber2ver 17 = "0.9.7dev" 
84 
protoNumber2ver 19 = "0.9.7" 

85 
protoNumber2ver 20 = "0.9.8dev" 

86 
protoNumber2ver 21 = "0.9.8" 

87 
protoNumber2ver 22 = "0.9.9dev" 

88 
protoNumber2ver 23 = "0.9.9" 

89 
protoNumber2ver 24 = "0.9.10dev" 

90 
protoNumber2ver 25 = "0.9.10" 

1953  91 
protoNumber2ver 26 = "0.9.11dev" 
2113  92 
protoNumber2ver 27 = "0.9.11" 
93 
protoNumber2ver 28 = "0.9.12dev" 

2448  94 
protoNumber2ver 29 = "0.9.12" 
95 
protoNumber2ver 30 = "0.9.13dev" 

3297  96 
protoNumber2ver 31 = "0.9.13" 
97 
protoNumber2ver 32 = "0.9.14dev" 

1804  98 
protoNumber2ver _ = "Unknown" 
99 

1964  100 
askFromConsole :: String > IO String 
101 
askFromConsole msg = do 

2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

102 
putStr msg 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

103 
hFlush stdout 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

104 
getLine 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

105 

1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

106 

1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

107 
unfoldrE :: (b > Either b (a, b)) > b > ([a], b) 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

108 
unfoldrE f b = 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

109 
case f b of 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

110 
Right (a, new_b) > let (a', b') = unfoldrE f new_b in (a : a', b') 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

111 
Left new_b > ([], new_b) 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

112 

1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

113 
showB :: Show a => a > B.ByteString 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

114 
showB = B.pack .show 