netserver/Miscutils.hs
changeset 901 2f5ce9a584f9
parent 895 6aee2f335726
child 902 3cc10f0aae37
equal deleted inserted replaced
900:5224ac938442 901:2f5ce9a584f9
     1 module Miscutils where
     1 module Miscutils where
     2 
     2 
     3 import IO
     3 import IO
     4 import System.IO
       
     5 import Control.Concurrent
       
     6 import Control.Concurrent.STM
     4 import Control.Concurrent.STM
     7 import Control.Exception (finally)
       
     8 import Data.Word
     5 import Data.Word
     9 import Data.Char
     6 import Data.Char
       
     7 import Data.List
       
     8 import Maybe (fromJust)
       
     9 
    10 
    10 
    11 data ClientInfo =
    11 data ClientInfo =
    12 	ClientInfo
    12 	ClientInfo
    13 	{
    13 	{
    14 		chan :: TChan String,
    14 		chan :: TChan String,
    24 	{
    24 	{
    25 		name :: String,
    25 		name :: String,
    26 		password :: String
    26 		password :: String
    27 	}
    27 	}
    28 
    28 
    29 tselect :: [ClientInfo] -> STM (String, ClientInfo)
    29 clientByHandle :: Handle -> [ClientInfo] -> ClientInfo
    30 tselect = foldl orElse retry . map (\ci -> (flip (,) ci) `fmap` readTChan (chan ci))
    30 clientByHandle clhandle clients = fromJust $ find (\ci -> handle ci == clhandle) clients
       
    31 
       
    32 fromRoomHandles :: String -> [ClientInfo] -> [Handle]
       
    33 fromRoomHandles roomName clients = map (\ci -> handle ci) $ filter (\ci -> room ci == roomName) clients
       
    34 
       
    35 modifyClient :: Handle -> [ClientInfo] -> (ClientInfo -> ClientInfo) -> [ClientInfo]
       
    36 modifyClient clhandle (cl:cls) func =
       
    37 	if handle cl == clhandle then
       
    38 		(func cl) : cls
       
    39 	else
       
    40 		cl : (modifyClient clhandle cls func)
       
    41 
       
    42 tselect :: [ClientInfo] -> STM (String, Handle)
       
    43 tselect = foldl orElse retry . map (\ci -> (flip (,) $ handle ci) `fmap` readTChan (chan ci))
    31 
    44 
    32 maybeRead :: Read a => String -> Maybe a
    45 maybeRead :: Read a => String -> Maybe a
    33 maybeRead s = case reads s of
    46 maybeRead s = case reads s of
    34 	[(x, rest)] | all isSpace rest -> Just x
    47 	[(x, rest)] | all isSpace rest -> Just x
    35 	_         -> Nothing
    48 	_         -> Nothing
       
    49 
       
    50 deleteBy2t :: (a -> b -> Bool) -> b -> [a] -> [a]
       
    51 deleteBy2t _  _ [] = []
       
    52 deleteBy2t eq x (y:ys) = if y `eq` x then ys else y : deleteBy2t eq x ys
       
    53 
       
    54 deleteFirstsBy2t :: (a -> b -> Bool) -> [a] -> [b] -> [a]
       
    55 deleteFirstsBy2t eq =  foldl (flip (deleteBy2t eq))