author | unc0rr |
Wed, 08 Oct 2008 18:25:08 +0000 | |
changeset 1321 | d7dc4e86201e |
parent 1317 | 13cf8c5a7428 |
child 1327 | 9d43a6e6b9ca |
permissions | -rw-r--r-- |
849 | 1 |
module Miscutils where |
2 |
||
3 |
import IO |
|
4 |
import Control.Concurrent.STM |
|
894 | 5 |
import Data.Word |
6 |
import Data.Char |
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
7 |
import Data.List |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
8 |
import Maybe (fromJust) |
1317 | 9 |
import qualified Data.Map as Map |
849 | 10 |
|
851 | 11 |
data ClientInfo = |
1082 | 12 |
ClientInfo |
851 | 13 |
{ |
1082 | 14 |
chan :: TChan [String], |
851 | 15 |
handle :: Handle, |
16 |
nick :: String, |
|
894 | 17 |
protocol :: Word16, |
851 | 18 |
room :: String, |
19 |
isMaster :: Bool |
|
20 |
} |
|
21 |
||
1082 | 22 |
instance Eq ClientInfo where |
23 |
a1 == a2 = handle a1 == handle a2 |
|
24 |
||
1317 | 25 |
data HedgehogInfo = |
26 |
HedgehogInfo String String |
|
27 |
||
1083 | 28 |
data TeamInfo = |
29 |
TeamInfo |
|
30 |
{ |
|
1317 | 31 |
teamname :: String, |
1321 | 32 |
teamcolor :: String, |
33 |
teamgrave :: String, |
|
34 |
teamfort :: String, |
|
35 |
difficulty :: Int, |
|
1317 | 36 |
hedgehogs :: [HedgehogInfo] |
1083 | 37 |
} |
38 |
||
851 | 39 |
data RoomInfo = |
40 |
RoomInfo |
|
41 |
{ |
|
42 |
name :: String, |
|
1083 | 43 |
password :: String, |
1317 | 44 |
roomProto :: Word16, |
45 |
teams :: [TeamInfo], |
|
46 |
params :: Map.Map String [String] |
|
851 | 47 |
} |
48 |
||
1082 | 49 |
type ClientsTransform = [ClientInfo] -> [ClientInfo] |
50 |
type RoomsTransform = [RoomInfo] -> [RoomInfo] |
|
51 |
type HandlesSelector = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [Handle] |
|
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1083
diff
changeset
|
52 |
type CmdHandler = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientsTransform, RoomsTransform, [(HandlesSelector, [String])]) |
1082 | 53 |
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
54 |
|
902 | 55 |
roomByName :: String -> [RoomInfo] -> RoomInfo |
56 |
roomByName roomName rooms = fromJust $ find (\room -> roomName == name room) rooms |
|
57 |
||
1082 | 58 |
tselect :: [ClientInfo] -> STM ([String], ClientInfo) |
59 |
tselect = foldl orElse retry . map (\ci -> (flip (,) ci) `fmap` readTChan (chan ci)) |
|
889 | 60 |
|
894 | 61 |
maybeRead :: Read a => String -> Maybe a |
62 |
maybeRead s = case reads s of |
|
63 |
[(x, rest)] | all isSpace rest -> Just x |
|
64 |
_ -> Nothing |
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
65 |
|
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
66 |
deleteBy2t :: (a -> b -> Bool) -> b -> [a] -> [a] |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
67 |
deleteBy2t _ _ [] = [] |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
68 |
deleteBy2t eq x (y:ys) = if y `eq` x then ys else y : deleteBy2t eq x ys |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
69 |
|
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
70 |
deleteFirstsBy2t :: (a -> b -> Bool) -> [a] -> [b] -> [a] |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
71 |
deleteFirstsBy2t eq = foldl (flip (deleteBy2t eq)) |
1082 | 72 |
|
73 |
sameRoom :: HandlesSelector |
|
74 |
sameRoom client clients rooms = map handle $ filter (\ci -> room ci == room client) clients |
|
75 |
||
76 |
othersInRoom :: HandlesSelector |
|
77 |
othersInRoom client clients rooms = map handle $ filter (client /=) $ filter (\ci -> room ci == room client) clients |
|
78 |
||
79 |
fromRoom :: String -> HandlesSelector |
|
80 |
fromRoom roomName _ clients _ = map handle $ filter (\ci -> room ci == roomName) clients |
|
81 |
||
82 |
clientOnly :: HandlesSelector |
|
83 |
clientOnly client _ _ = [handle client] |
|
84 |
||
85 |
noChangeClients :: ClientsTransform |
|
86 |
noChangeClients a = a |
|
87 |
||
88 |
modifyClient :: ClientInfo -> ClientsTransform |
|
1321 | 89 |
modifyClient _ [] = error "modifyClient: no such client" |
1082 | 90 |
modifyClient client (cl:cls) = |
91 |
if cl == client then |
|
92 |
client : cls |
|
93 |
else |
|
94 |
cl : (modifyClient client cls) |
|
95 |
||
96 |
noChangeRooms :: RoomsTransform |
|
97 |
noChangeRooms a = a |
|
98 |
||
99 |
addRoom :: RoomInfo -> RoomsTransform |
|
100 |
addRoom room rooms = room:rooms |
|
101 |
||
102 |
removeRoom :: String -> RoomsTransform |
|
103 |
removeRoom roomname rooms = filter (\rm -> roomname /= name rm) rooms |
|
1317 | 104 |
|
1321 | 105 |
modifyRoom :: RoomInfo -> RoomsTransform |
106 |
modifyRoom _ [] = error "changeRoomConfig: no such room" |
|
107 |
modifyRoom room (rm:rms) = |
|
108 |
if name room == name rm then |
|
109 |
room : rms |
|
1317 | 110 |
else |
1321 | 111 |
room : modifyRoom room rms |