gameServer/HandlerUtils.hs
author unc0rr
Mon, 10 May 2010 17:48:06 +0000
changeset 3458 11cd56019f00
parent 3435 4e4f88a7bdf2
child 3500 af8390d807d6
permissions -rw-r--r--
Make some more protocol commands work
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     1
module HandlerUtils where
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     2
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     3
import Control.Monad.Reader
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     4
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     5
import RoomsAndClients
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     6
import CoreTypes
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     7
import Actions
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     8
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
     9
thisClient :: Reader (ClientIndex, IRnC) ClientInfo
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    10
thisClient = do
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    11
    (ci, rnc) <- ask
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    12
    return $ rnc `client` ci
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    13
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    14
clientNick :: Reader (ClientIndex, IRnC) String
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    15
clientNick = liftM nick thisClient
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    16
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    17
roomOthersChans :: Reader (ClientIndex, IRnC) [ClientChan]
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    18
roomOthersChans = do
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    19
    (ci, rnc) <- ask
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    20
    let ri = clientRoom rnc ci
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    21
    return $ map (sendChan . client rnc) (roomClients rnc ri)
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    22
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    23
thisClientChans :: Reader (ClientIndex, IRnC) [ClientChan]
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    24
thisClientChans = do
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    25
    (ci, rnc) <- ask
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    26
    return $ [sendChan (rnc `client` ci)]
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    27
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    28
answerClient :: [String] -> Reader (ClientIndex, IRnC) [Action]
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents:
diff changeset
    29
answerClient msg = thisClientChans >>= return . (: []) . flip AnswerClients msg