-- | 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 :: 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  -- 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, "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)
    -- too large for pretty printing

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 }