gameServer/HWProtoChecker.hs
author unc0rr
Thu, 19 Jun 2014 23:32:11 +0400
changeset 10336 3edfa6b68407
parent 10212 5fb3bb2de9d2
child 10460 8dcea9087d75
permissions -rw-r--r--
Fix issue #791: - Send drawn map data on room creation - Don't use MAP parameter to deduce mapgen when it is one of "+rnd+", "+drawn+", "+maze+"
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 HandlerUtils
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
     9
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
handleCmd_checker :: CmdHandler
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    12
9433
f0a8ac191839 Push demo to idle checker on game finish
unc0rr
parents: 9109
diff changeset
    13
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
    14
8507
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    15
handleCmd_checker ["CHECKED", "FAIL", msg] = do
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    16
    isChecking <- liftM (isJust . checkInfo) thisClient
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    17
    if not isChecking then
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    18
        return []
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    19
        else
9444
30748b1d9ec7 Fix checker ready status mess
unc0rr
parents: 9433
diff changeset
    20
        return [CheckFailed msg, ModifyClient $ \c -> c{checkInfo = Nothing}]
8507
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    21
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    22
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    23
handleCmd_checker ("CHECKED" : "OK" : info) = do
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    24
    isChecking <- liftM (isJust . checkInfo) thisClient
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    25
    if not isChecking then
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    26
        return []
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    27
        else
9444
30748b1d9ec7 Fix checker ready status mess
unc0rr
parents: 9433
diff changeset
    28
        return [CheckSuccess info, ModifyClient $ \c -> c{checkInfo = Nothing}]
8507
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    29
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents:
diff changeset
    30
handleCmd_checker _ = return [ProtocolError "Unknown command"]