netserver/Miscutils.hs
author unc0rr
Fri, 18 Apr 2008 18:06:17 +0000
changeset 849 82ac0596aa3c
child 851 8ffa4ad0d8ea
permissions -rw-r--r--
Start work on standalone server in Haskell
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 System.IO
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
     5
import Control.Concurrent
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
     6
import Control.Concurrent.STM
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
     7
import Control.Exception (finally)
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
     8
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
     9
sendMsg :: Handle -> String -> IO()
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    10
sendMsg clientHandle str = finally (return ()) (hPutStrLn clientHandle str >> hFlush clientHandle) -- catch exception when client tries to send to other
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    11
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    12
sendAll :: [Handle] -> String -> IO[()]
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    13
sendAll clientsList str = mapM (\x -> sendMsg x str) clientsList
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    14
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    15
sendOthers :: [Handle] -> Handle -> String -> IO[()]
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    16
sendOthers clientsList clientHandle str = sendAll (filter (/= clientHandle) clientsList) str
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    17
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    18
extractCmd :: String -> (String, [String])
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    19
extractCmd str = if ws == [] then ("", []) else (head ws, tail ws)
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    20
		where ws = words str
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    21
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    22
manipState :: TVar[a] -> ([a] -> [a]) -> IO()
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    23
manipState state op =
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    24
	atomically $ do
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    25
			ls <- readTVar state
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    26
			writeTVar state $ op ls
82ac0596aa3c Start work on standalone server in Haskell
unc0rr
parents:
diff changeset
    27