gameServer/HWProtoChecker.hs
author koda
Mon, 01 Jun 2015 14:39:25 +0200
branch0.9.20
changeset 9934 57f9ce8b2854
parent 9444 30748b1d9ec7
child 10212 5fb3bb2de9d2
permissions -rw-r--r--
Close branch
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
9433
f0a8ac191839 Push demo to idle checker on game finish
unc0rr
parents: 9109
diff changeset
    14
handleCmd_checker ["READY"] = return [ModifyClient $ \c -> c{isReady = True}, CheckRecord]
8479
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
9444
30748b1d9ec7 Fix checker ready status mess
unc0rr
parents: 9433
diff changeset
    21
        return [CheckFailed msg, ModifyClient $ \c -> c{checkInfo = Nothing}]
8507
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
9444
30748b1d9ec7 Fix checker ready status mess
unc0rr
parents: 9433
diff changeset
    29
        return [CheckSuccess info, ModifyClient $ \c -> c{checkInfo = Nothing}]
8507
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"]