netserver/Miscutils.hs
author unc0rr
Sun, 06 Jul 2008 23:44:56 +0000
changeset 1064 9e0701c56fb3
parent 902 3cc10f0aae37
child 1082 596b1dcdc1df
permissions -rw-r--r--
Fix another regression arising from splitting switchhedgehog
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 =
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    12
	ClientInfo
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    13
	{
889
3bf9dc791f45 Some work on newhwserv
unc0rr
parents: 852
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
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    22
data RoomInfo =
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    23
	RoomInfo
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    24
	{
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    25
		name :: String,
8ffa4ad0d8ea Introduce function to atomically change both lists
unc0rr
parents: 849
diff changeset
    26
		password :: String
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
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
3cc10f0aae37 Finish conversion
unc0rr
parents: 901
diff changeset
    32
roomByName :: String -> [RoomInfo] -> RoomInfo
3cc10f0aae37 Finish conversion
unc0rr
parents: 901
diff changeset
    33
roomByName roomName rooms = fromJust $ find (\room -> roomName == name room) rooms
3cc10f0aae37 Finish conversion
unc0rr
parents: 901
diff changeset
    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
3bf9dc791f45 Some work on newhwserv
unc0rr
parents: 852
diff changeset
    47
894
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
    48
maybeRead :: Read a => String -> Maybe a
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
    49
maybeRead s = case reads s of
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
    50
	[(x, rest)] | all isSpace rest -> Just x
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
    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))