-- | Debug readout sampling shared by the backends: frame timing and skip
-- counts, RTS statistics, draw counts, and the rows the debug windows show.
module NanoUI.Debug
  ( debugRefreshSec
  , blend
  , RtsStatsSnapshot (..)
  , readRtsSnapshot
  , CoreDebugSnapshot (..)
  , emptyCoreDebugSnapshot
  , DebugSampler (..)
  , DebugSamplerRef
  , newDebugSampler
  , noteDebugLoop
  , noteDebugSkip
  , isDebugActive
  , debugRefreshDue
  , noteDebugPresent
  , refreshDebugSnapshot
  , formatFpsRows
  , formatDrawRows
  , formatCoreRtsRows
  ) where

import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef, writeIORef)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Word (Word32, Word64)
import GHC.Clock (getMonotonicTime)
import GHC.Conc (getNumCapabilities, getNumProcessors)
import GHC.Stats (GCDetails (..), RTSStats (..), getRTSStats, getRTSStatsEnabled)
import Text.Printf (printf)

debugRefreshSec :: Double
debugRefreshSec :: Double
debugRefreshSec = Double
0.25

blend :: Double -> Double -> Double
blend :: Double -> Double -> Double
blend Double
prev Double
sample
  | Double
prev Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0 = Double
sample
  | Bool
otherwise = Double
prev Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.85 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
sample Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.15

data RtsStatsSnapshot = RtsStatsSnapshot
  { RtsStatsSnapshot -> Bool
rtsEnabled :: !Bool
  , RtsStatsSnapshot -> Word32
rtsGcs :: !Word32
  , RtsStatsSnapshot -> Word32
rtsMajorGcs :: !Word32
  , RtsStatsSnapshot -> Double
rtsAllocMb :: !Double
  , RtsStatsSnapshot -> Double
rtsLiveMb :: !Double
  , RtsStatsSnapshot -> Double
rtsMaxMemMb :: !Double
  , RtsStatsSnapshot -> Double
rtsCopiedMb :: !Double
  , RtsStatsSnapshot -> Double
rtsGcPct :: !Double
  , RtsStatsSnapshot -> Word32
rtsLastGcGen :: !Word32
  , RtsStatsSnapshot -> Double
rtsLastGcMs :: !Double
  , RtsStatsSnapshot -> Int
rtsCaps :: !Int
  , RtsStatsSnapshot -> Int
rtsCpus :: !Int
  }
  deriving (RtsStatsSnapshot -> RtsStatsSnapshot -> Bool
(RtsStatsSnapshot -> RtsStatsSnapshot -> Bool)
-> (RtsStatsSnapshot -> RtsStatsSnapshot -> Bool)
-> Eq RtsStatsSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RtsStatsSnapshot -> RtsStatsSnapshot -> Bool
== :: RtsStatsSnapshot -> RtsStatsSnapshot -> Bool
$c/= :: RtsStatsSnapshot -> RtsStatsSnapshot -> Bool
/= :: RtsStatsSnapshot -> RtsStatsSnapshot -> Bool
Eq, Int -> RtsStatsSnapshot -> ShowS
[RtsStatsSnapshot] -> ShowS
RtsStatsSnapshot -> String
(Int -> RtsStatsSnapshot -> ShowS)
-> (RtsStatsSnapshot -> String)
-> ([RtsStatsSnapshot] -> ShowS)
-> Show RtsStatsSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RtsStatsSnapshot -> ShowS
showsPrec :: Int -> RtsStatsSnapshot -> ShowS
$cshow :: RtsStatsSnapshot -> String
show :: RtsStatsSnapshot -> String
$cshowList :: [RtsStatsSnapshot] -> ShowS
showList :: [RtsStatsSnapshot] -> ShowS
Show)

emptyRtsSnapshot :: RtsStatsSnapshot
emptyRtsSnapshot :: RtsStatsSnapshot
emptyRtsSnapshot =
  RtsStatsSnapshot
    { rtsEnabled :: Bool
rtsEnabled = Bool
False
    , rtsGcs :: Word32
rtsGcs = Word32
0
    , rtsMajorGcs :: Word32
rtsMajorGcs = Word32
0
    , rtsAllocMb :: Double
rtsAllocMb = Double
0
    , rtsLiveMb :: Double
rtsLiveMb = Double
0
    , rtsMaxMemMb :: Double
rtsMaxMemMb = Double
0
    , rtsCopiedMb :: Double
rtsCopiedMb = Double
0
    , rtsGcPct :: Double
rtsGcPct = Double
0
    , rtsLastGcGen :: Word32
rtsLastGcGen = Word32
0
    , rtsLastGcMs :: Double
rtsLastGcMs = Double
0
    , rtsCaps :: Int
rtsCaps = Int
0
    , rtsCpus :: Int
rtsCpus = Int
0
    }

