1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
-- | Debug output for requests and responses.
module Game.LambdaHack.Server.DebugM
( debugResponse
, debugRequestAI, debugRequestUI
#ifdef EXPOSE_INTERNAL
-- * Internal operations
, debugShow, debugPretty, debugPlain, DebugAid(..), debugAid
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Data.Int (Int64)
import qualified Data.Text as T
import qualified Text.Show.Pretty as Show.Pretty
import Game.LambdaHack.Atomic
import Game.LambdaHack.Client (Response (..))
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Server.MonadServer
import Game.LambdaHack.Server.State
-- We debug these on the server, not on the clients, because we want
-- a single log, knowing the order in which the server received requests
-- and sent responseQs. Clients interleave and block non-deterministically
-- so their logs would be harder to interpret.
debugShow :: Show a => a -> Text
debugShow = T.pack . Show.Pretty.ppShow
debugResponse :: MonadServer m => FactionId -> Response -> m ()
debugResponse fid resp = case resp of
RespUpdAtomic _ cmd@UpdPerception{} -> debugPlain fid "RespUpdAtomic" cmd
RespUpdAtomic _ cmd@UpdResume{} -> debugPlain fid "RespUpdAtomic" cmd
RespUpdAtomic _ cmd@UpdRestart{} -> debugPlain fid "RespUpdAtomic" cmd
RespUpdAtomic _ cmd@UpdSpotTile{} -> debugPlain fid "RespUpdAtomic" cmd
RespUpdAtomic _ cmd@(UpdCreateActor aid _ _) -> do
d <- debugAid aid "UpdCreateActor"
serverPrint d
debugPretty fid "RespUpdAtomic" cmd
RespUpdAtomic _ cmd@(UpdSpotActor aid _) -> do
d <- debugAid aid "UpdSpotActor"
serverPrint d
debugPretty fid "RespUpdAtomic" cmd
RespUpdAtomic _ cmd -> debugPretty fid "RespUpdAtomic" cmd
RespUpdAtomicNoState cmd@UpdPerception{} ->
debugPlain fid "RespUpdAtomicNoState" cmd
RespUpdAtomicNoState cmd@UpdResume{} ->
debugPlain fid "RespUpdAtomicNoState" cmd
RespUpdAtomicNoState cmd@UpdSpotTile{} ->
debugPlain fid "RespUpdAtomicNoState" cmd
RespUpdAtomicNoState cmd ->
debugPretty fid "RespUpdAtomicNoState" cmd
RespQueryAI aid -> do
d <- debugAid aid "RespQueryAI"
serverPrint d
RespSfxAtomic sfx -> do -- not so crucial so no details
ps <- posSfxAtomic sfx
serverPrint $ debugShow (fid, "RespSfxAtomic" :: Text, ps)
RespQueryUIunderAI -> serverPrint "RespQueryUIunderAI"
RespQueryUI -> serverPrint "RespQueryUI"
debugPretty :: MonadServer m => FactionId -> Text -> UpdAtomic -> m ()
debugPretty fid t cmd = do
ps <- posUpdAtomic cmd
serverPrint $ debugShow (fid, t, ps, cmd)
debugPlain :: MonadServer m => FactionId -> Text -> UpdAtomic -> m ()
debugPlain fid t cmd = do
ps <- posUpdAtomic cmd
serverPrint $ T.pack $ show (fid, t, ps, cmd)
-- too large for pretty printing
debugRequestAI :: MonadServer m => ActorId -> m ()
debugRequestAI aid = do
d <- debugAid aid "AI request"
serverPrint d
debugRequestUI :: MonadServer m => ActorId -> m ()
debugRequestUI aid = do
d <- debugAid aid "UI request"
serverPrint d
data DebugAid = DebugAid
{ label :: Text
, aid :: ActorId
, faction :: FactionId
, lid :: LevelId
, bHP :: Int64
, btime :: Maybe Time
, btrTime :: Maybe Time
, time :: Time
}
deriving Show
debugAid :: MonadServer m => ActorId -> Text -> m Text
debugAid aid label = do
b <- getsState $ getActorBody aid
time <- getsState $ getLocalTime (blid b)
btime <- getsServer $ lookupActorTime (bfid b) (blid b) aid . sactorTime
btrTime <- getsServer $ lookupActorTime (bfid b) (blid b) aid . strajTime
return $! debugShow DebugAid { label
, aid
, faction = bfid b
, lid = blid b
, bHP = bhp b
, btime
, btrTime
, time }
|
