netserver/Miscutils.hs
author unc0rr
Thu, 01 May 2008 15:14:32 +0000
changeset 895 6aee2f335726
parent 894 2ca76a7f3121
child 901 2f5ce9a584f9
permissions -rw-r--r--
- Remove old hwserv code - Introduce rooms (CREATE and JOIN commands handling)
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)
894
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
     8
import Data.Word
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
     9
import Data.Char
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
890
1d8c4a5ec622 - Improve server core
unc0rr
parents: 889
diff changeset
    29
tselect :: [ClientInfo] -> STM (String, ClientInfo)
1d8c4a5ec622 - Improve server core
unc0rr
parents: 889
diff changeset
    30
tselect = foldl orElse retry . map (\ci -> (flip (,) ci) `fmap` readTChan (chan ci))
889
3bf9dc791f45 Some work on newhwserv
unc0rr
parents: 852
diff changeset
    31
894
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
    32
maybeRead :: Read a => String -> Maybe a
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
    33
maybeRead s = case reads s of
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
    34
	[(x, rest)] | all isSpace rest -> Just x
2ca76a7f3121 - Fixed some bugs
unc0rr
parents: 890
diff changeset
    35
	_         -> Nothing