module Game.LambdaHack.Server.DebugM
( debugResponse
, debugRequestAI, debugRequestUI
#ifdef EXPOSE_INTERNAL
, 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
debugShow :: Show a => a -> Text
debugShow :: a -> Text
debugShow = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
Show.Pretty.ppShow
debugResponse :: MonadServer m => FactionId -> Response -> m ()
debugResponse :: FactionId -> Response -> m ()
debugResponse fid :: FactionId
fid resp :: Response
resp = case Response
resp of
RespUpdAtomic _ cmd :: UpdAtomic
cmd@UpdPerception{} -> FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPlain FactionId
fid "RespUpdAtomic" UpdAtomic
cmd
RespUpdAtomic _ cmd :: UpdAtomic
cmd@UpdResume{} -> FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPlain FactionId
fid "RespUpdAtomic" UpdAtomic
cmd
RespUpdAtomic _ cmd :: UpdAtomic
cmd@UpdRestart{} -> FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPlain FactionId
fid "RespUpdAtomic" UpdAtomic
cmd
RespUpdAtomic _ cmd :: UpdAtomic
cmd@UpdSpotTile{} -> FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPlain FactionId
fid "RespUpdAtomic" UpdAtomic
cmd
RespUpdAtomic _ cmd :: UpdAtomic
cmd@(UpdCreateActor aid :: ActorId
aid _ _) -> do
Text
d <- ActorId -> Text -> m Text
forall (m :: * -> *). MonadServer m => ActorId -> Text -> m Text
debugAid ActorId
aid "UpdCreateActor"
Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
serverPrint Text
d
FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPretty FactionId
fid "RespUpdAtomic" UpdAtomic
cmd
RespUpdAtomic _ cmd :: UpdAtomic
cmd@(UpdSpotActor aid :: ActorId
aid _) -> do
Text
d <- ActorId -> Text -> m Text
forall (m :: * -> *). MonadServer m => ActorId -> Text -> m Text
debugAid ActorId
aid "UpdSpotActor"
Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
serverPrint Text
d
FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPretty FactionId
fid "RespUpdAtomic" UpdAtomic
cmd
RespUpdAtomic _ cmd :: UpdAtomic
cmd -> FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPretty FactionId
fid "RespUpdAtomic" UpdAtomic
cmd
RespUpdAtomicNoState cmd :: UpdAtomic
cmd@UpdPerception{} ->
FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPlain FactionId
fid "RespUpdAtomicNoState" UpdAtomic
cmd
RespUpdAtomicNoState cmd :: UpdAtomic
cmd@UpdResume{} ->
FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPlain FactionId
fid "RespUpdAtomicNoState" UpdAtomic
cmd
RespUpdAtomicNoState cmd :: UpdAtomic
cmd@UpdSpotTile{} ->
FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPlain FactionId
fid "RespUpdAtomicNoState" UpdAtomic
cmd
RespUpdAtomicNoState cmd :: UpdAtomic
cmd ->
FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPretty FactionId
fid "RespUpdAtomicNoState" UpdAtomic
cmd
RespQueryAI aid :: ActorId
aid -> do
Text
d <- ActorId -> Text -> m Text
forall (m :: * -> *). MonadServer m => ActorId -> Text -> m Text
debugAid ActorId
aid "RespQueryAI"
Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
serverPrint Text
d
RespSfxAtomic sfx :: SfxAtomic
sfx -> do
PosAtomic
ps <- SfxAtomic -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => SfxAtomic -> m PosAtomic
posSfxAtomic SfxAtomic
sfx
Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
serverPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ (FactionId, Text, PosAtomic) -> Text
forall a. Show a => a -> Text
debugShow (FactionId
fid, "RespSfxAtomic" :: Text, PosAtomic
ps)
RespQueryUI -> Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
serverPrint "RespQueryUI"
debugPretty :: MonadServer m => FactionId -> Text -> UpdAtomic -> m ()
debugPretty :: FactionId -> Text -> UpdAtomic -> m ()
debugPretty fid :: FactionId
fid t :: Text
t cmd :: UpdAtomic
cmd = do
PosAtomic
ps <- UpdAtomic -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => UpdAtomic -> m PosAtomic
posUpdAtomic UpdAtomic
cmd
Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
serverPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ (FactionId, Text, PosAtomic, UpdAtomic) -> Text
forall a. Show a => a -> Text
debugShow (FactionId
fid, Text
t, PosAtomic
ps, UpdAtomic
cmd)
debugPlain :: MonadServer m => FactionId -> Text -> UpdAtomic -> m ()
debugPlain :: FactionId -> Text -> UpdAtomic -> m ()
debugPlain fid :: FactionId
fid t :: Text
t cmd :: UpdAtomic
cmd = do
PosAtomic
ps <- UpdAtomic -> m PosAtomic
forall (m :: * -> *). MonadStateRead m => UpdAtomic -> m PosAtomic
posUpdAtomic UpdAtomic
cmd
Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
serverPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (FactionId, Text, PosAtomic, UpdAtomic) -> String
forall a. Show a => a -> String
show (FactionId
fid, Text
t, PosAtomic
ps, UpdAtomic
cmd)
debugRequestAI :: MonadServer m => ActorId -> m ()
debugRequestAI :: ActorId -> m ()
debugRequestAI aid :: ActorId
aid = do
Text
d <- ActorId -> Text -> m Text
forall (m :: * -> *). MonadServer m => ActorId -> Text -> m Text
debugAid ActorId
aid "AI request"
Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
serverPrint Text
d
debugRequestUI :: MonadServer m => ActorId -> m ()
debugRequestUI :: ActorId -> m ()
debugRequestUI aid :: ActorId
aid = do
Text
d <- ActorId -> Text -> m Text
forall (m :: * -> *). MonadServer m => ActorId -> Text -> m Text
debugAid ActorId
aid "UI request"
Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
serverPrint Text
d
data DebugAid = DebugAid
{ DebugAid -> Text
label :: Text
, DebugAid -> ActorId
aid :: ActorId
, DebugAid -> FactionId
faction :: FactionId
, DebugAid -> LevelId
lid :: LevelId
, DebugAid -> Int64
bHP :: Int64
, DebugAid -> Maybe Time
btime :: Maybe Time
, DebugAid -> Maybe Time
btrTime :: Maybe Time
, DebugAid -> Time
time :: Time
}
deriving Int -> DebugAid -> ShowS
[DebugAid] -> ShowS
DebugAid -> String
(Int -> DebugAid -> ShowS)
-> (DebugAid -> String) -> ([DebugAid] -> ShowS) -> Show DebugAid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebugAid] -> ShowS
$cshowList :: [DebugAid] -> ShowS
show :: DebugAid -> String
$cshow :: DebugAid -> String
showsPrec :: Int -> DebugAid -> ShowS
$cshowsPrec :: Int -> DebugAid -> ShowS
Show
debugAid :: MonadServer m => ActorId -> Text -> m Text
debugAid :: ActorId -> Text -> m Text
debugAid aid :: ActorId
aid label :: Text
label = do
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
Time
time <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
b)
Maybe Time
btime <- (StateServer -> Maybe Time) -> m (Maybe Time)
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Maybe Time) -> m (Maybe Time))
-> (StateServer -> Maybe Time) -> m (Maybe Time)
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> ActorId -> ActorTime -> Maybe Time
lookupActorTime (Actor -> FactionId
bfid Actor
b) (Actor -> LevelId
blid Actor
b) ActorId
aid (ActorTime -> Maybe Time)
-> (StateServer -> ActorTime) -> StateServer -> Maybe Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ActorTime
sactorTime
Maybe Time
btrTime <- (StateServer -> Maybe Time) -> m (Maybe Time)
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Maybe Time) -> m (Maybe Time))
-> (StateServer -> Maybe Time) -> m (Maybe Time)
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> ActorId -> ActorTime -> Maybe Time
lookupActorTime (Actor -> FactionId
bfid Actor
b) (Actor -> LevelId
blid Actor
b) ActorId
aid (ActorTime -> Maybe Time)
-> (StateServer -> ActorTime) -> StateServer -> Maybe Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ActorTime
strajTime
Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$! DebugAid -> Text
forall a. Show a => a -> Text
debugShow $WDebugAid :: Text
-> ActorId
-> FactionId
-> LevelId
-> Int64
-> Maybe Time
-> Maybe Time
-> Time
-> DebugAid
DebugAid { Text
label :: Text
label :: Text
label
, ActorId
aid :: ActorId
aid :: ActorId
aid
, faction :: FactionId
faction = Actor -> FactionId
bfid Actor
b
, lid :: LevelId
lid = Actor -> LevelId
blid Actor
b
, bHP :: Int64
bHP = Actor -> Int64
bhp Actor
b
, Maybe Time
btime :: Maybe Time
btime :: Maybe Time
btime
, Maybe Time
btrTime :: Maybe Time
btrTime :: Maybe Time
btrTime
, Time
time :: Time
time :: Time
time }