netserver/Miscutils.hs
author unc0rr
Mon, 29 Sep 2008 22:14:23 +0000
changeset 1301 c6fe8a4bfd34
parent 1083 3448dd03483f
child 1304 05cebf68ebd8
permissions -rw-r--r--
Fix a bug screwing team selection up in network game (REMOVETEAM message doesn't have teamID, and after removing the team QMap still contains old info, when add and remove team with the same name, total hedgehogs number will be decreased by first team hh number)
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
1083
3448dd03483f Further work on dedicated server
unc0rr
parents: 1082
diff changeset
    25
data TeamInfo =
3448dd03483f Further work on dedicated server
unc0rr
parents: 1082
diff changeset
    26
	TeamInfo
3448dd03483f Further work on dedicated server
unc0rr
parents: 1082
diff changeset
    27
	{
3448dd03483f Further work on dedicated server
unc0rr
parents: 1082
diff changeset
    28
		teamname :: String
3448dd03483f Further work on dedicated server
unc0rr
parents: 1082
diff changeset
    29
	}
3448dd03483f Further work on dedicated server
unc0rr
parents: 1082
diff changeset
    30
851
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    31
data RoomInfo =
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    32
	RoomInfo
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    33
	{
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    34
		name :: String,
1083
3448dd03483f Further work on dedicated server
unc0rr
parents: 1082
diff changeset
    35
		password :: String,
3448dd03483f Further work on dedicated server
unc0rr
parents: 1082
diff changeset
    36
		teams :: [TeamInfo]
851
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    37
	}
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    38
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    39
type ClientsTransform = [ClientInfo] -> [ClientInfo]
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    40
type RoomsTransform = [RoomInfo] -> [RoomInfo]
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    41
type HandlesSelector = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [Handle]
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    42
type CmdHandler = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientsTransform, RoomsTransform, HandlesSelector, [String])
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    43
901
2f5ce9a584f9 Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents: 895
diff changeset
    44
902
3cc10f0aae37 Finish conversion
unc0rr
parents: 901
diff changeset
    45
roomByName :: String -> [RoomInfo] -> RoomInfo
3cc10f0aae37 Finish conversion
unc0rr
parents: 901
diff changeset
    46
roomByName roomName rooms = fromJust $ find (\room -> roomName == name room) rooms
3cc10f0aae37 Finish conversion
unc0rr
parents: 901
diff changeset
    47
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    48
tselect :: [ClientInfo] -> STM ([String], ClientInfo)
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    49
tselect = foldl orElse retry . map (\ci -> (flip (,) ci) `fmap` readTChan (chan ci))
889
3bf9dc791f45 Some work on newhwserv
unc0rr
parents: 852
diff changeset
    50
894
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
    51
maybeRead :: Read a => String -> Maybe a
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
    52
maybeRead s = case reads s of
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
    53
	[(x, rest)] | all isSpace rest -> Just x
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
    54
	_         -> Nothing
901
2f5ce9a584f9 Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents: 895
diff changeset
    55
2f5ce9a584f9 Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents: 895
diff changeset
    56
deleteBy2t :: (a -> b -> Bool) -> b -> [a] -> [a]
2f5ce9a584f9 Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents: 895
diff changeset
    57
deleteBy2t _  _ [] = []
2f5ce9a584f9 Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents: 895
diff changeset
    58
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
    59
2f5ce9a584f9 Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents: 895
diff changeset
    60
deleteFirstsBy2t :: (a -> b -> Bool) -> [a] -> [b] -> [a]
2f5ce9a584f9 Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents: 895
diff changeset
    61
deleteFirstsBy2t eq =  foldl (flip (deleteBy2t eq))
1082
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    62
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    63
sameRoom :: HandlesSelector
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    64
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
    65
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    66
othersInRoom :: HandlesSelector
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    67
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
    68
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    69
fromRoom :: String -> HandlesSelector
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    70
fromRoom roomName _ clients _ = map handle $ filter (\ci -> room ci == roomName) clients
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    71
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    72
clientOnly :: HandlesSelector
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    73
clientOnly client _ _ = [handle client]
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    74
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    75
noChangeClients :: ClientsTransform
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    76
noChangeClients a = a
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
modifyClient :: ClientInfo -> ClientsTransform
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    79
modifyClient client (cl:cls) =
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    80
	if cl == client then
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    81
		client : cls
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    82
	else
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    83
		cl : (modifyClient client cls)
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    84
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    85
noChangeRooms :: RoomsTransform
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    86
noChangeRooms a = a
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    87
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    88
addRoom :: RoomInfo -> RoomsTransform
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    89
addRoom room rooms = room:rooms
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    90
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    91
removeRoom :: String -> RoomsTransform
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    92
removeRoom roomname rooms = filter (\rm -> roomname /= name rm) rooms
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    93
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    94
badCmd :: [String]
596b1dcdc1df - Modify network protocol to use new delimiter
unc0rr
parents: 902
diff changeset
    95
badCmd = ["ERROR", "Bad command, state or incorrect parameter"]