-- | 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 :: forall a. Show a => 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 :: forall (m :: * -> *).
MonadServer m =>
FactionId -> Response -> m ()
debugResponse FactionId
fid Response
resp = case Response
resp of
  RespUpdAtomic State
_ cmd :: UpdAtomic
cmd@UpdPerception{} -> FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPlain FactionId
fid Text
"RespUpdAtomic" UpdAtomic
cmd
  RespUpdAtomic State
_ cmd :: UpdAtomic
cmd@UpdResume{} -> FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPlain FactionId
fid Text
"RespUpdAtomic" UpdAtomic
cmd
  RespUpdAtomic State
_ cmd :: UpdAtomic
cmd@UpdRestart{} -> FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPlain FactionId
fid Text
"RespUpdAtomic" UpdAtomic
cmd
  RespUpdAtomic State
_ cmd :: UpdAtomic
cmd@UpdSpotTile{} -> FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPlain FactionId
fid Text
"RespUpdAtomic" UpdAtomic
cmd
  RespUpdAtomic State
_ cmd :: UpdAtomic
cmd@(UpdCreateActor ActorId
aid Actor
_ [(ItemId, Item)]
_) -> do
    Text
d <- ActorId -> Text -> m Text
forall (m :: * -> *). MonadServer m => ActorId -> Text -> m Text
debugAid ActorId
aid Text
"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 Text
"RespUpdAtomic" UpdAtomic
cmd
  RespUpdAtomic State
_ cmd :: UpdAtomic
cmd@(UpdSpotActor ActorId
aid Actor
_) -> do
    Text
d <- ActorId -> Text -> m Text
forall (m :: * -> *). MonadServer m => ActorId -> Text -> m Text
debugAid ActorId
aid Text
"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 Text
"RespUpdAtomic" UpdAtomic
cmd
  RespUpdAtomic State
_ UpdAtomic
cmd -> FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPretty FactionId
fid Text
"RespUpdAtomic" UpdAtomic
cmd
  RespUpdAtomicNoState cmd :: UpdAtomic
cmd@UpdPerception{} ->
    FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPlain FactionId
fid Text
"RespUpdAtomicNoState" UpdAtomic
cmd
  RespUpdAtomicNoState cmd :: UpdAtomic
cmd@UpdResume{} ->
    FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPlain FactionId
fid Text
"RespUpdAtomicNoState" UpdAtomic
cmd
  RespUpdAtomicNoState cmd :: UpdAtomic
cmd@UpdSpotTile{} ->
    FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPlain FactionId
fid Text
"RespUpdAtomicNoState" UpdAtomic
cmd
  RespUpdAtomicNoState UpdAtomic
cmd ->
    FactionId -> Text -> UpdAtomic -> m ()
forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPretty FactionId
fid Text
"RespUpdAtomicNoState" UpdAtomic
cmd
  RespQueryAI ActorId
aid -> do
    Text
d <- ActorId -> Text -> m Text
forall (m :: * -> *). MonadServer m => ActorId -> Text -> m Text
debugAid ActorId
aid Text
"RespQueryAI"
    Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
serverPrint Text
d
  RespSfxAtomic SfxAtomic
sfx -> do  -- not so crucial so no details
    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, Text
"RespSfxAtomic" :: Text, PosAtomic
ps)
  Response
RespQueryUIunderAI -> Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
serverPrint Text
"RespQueryUIunderAI"
  Response
RespQueryUI -> Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
serverPrint Text
"RespQueryUI"

debugPretty :: MonadServer m => FactionId -> Text -> UpdAtomic -> m ()
debugPretty :: forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPretty FactionId
fid Text
t 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 :: forall (m :: * -> *).
MonadServer m =>
FactionId -> Text -> UpdAtomic -> m ()
debugPlain FactionId
fid Text
t 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)
    -- too large for pretty printing

debugRequestAI :: MonadServer m => ActorId -> m ()
debugRequestAI :: forall (m :: * -> *). MonadServer m => ActorId -> m ()
debugRequestAI ActorId
aid = do
  Text
d <- ActorId -> Text -> m Text
forall (m :: * -> *). MonadServer m => ActorId -> Text -> m Text
debugAid ActorId
aid Text
"AI request"
  Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
serverPrint Text
d

debugRequestUI :: MonadServer m => ActorId -> m ()
debugRequestUI :: forall (m :: * -> *). MonadServer m => ActorId -> m ()
debugRequestUI ActorId
aid = do
  Text
d <- ActorId -> Text -> m Text
forall (m :: * -> *). MonadServer m => ActorId -> Text -> m Text
debugAid ActorId
aid Text
"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
$cshowsPrec :: Int -> DebugAid -> ShowS
showsPrec :: Int -> DebugAid -> ShowS
$cshow :: DebugAid -> String
show :: DebugAid -> String
$cshowList :: [DebugAid] -> ShowS
showList :: [DebugAid] -> ShowS
Show

debugAid :: MonadServer m => ActorId -> Text -> m Text
debugAid :: forall (m :: * -> *). MonadServer m => ActorId -> Text -> m Text
debugAid ActorId
aid Text
label = do
  Actor
b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
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 a. (State -> a) -> m a
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 a. (StateServer -> a) -> m a
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 a. (StateServer -> a) -> m a
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 a. a -> m a
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 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 }