readRtsSnapshot :: IO RtsStatsSnapshot
readRtsSnapshot :: IO RtsStatsSnapshot
readRtsSnapshot = do
  caps <- IO Int
getNumCapabilities
  cpus <- getNumProcessors
  rtsOn <- getRTSStatsEnabled
  if not rtsOn
    then pure emptyRtsSnapshot {rtsCaps = caps, rtsCpus = cpus}
    else do
      st <- getRTSStats
      let tot = RTSStats -> RtsTime
elapsed_ns RTSStats
st
          lastGc = RTSStats -> GCDetails
gc RTSStats
st
          bytesMb a
n = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
1024 a -> a -> a
forall a. Num a => a -> a -> a
* a
1024)
      pure
        RtsStatsSnapshot
          { rtsEnabled = True
          , rtsGcs = gcs st
          , rtsMajorGcs = major_gcs st
          , rtsAllocMb = bytesMb (allocated_bytes st)
          , rtsLiveMb = bytesMb (gcdetails_live_bytes lastGc)
          , rtsMaxMemMb = bytesMb (max_mem_in_use_bytes st)
          , rtsCopiedMb = bytesMb (copied_bytes st)
          , rtsGcPct =
              if tot > 0 then 100 * fromIntegral (gc_elapsed_ns st) / fromIntegral tot else 0
          , rtsLastGcGen = gcdetails_gen lastGc
          , rtsLastGcMs = fromIntegral (gcdetails_elapsed_ns lastGc) / 1.0e6
          , rtsCaps = caps
          , rtsCpus = cpus
          }

data CoreDebugSnapshot = CoreDebugSnapshot
  { CoreDebugSnapshot -> Double
dbgPresentFps :: !Double
  , CoreDebugSnapshot -> Double
dbgLoopFps    :: !Double
  , CoreDebugSnapshot -> Double
dbgFrameMs    :: !Double
  , CoreDebugSnapshot -> Double
dbgUiMs       :: !Double
  , CoreDebugSnapshot -> Double
dbgRenderMs   :: !Double
  , CoreDebugSnapshot -> Double
dbgPresentMs  :: !Double
  , CoreDebugSnapshot -> Word64
dbgPresents   :: !Word64
  , CoreDebugSnapshot -> Word64
dbgSkips      :: !Word64
  , CoreDebugSnapshot -> Int
dbgVerts      :: !Int
  , CoreDebugSnapshot -> Int
dbgIndices    :: !Int
  , CoreDebugSnapshot -> Int
dbgCmds       :: !Int
  , CoreDebugSnapshot -> Float
dbgWinW       :: !Float
  , CoreDebugSnapshot -> Float
dbgWinH       :: !Float
  , CoreDebugSnapshot -> Float
dbgMouseX     :: !Float
  , CoreDebugSnapshot -> Float
dbgMouseY     :: !Float
  , CoreDebugSnapshot -> RtsStatsSnapshot
dbgRts        :: !RtsStatsSnapshot
  }
  deriving (CoreDebugSnapshot -> CoreDebugSnapshot -> Bool
(CoreDebugSnapshot -> CoreDebugSnapshot -> Bool)
-> (CoreDebugSnapshot -> CoreDebugSnapshot -> Bool)
-> Eq CoreDebugSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CoreDebugSnapshot -> CoreDebugSnapshot -> Bool
== :: CoreDebugSnapshot -> CoreDebugSnapshot -> Bool
$c/= :: CoreDebugSnapshot -> CoreDebugSnapshot -> Bool
/= :: CoreDebugSnapshot -> CoreDebugSnapshot -> Bool
Eq, Int -> CoreDebugSnapshot -> ShowS
[CoreDebugSnapshot] -> ShowS
CoreDebugSnapshot -> String
(Int -> CoreDebugSnapshot -> ShowS)
-> (CoreDebugSnapshot -> String)
-> ([CoreDebugSnapshot] -> ShowS)
-> Show CoreDebugSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CoreDebugSnapshot -> ShowS
showsPrec :: Int -> CoreDebugSnapshot -> ShowS
$cshow :: CoreDebugSnapshot -> String
show :: CoreDebugSnapshot -> String
$cshowList :: [CoreDebugSnapshot] -> ShowS
showList :: [CoreDebugSnapshot] -> ShowS
Show)

