author | unc0rr |
Tue, 17 Jun 2008 21:25:21 +0000 | |
changeset 1004 | 4cbd91296df7 |
parent 902 | 3cc10f0aae37 |
child 1082 | 596b1dcdc1df |
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) |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
9 |
|
849 | 10 |
|
851 | 11 |
data ClientInfo = |
12 |
ClientInfo |
|
13 |
{ |
|
889 | 14 |
chan :: TChan String, |
851 | 15 |
handle :: Handle, |
16 |
nick :: String, |
|
894 | 17 |
protocol :: Word16, |
851 | 18 |
room :: String, |
19 |
isMaster :: Bool |
|
20 |
} |
|
21 |
||
22 |
data RoomInfo = |
|
23 |
RoomInfo |
|
24 |
{ |
|
25 |
name :: String, |
|
26 |
password :: String |
|
27 |
} |
|
28 |
||
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
29 |
clientByHandle :: Handle -> [ClientInfo] -> ClientInfo |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
30 |
clientByHandle clhandle clients = fromJust $ find (\ci -> handle ci == clhandle) clients |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
31 |
|
902 | 32 |
roomByName :: String -> [RoomInfo] -> RoomInfo |
33 |
roomByName roomName rooms = fromJust $ find (\room -> roomName == name room) rooms |
|
34 |
||
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
35 |
fromRoomHandles :: String -> [ClientInfo] -> [Handle] |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
36 |
fromRoomHandles roomName clients = map (\ci -> handle ci) $ filter (\ci -> room ci == roomName) clients |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
37 |
|
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
38 |
modifyClient :: Handle -> [ClientInfo] -> (ClientInfo -> ClientInfo) -> [ClientInfo] |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
39 |
modifyClient clhandle (cl:cls) func = |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
40 |
if handle cl == clhandle then |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
41 |
(func cl) : cls |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
42 |
else |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
43 |
cl : (modifyClient clhandle cls func) |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
44 |
|
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
45 |
tselect :: [ClientInfo] -> STM (String, Handle) |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
46 |
tselect = foldl orElse retry . map (\ci -> (flip (,) $ handle ci) `fmap` readTChan (chan ci)) |
889 | 47 |
|
894 | 48 |
maybeRead :: Read a => String -> Maybe a |
49 |
maybeRead s = case reads s of |
|
50 |
[(x, rest)] | all isSpace rest -> Just x |
|
51 |
_ -> Nothing |
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
52 |
|
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
53 |
deleteBy2t :: (a -> b -> Bool) -> b -> [a] -> [a] |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
54 |
deleteBy2t _ _ [] = [] |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
55 |
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
|
56 |
|
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
57 |
deleteFirstsBy2t :: (a -> b -> Bool) -> [a] -> [b] -> [a] |
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
895
diff
changeset
|
58 |
deleteFirstsBy2t eq = foldl (flip (deleteBy2t eq)) |