module Stats
  ( RtsStatsPath (..),
    recordRtsStats,
  )
where

import Control.Exception (finally)
import Data.Aeson (encode, object, (.=))
import Data.ByteString.Lazy qualified as BL
import Data.Function
import Data.String (IsString)
import GHC.Stats

newtype RtsStatsPath
  = RtsStatsPath FilePath
  deriving stock (Int -> RtsStatsPath -> ShowS
[RtsStatsPath] -> ShowS
RtsStatsPath -> String
(Int -> RtsStatsPath -> ShowS)
-> (RtsStatsPath -> String)
-> ([RtsStatsPath] -> ShowS)
-> Show RtsStatsPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RtsStatsPath -> ShowS
showsPrec :: Int -> RtsStatsPath -> ShowS
$cshow :: RtsStatsPath -> String
show :: RtsStatsPath -> String
$cshowList :: [RtsStatsPath] -> ShowS
showList :: [RtsStatsPath] -> ShowS
Show, RtsStatsPath -> RtsStatsPath -> Bool
(RtsStatsPath -> RtsStatsPath -> Bool)
-> (RtsStatsPath -> RtsStatsPath -> Bool) -> Eq RtsStatsPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RtsStatsPath -> RtsStatsPath -> Bool
== :: RtsStatsPath -> RtsStatsPath -> Bool
$c/= :: RtsStatsPath -> RtsStatsPath -> Bool
/= :: RtsStatsPath -> RtsStatsPath -> Bool
Eq)
  deriving newtype (String -> RtsStatsPath
(String -> RtsStatsPath) -> IsString RtsStatsPath
forall a. (String -> a) -> IsString a
$cfromString :: String -> RtsStatsPath
fromString :: String -> RtsStatsPath
IsString)

recordRtsStats :: RtsStatsPath -> IO a -> IO a
recordRtsStats :: forall a. RtsStatsPath -> IO a -> IO a
recordRtsStats (RtsStatsPath String
fp) IO a
action = do
  RTSStats
r0 <- IO RTSStats
getRTSStats
  IO a
action IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` do
    RTSStats
r1 <- IO RTSStats
getRTSStats
    String -> ByteString -> IO ()
BL.writeFile String
fp (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (RTSStats -> RTSStats -> Value
produceStats RTSStats
r0 RTSStats
r1))
  where
    produceStats :: RTSStats -> RTSStats -> Value
produceStats RTSStats
r0 RTSStats
r1 =
      [Pair] -> Value
object
        [ Key
"gcs" Key -> Word32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Word32 -> Word32 -> Word32)
-> (RTSStats -> Word32) -> RTSStats -> RTSStats -> Word32
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (-) RTSStats -> Word32
gcs RTSStats
r1 RTSStats
r0,
          Key
"major_gcs" Key -> Word32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Word32 -> Word32 -> Word32)
-> (RTSStats -> Word32) -> RTSStats -> RTSStats -> Word32
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (-) RTSStats -> Word32
major_gcs RTSStats
r1 RTSStats
r0,
          Key
"allocated_bytes" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Word64 -> Word64 -> Word64)
-> (RTSStats -> Word64) -> RTSStats -> RTSStats -> Word64
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (-) RTSStats -> Word64
allocated_bytes RTSStats
r1 RTSStats
r0,
          Key
"max_live_bytes" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Word64 -> Word64 -> Word64)
-> (RTSStats -> Word64) -> RTSStats -> RTSStats -> Word64
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (-) RTSStats -> Word64
max_live_bytes RTSStats
r1 RTSStats
r0,
          Key
"copied_bytes" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Word64 -> Word64 -> Word64)
-> (RTSStats -> Word64) -> RTSStats -> RTSStats -> Word64
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (-) RTSStats -> Word64
copied_bytes RTSStats
r1 RTSStats
r0,
          Key
"mutator_cpu_ns" Key -> RtsTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (RtsTime -> RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RTSStats -> RtsTime
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (-) RTSStats -> RtsTime
mutator_cpu_ns RTSStats
r1 RTSStats
r0,
          Key
"mutator_elapsed_ns" Key -> RtsTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (RtsTime -> RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RTSStats -> RtsTime
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (-) RTSStats -> RtsTime
mutator_elapsed_ns RTSStats
r1 RTSStats
r0,
          Key
"gc_cpu_ns" Key -> RtsTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (RtsTime -> RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RTSStats -> RtsTime
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (-) RTSStats -> RtsTime
mutator_cpu_ns RTSStats
r1 RTSStats
r0,
          Key
"gc_elapsed_ns" Key -> RtsTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (RtsTime -> RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RTSStats -> RtsTime
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (-) RTSStats -> RtsTime
mutator_elapsed_ns RTSStats
r1 RTSStats
r0,
          Key
"cpu_ns" Key -> RtsTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (RtsTime -> RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RTSStats -> RtsTime
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (-) RTSStats -> RtsTime
cpu_ns RTSStats
r1 RTSStats
r0,
          Key
"elapsed_ns" Key -> RtsTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (RtsTime -> RtsTime -> RtsTime)
-> (RTSStats -> RtsTime) -> RTSStats -> RTSStats -> RtsTime
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (-) RTSStats -> RtsTime
cpu_ns RTSStats
r1 RTSStats
r0
        ]