emptyCoreDebugSnapshot :: CoreDebugSnapshot
emptyCoreDebugSnapshot :: CoreDebugSnapshot
emptyCoreDebugSnapshot =
  CoreDebugSnapshot
    { dbgPresentFps :: Double
dbgPresentFps = Double
0
    , dbgLoopFps :: Double
dbgLoopFps = Double
0
    , dbgFrameMs :: Double
dbgFrameMs = Double
0
    , dbgUiMs :: Double
dbgUiMs = Double
0
    , dbgRenderMs :: Double
dbgRenderMs = Double
0
    , dbgPresentMs :: Double
dbgPresentMs = Double
0
    , dbgPresents :: Word64
dbgPresents = Word64
0
    , dbgSkips :: Word64
dbgSkips = Word64
0
    , dbgVerts :: Int
dbgVerts = Int
0
    , dbgIndices :: Int
dbgIndices = Int
0
    , dbgCmds :: Int
dbgCmds = Int
0
    , dbgWinW :: Float
dbgWinW = Float
0
    , dbgWinH :: Float
dbgWinH = Float
0
    , dbgMouseX :: Float
dbgMouseX = Float
0
    , dbgMouseY :: Float
dbgMouseY = Float
0
    , dbgRts :: RtsStatsSnapshot
dbgRts = RtsStatsSnapshot
emptyRtsSnapshot
    }

