gameServer/HWProtoChecker.hs
author Edža <s@o-o.lv>
Tue, 23 Jul 2013 16:18:21 +0300
changeset 9369 b96988134dc6
parent 9109 878f06e9c484
child 9433 f0a8ac191839
permissions -rw-r--r--
fixed urls - added new version links
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
     1
{-# LANGUAGE OverloadedStrings #-}
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
     2
module HWProtoChecker where
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
     3
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
     4
import Data.Maybe
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
     5
import Control.Monad.Reader
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
     6
--------------------------------------
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
     7
import CoreTypes
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
     8
import Actions
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
     9
import HandlerUtils
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    10
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    11
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    12
handleCmd_checker :: CmdHandler
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    13
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    14
handleCmd_checker ["READY"] = return [CheckRecord]
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    15
8507
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    16
handleCmd_checker ["CHECKED", "FAIL", msg] = do
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    17
    isChecking <- liftM (isJust . checkInfo) thisClient
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    18
    if not isChecking then
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    19
        return []
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    20
        else
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    21
        return [CheckFailed msg, ModifyClient $ \c -> c{checkInfo = Nothing}]
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    22
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    23
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    24
handleCmd_checker ("CHECKED" : "OK" : info) = do
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    25
    isChecking <- liftM (isJust . checkInfo) thisClient
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    26
    if not isChecking then
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    27
        return []
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    28
        else
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    29
        return [CheckSuccess info, ModifyClient $ \c -> c{checkInfo = Nothing}]
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    30
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    31
handleCmd_checker _ = return [ProtocolError "Unknown command"]