netserver/Miscutils.hs
author unc0rr
Mon, 21 Jul 2008 09:45:40 +0000
changeset 1082 596b1dcdc1df
parent 902 3cc10f0aae37
child 1083 3448dd03483f
permissions -rw-r--r--
- Modify network protocol to use new delimiter - Much improve dedicated server usability
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
849
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
     1
module Miscutils where
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
     2
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
     3
import IO
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
     4
import Control.Concurrent.STM
894
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
     5
import Data.Word
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
     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
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    10
851
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    11
data ClientInfo =
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    12
 ClientInfo
851
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    13
	{
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    14
		chan :: TChan [String],
851
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    15
		handle :: Handle,
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    16
		nick :: String,
894
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
    17
		protocol :: Word16,
851
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    18
		room :: String,
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    19
		isMaster :: Bool
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    20
	}
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    21
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    22
instance Eq ClientInfo where
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    23
	a1 == a2 = handle a1 == handle a2
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    24
851
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    25
data RoomInfo =
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    26
	RoomInfo
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    27
	{
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    28
		name :: String,
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    29
		password :: String
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    30
	}
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    31
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    32
type ClientsTransform = [ClientInfo] -> [ClientInfo]
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    33
type RoomsTransform = [RoomInfo] -> [RoomInfo]
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    34
type HandlesSelector = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [Handle]
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    35
type CmdHandler = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientsTransform, RoomsTransform, HandlesSelector, [String])
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    36
901
2f5ce9a584f9 Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents: 895
diff changeset
    37
902
3cc10f0aae37 Finish conversion
unc0rr
parents: 901
diff changeset
    38
roomByName :: String -> [RoomInfo] -> RoomInfo
3cc10f0aae37 Finish conversion
unc0rr
parents: 901
diff changeset
    39
roomByName roomName rooms = fromJust $ find (\room -> roomName == name room) rooms
3cc10f0aae37 Finish conversion
unc0rr
parents: 901
diff changeset
    40
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    41
tselect :: [ClientInfo] -> STM ([String], ClientInfo)
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    42
tselect = foldl orElse retry . map (\ci -> (flip (,) ci) `fmap` readTChan (chan ci))
889
3bf9dc791f45 Some work on newhwserv
unc0rr
parents: 852
diff changeset
    43
894
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
    44
maybeRead :: Read a => String -> Maybe a
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
    45
maybeRead s = case reads s of
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
    46
	[(x, rest)] | all isSpace rest -> Just x
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
    47
	_         -> Nothing
901
2f5ce9a584f9 Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents: 895
diff changeset
    48
2f5ce9a584f9 Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents: 895
diff changeset
    49
deleteBy2t :: (a -> b -> Bool) -> b -> [a] -> [a]
2f5ce9a584f9 Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents: 895
diff changeset
    50
deleteBy2t _  _ [] = []
2f5ce9a584f9 Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents: 895
diff changeset
    51
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
    52
2f5ce9a584f9 Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents: 895
diff changeset
    53
deleteFirstsBy2t :: (a -> b -> Bool) -> [a] -> [b] -> [a]
2f5ce9a584f9 Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents: 895
diff changeset
    54
deleteFirstsBy2t eq =  foldl (flip (deleteBy2t eq))
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    55
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    56
sameRoom :: HandlesSelector
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    57
sameRoom client clients rooms = map handle $ filter (\ci -> room ci == room client) clients
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    58
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    59
othersInRoom :: HandlesSelector
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    60
othersInRoom client clients rooms = map handle $ filter (client /=) $ filter (\ci -> room ci == room client) clients
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    61
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    62
fromRoom :: String -> HandlesSelector
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    63
fromRoom roomName _ clients _ = map handle $ filter (\ci -> room ci == roomName) clients
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    64
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    65
clientOnly :: HandlesSelector
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    66
clientOnly client _ _ = [handle client]
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    67
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    68
noChangeClients :: ClientsTransform
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    69
noChangeClients a = a
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    70
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    71
modifyClient :: ClientInfo -> ClientsTransform
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    72
modifyClient client (cl:cls) =
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    73
	if cl == client then
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    74
		client : cls
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    75
	else
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    76
		cl : (modifyClient client cls)
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    77
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    78
noChangeRooms :: RoomsTransform
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    79
noChangeRooms a = a
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    80
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    81
addRoom :: RoomInfo -> RoomsTransform
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    82
addRoom room rooms = room:rooms
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    83
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    84
removeRoom :: String -> RoomsTransform
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    85
removeRoom roomname rooms = filter (\rm -> roomname /= name rm) rooms
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    86
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    87
badCmd :: [String]
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    88
badCmd = ["ERROR", "Bad command, state or incorrect parameter"]