data DebugSampler = DebugSampler
  { DebugSampler -> Double
smPresentEma   :: {-# UNPACK #-} !Double
  , DebugSampler -> Double
smLoopEma      :: {-# UNPACK #-} !Double
  , DebugSampler -> Double
smLastPresentT :: {-# UNPACK #-} !Double
  , DebugSampler -> Double
smLastDebugT   :: {-# UNPACK #-} !Double
  , DebugSampler -> Double
smLastQueryT   :: {-# UNPACK #-} !Double
  , DebugSampler -> Word64
smPresents     :: {-# UNPACK #-} !Word64
  , DebugSampler -> Word64
smSkips        :: {-# UNPACK #-} !Word64
  , DebugSampler -> Double
smUiMs         :: {-# UNPACK #-} !Double
  , DebugSampler -> Double
smRenderMs     :: {-# UNPACK #-} !Double
  , DebugSampler -> Double
smPresentMs    :: {-# UNPACK #-} !Double
  , DebugSampler -> Double
smFrameMs      :: {-# UNPACK #-} !Double
  , DebugSampler -> Int
smVerts        :: {-# UNPACK #-} !Int
  , DebugSampler -> Int
smIndices      :: {-# UNPACK #-} !Int
  , DebugSampler -> Int
smCmds         :: {-# UNPACK #-} !Int
  , DebugSampler -> Word64
smRatePresents :: {-# UNPACK #-} !Word64
  , DebugSampler -> Double
smRateT        :: {-# UNPACK #-} !Double
  }

type DebugSamplerRef = IORef DebugSampler

newDebugSampler :: IO DebugSamplerRef
newDebugSampler :: IO DebugSamplerRef
newDebugSampler = do
  now <- IO Double
getMonotonicTime
  newIORef
    DebugSampler
      { smPresentEma = 0
      , smLoopEma = 0
      , smLastPresentT = now
      , smLastDebugT = 0
      , smLastQueryT = 0
      , smPresents = 0
      , smSkips = 0
      , smUiMs = 0
      , smRenderMs = 0
      , smPresentMs = 0
      , smFrameMs = 0
      , smVerts = 0
      , smIndices = 0
      , smCmds = 0
      , smRatePresents = 0
      , smRateT = now
      }

noteDebugLoop :: DebugSamplerRef -> Float -> IO ()
noteDebugLoop :: DebugSamplerRef -> Float -> IO ()
noteDebugLoop DebugSamplerRef
ref Float
dt =
  DebugSamplerRef -> (DebugSampler -> (DebugSampler, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' DebugSamplerRef
ref ((DebugSampler -> (DebugSampler, ())) -> IO ())
-> (DebugSampler -> (DebugSampler, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DebugSampler
s ->
    let dtD :: Double
dtD = Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
dt :: Double
        fps :: Double
fps = if Double
dtD Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1e-4 Bool -> Bool -> Bool
&& Double
dtD Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.25 then Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dtD else Double
0
        ema' :: Double
ema' =
          if Double
fps Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0
            then Double -> Double -> Double
blend (DebugSampler -> Double
smLoopEma DebugSampler
s) Double
fps
            else DebugSampler -> Double
smLoopEma DebugSampler
s
     in (DebugSampler
s {smLoopEma = ema'}, ())

noteDebugSkip :: DebugSamplerRef -> IO ()
noteDebugSkip :: DebugSamplerRef -> IO ()
noteDebugSkip DebugSamplerRef
ref =
  DebugSamplerRef -> (DebugSampler -> (DebugSampler, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' DebugSamplerRef
ref ((DebugSampler -> (DebugSampler, ())) -> IO ())
-> (DebugSampler -> (DebugSampler, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DebugSampler
s -> (DebugSampler
s {smSkips = smSkips s + 1}, ())

-- | Debug HUD cadence is driven by actual snapshot consumption: a snapshot
-- query ('refreshDebugSnapshot') refreshes 'smLastQueryT', so the 4 Hz refresh
-- loop only runs while a stats window is being built. An open window alone
-- does not count as activity, or the event loop would wake every refresh
-- period while any floating window is open.
isDebugActive :: DebugSamplerRef -> IO Bool
isDebugActive :: DebugSamplerRef -> IO Bool
isDebugActive DebugSamplerRef
ref = do
  now <- IO Double
getMonotonicTime
  s <- readIORef ref
  pure (now - smLastQueryT s < 1.0)

-- | Whether the published snapshot is older than 'debugRefreshSec'.
debugRefreshDue :: DebugSamplerRef -> IO Bool
debugRefreshDue :: DebugSamplerRef -> IO Bool
debugRefreshDue DebugSamplerRef
ref = do
  now <- IO Double
getMonotonicTime
  s <- readIORef ref
  pure (snapshotDue now s)

snapshotDue :: Double -> DebugSampler -> Bool
snapshotDue :: Double -> DebugSampler -> Bool
snapshotDue Double
now DebugSampler
s = DebugSampler -> Double
smLastDebugT DebugSampler
s Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0 Bool -> Bool -> Bool
|| Double
now Double -> Double -> Double
forall a. Num a => a -> a -> a
- DebugSampler -> Double
smLastDebugT DebugSampler
s Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
debugRefreshSec

noteDebugPresent :: DebugSamplerRef -> Double -> Double -> Double -> Double -> Int -> Int -> Int -> IO ()
noteDebugPresent :: DebugSamplerRef
-> Double
-> Double
-> Double
-> Double
-> Int
-> Int
-> Int
-> IO ()
noteDebugPresent DebugSamplerRef
ref Double
uiMs Double
renderMs Double
presentMs Double
frameMs Int
verts Int
indices Int
cmds = do
  now <- IO Double
getMonotonicTime
  atomicModifyIORef' ref $ \DebugSampler
s ->
    let dt :: Double
dt = Double
now Double -> Double -> Double
forall a. Num a => a -> a -> a
- DebugSampler -> Double
smLastPresentT DebugSampler
s
        instantFps :: Double
instantFps =
          if Double
dt Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1e-4 Bool -> Bool -> Bool
&& Double
dt Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.25
            then Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dt
            else Double
0
        ema' :: Double
ema' =
          if Double
instantFps Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0
            then Double -> Double -> Double
blend (DebugSampler -> Double
smPresentEma DebugSampler
s) Double
instantFps
            else DebugSampler -> Double
smPresentEma DebugSampler
s
     in ( DebugSampler
s
             { smPresentEma = ema'
             , smLastPresentT = now
             , smPresents = smPresents s + 1
             , smUiMs = uiMs
             , smRenderMs = renderMs
             , smPresentMs = presentMs
             , smFrameMs = frameMs
             , smVerts = verts
             , smIndices = indices
             , smCmds = cmds
             }
        , ()
        )

-- | The published snapshot, rebuilt at most every 'debugRefreshSec' and cached
-- in between. A due query samples the core stats and hands them to @build@,
-- which adds the backend's fields: window size and mouse position are left 0
-- for it to fill. Every query marks the readout active ('isDebugActive').
refreshDebugSnapshot :: DebugSamplerRef -> IORef s -> (CoreDebugSnapshot -> IO s) -> IO s
refreshDebugSnapshot :: forall s.
DebugSamplerRef -> IORef s -> (CoreDebugSnapshot -> IO s) -> IO s
refreshDebugSnapshot DebugSamplerRef
ref IORef s
cache CoreDebugSnapshot -> IO s
build = do
  now <- IO Double
getMonotonicTime
  due <- atomicModifyIORef' ref $ \DebugSampler
cur -> (DebugSampler
cur {smLastQueryT = now}, Double -> DebugSampler -> Bool
snapshotDue Double
now DebugSampler
cur)
  if not due
    then readIORef cache
    else do
      rts <- readRtsSnapshot
      core <- atomicModifyIORef' ref $ \DebugSampler
cur ->
        -- Actual presents per second since the previous refresh. Unlike the
        -- per-present EMA this stays truthful when presents are sparse (idle
        -- app: ~4/s with the HUD open, not the theoretical fps of one fast
        -- frame).
        let elapsed :: Double
elapsed = Double
now Double -> Double -> Double
forall a. Num a => a -> a -> a
- DebugSampler -> Double
smRateT DebugSampler
cur
            rate :: Double
rate
              | Double
elapsed Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1e-3 = Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DebugSampler -> Word64
smPresents DebugSampler
cur Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- DebugSampler -> Word64
smRatePresents DebugSampler
cur) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
elapsed
              | Bool
otherwise = Double
0
            cur' :: DebugSampler
cur' = DebugSampler
cur {smLastDebugT = now, smRatePresents = smPresents cur, smRateT = now}
         in (DebugSampler
cur', (DebugSampler -> RtsStatsSnapshot -> CoreDebugSnapshot
coreDebugSnapshot DebugSampler
cur' RtsStatsSnapshot
rts) {dbgPresentFps = rate})
      snap <- build core
      writeIORef cache snap
      pure snap

coreDebugSnapshot :: DebugSampler -> RtsStatsSnapshot -> CoreDebugSnapshot
coreDebugSnapshot :: DebugSampler -> RtsStatsSnapshot -> CoreDebugSnapshot
coreDebugSnapshot DebugSampler
s RtsStatsSnapshot
rts =
  CoreDebugSnapshot
    { dbgPresentFps :: Double
dbgPresentFps = DebugSampler -> Double
smPresentEma DebugSampler
s
    , dbgLoopFps :: Double
dbgLoopFps = DebugSampler -> Double
smLoopEma DebugSampler
s
    , dbgFrameMs :: Double
dbgFrameMs = DebugSampler -> Double
smFrameMs DebugSampler
s
    , dbgUiMs :: Double
dbgUiMs = DebugSampler -> Double
smUiMs DebugSampler
s
    , dbgRenderMs :: Double
dbgRenderMs = DebugSampler -> Double
smRenderMs DebugSampler
s
    , dbgPresentMs :: Double
dbgPresentMs = DebugSampler -> Double
smPresentMs DebugSampler
s
    , dbgPresents :: Word64
dbgPresents = DebugSampler -> Word64
smPresents DebugSampler
s
    , dbgSkips :: Word64
dbgSkips = DebugSampler -> Word64
smSkips DebugSampler
s
    , dbgVerts :: Int
dbgVerts = DebugSampler -> Int
smVerts DebugSampler
s
    , dbgIndices :: Int
dbgIndices = DebugSampler -> Int
smIndices DebugSampler
s
    , dbgCmds :: Int
dbgCmds = DebugSampler -> Int
smCmds DebugSampler
s
    , dbgWinW :: Float
dbgWinW = Float
0
    , dbgWinH :: Float
dbgWinH = Float
0
    , dbgMouseX :: Float
dbgMouseX = Float
0
    , dbgMouseY :: Float
dbgMouseY = Float
0
    , dbgRts :: RtsStatsSnapshot
dbgRts = RtsStatsSnapshot
rts
    }

formatFpsRows :: CoreDebugSnapshot -> [(Text, Text)]
formatFpsRows :: CoreDebugSnapshot -> [(Text, Text)]
formatFpsRows CoreDebugSnapshot
s =
  [ (Text
"fps present", String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%6.1f" (CoreDebugSnapshot -> Double
dbgPresentFps CoreDebugSnapshot
s)))
  , (Text
"fps loop", String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%6.1f" (CoreDebugSnapshot -> Double
dbgLoopFps CoreDebugSnapshot
s)))
  , (Text
"frame ms", String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%6.2f" (CoreDebugSnapshot -> Double
dbgFrameMs CoreDebugSnapshot
s)))
  , (Text
"ui ms", String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%6.2f" (CoreDebugSnapshot -> Double
dbgUiMs CoreDebugSnapshot
s)))
  , (Text
"render ms", String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%6.2f" (CoreDebugSnapshot -> Double
dbgRenderMs CoreDebugSnapshot
s)))
  , (Text
"present ms", String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%6.2f" (CoreDebugSnapshot -> Double
dbgPresentMs CoreDebugSnapshot
s)))
  , (Text
"presents", String -> Text
T.pack (String -> Word64 -> String
forall r. PrintfType r => String -> r
printf String
"%10d" (CoreDebugSnapshot -> Word64
dbgPresents CoreDebugSnapshot
s)))
  , (Text
"skips", String -> Text
T.pack (String -> Word64 -> String
forall r. PrintfType r => String -> r
printf String
"%10d" (CoreDebugSnapshot -> Word64
dbgSkips CoreDebugSnapshot
s)))
  ]

formatDrawRows :: CoreDebugSnapshot -> [(Text, Text)]
formatDrawRows :: CoreDebugSnapshot -> [(Text, Text)]
formatDrawRows CoreDebugSnapshot
s =
  [ (Text
"vertices", String -> Text
T.pack (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%10d" (CoreDebugSnapshot -> Int
dbgVerts CoreDebugSnapshot
s)))
  , (Text
"indices", String -> Text
T.pack (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%10d" (CoreDebugSnapshot -> Int
dbgIndices CoreDebugSnapshot
s)))
  , (Text
"commands", String -> Text
T.pack (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%10d" (CoreDebugSnapshot -> Int
dbgCmds CoreDebugSnapshot
s)))
  ]

formatCoreRtsRows :: CoreDebugSnapshot -> [(Text, Text)]
formatCoreRtsRows :: CoreDebugSnapshot -> [(Text, Text)]
formatCoreRtsRows CoreDebugSnapshot
core
  | Bool -> Bool
not (RtsStatsSnapshot -> Bool
rtsEnabled RtsStatsSnapshot
s) =
      [ (Text
"rts", Text
"stats off (need +RTS -T)")
      , (Text
"haskell", String -> Text
T.pack (String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%2d cap / %2d cpu" (RtsStatsSnapshot -> Int
rtsCaps RtsStatsSnapshot
s) (RtsStatsSnapshot -> Int
rtsCpus RtsStatsSnapshot
s)))
      ]
  | Bool
otherwise =
      [ (Text
"haskell", String -> Text
T.pack (String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%2d cap / %2d cpu" (RtsStatsSnapshot -> Int
rtsCaps RtsStatsSnapshot
s) (RtsStatsSnapshot -> Int
rtsCpus RtsStatsSnapshot
s)))
      , (Text
"gc total", String -> Text
T.pack (String -> Word32 -> String
forall r. PrintfType r => String -> r
printf String
"%10d" (RtsStatsSnapshot -> Word32
rtsGcs RtsStatsSnapshot
s)))
      , (Text
"gc major", String -> Text
T.pack (String -> Word32 -> String
forall r. PrintfType r => String -> r
printf String
"%10d" (RtsStatsSnapshot -> Word32
rtsMajorGcs RtsStatsSnapshot
s)))
      , (Text
"last gen", String -> Text
T.pack (String -> Word32 -> String
forall r. PrintfType r => String -> r
printf String
"%10d" (RtsStatsSnapshot -> Word32
rtsLastGcGen RtsStatsSnapshot
s)))
      , (Text
"last gc", String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%7.2f ms" (RtsStatsSnapshot -> Double
rtsLastGcMs RtsStatsSnapshot
s)))
      , (Text
"heap live", String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%6.1f MiB" (RtsStatsSnapshot -> Double
rtsLiveMb RtsStatsSnapshot
s)))
      , (Text
"heap alloc", String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%6.1f MiB" (RtsStatsSnapshot -> Double
rtsAllocMb RtsStatsSnapshot
s)))
      , (Text
"copied", String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%6.1f MiB" (RtsStatsSnapshot -> Double
rtsCopiedMb RtsStatsSnapshot
s)))
      , (Text
"rss max", String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%6.1f MiB" (RtsStatsSnapshot -> Double
rtsMaxMemMb RtsStatsSnapshot
s)))
      , (Text
"gc time", String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%9.1f%%" (RtsStatsSnapshot -> Double
rtsGcPct RtsStatsSnapshot
s)))
      ]
  where
    s :: RtsStatsSnapshot
s = CoreDebugSnapshot -> RtsStatsSnapshot
dbgRts CoreDebugSnapshot
core