{-# LANGUAGE DeriveGeneric #-}

-- | Functions related to obtaining information about the 'db-analyser' run.
--
-- Metadata includes information such as:
--
-- - RTS flags.
-- - Compiler version.
-- - OS and architecture.
--
-- See 'Metadata' and 'getMetadata' for more details.
--
module Cardano.Tools.DBAnalyser.Analysis.BenchmarkLedgerOps.Metadata (
    Metadata (..)
  , getMetadata
  ) where

import           Cardano.Tools.DBAnalyser.Types (LedgerApplicationMode (..))
import           Cardano.Tools.GitRev (gitRev)
import           Data.Aeson (ToJSON)
import qualified Data.Aeson as Aeson
import qualified Data.Text as T
import qualified Data.Version
import           Data.Word (Word32, Word64)
import           GHC.Generics (Generic)
import qualified GHC.RTS.Flags as RTS
import qualified System.Info

data Metadata = Metadata {
    Metadata -> Word32
rtsGCMaxStkSize             :: Word32
  , Metadata -> Word32
rtsGCMaxHeapSize            :: Word32
  , Metadata -> Word64
rtsConcurrentCtxtSwitchTime :: Word64
  , Metadata -> Word32
rtsParNCapabilities         :: Word32
  , Metadata -> String
compilerVersion             :: String
  , Metadata -> String
compilerName                :: String
  , Metadata -> String
operatingSystem             :: String
  , Metadata -> String
machineArchitecture         :: String
  , Metadata -> String
gitRevison                  :: String
  , Metadata -> String
ledgerApplicationMode       :: String
  } deriving ((forall x. Metadata -> Rep Metadata x)
-> (forall x. Rep Metadata x -> Metadata) -> Generic Metadata
forall x. Rep Metadata x -> Metadata
forall x. Metadata -> Rep Metadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Metadata -> Rep Metadata x
from :: forall x. Metadata -> Rep Metadata x
$cto :: forall x. Rep Metadata x -> Metadata
to :: forall x. Rep Metadata x -> Metadata
Generic, Int -> Metadata -> ShowS
[Metadata] -> ShowS
Metadata -> String
(Int -> Metadata -> ShowS)
-> (Metadata -> String) -> ([Metadata] -> ShowS) -> Show Metadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Metadata -> ShowS
showsPrec :: Int -> Metadata -> ShowS
$cshow :: Metadata -> String
show :: Metadata -> String
$cshowList :: [Metadata] -> ShowS
showList :: [Metadata] -> ShowS
Show, Metadata -> Metadata -> Bool
(Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool) -> Eq Metadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Metadata -> Metadata -> Bool
== :: Metadata -> Metadata -> Bool
$c/= :: Metadata -> Metadata -> Bool
/= :: Metadata -> Metadata -> Bool
Eq)

instance ToJSON Metadata where
  toEncoding :: Metadata -> Encoding
toEncoding = Options -> Metadata -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding Options
Aeson.defaultOptions

getMetadata :: LedgerApplicationMode -> IO Metadata
getMetadata :: LedgerApplicationMode -> IO Metadata
getMetadata LedgerApplicationMode
lgrAppMode = do
  RTSFlags
rtsFlags <- IO RTSFlags
RTS.getRTSFlags
  Metadata -> IO Metadata
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Metadata -> IO Metadata) -> Metadata -> IO Metadata
forall a b. (a -> b) -> a -> b
$ Metadata {
      rtsGCMaxStkSize :: Word32
rtsGCMaxStkSize             = GCFlags -> Word32
RTS.maxStkSize     (GCFlags -> Word32) -> GCFlags -> Word32
forall a b. (a -> b) -> a -> b
$ RTSFlags -> GCFlags
RTS.gcFlags RTSFlags
rtsFlags
    , rtsGCMaxHeapSize :: Word32
rtsGCMaxHeapSize            = GCFlags -> Word32
RTS.maxHeapSize    (GCFlags -> Word32) -> GCFlags -> Word32
forall a b. (a -> b) -> a -> b
$ RTSFlags -> GCFlags
RTS.gcFlags RTSFlags
rtsFlags
    , rtsConcurrentCtxtSwitchTime :: Word64
rtsConcurrentCtxtSwitchTime = ConcFlags -> Word64
RTS.ctxtSwitchTime (ConcFlags -> Word64) -> ConcFlags -> Word64
forall a b. (a -> b) -> a -> b
$ RTSFlags -> ConcFlags
RTS.concurrentFlags RTSFlags
rtsFlags
    , rtsParNCapabilities :: Word32
rtsParNCapabilities         = ParFlags -> Word32
RTS.nCapabilities  (ParFlags -> Word32) -> ParFlags -> Word32
forall a b. (a -> b) -> a -> b
$ RTSFlags -> ParFlags
RTS.parFlags RTSFlags
rtsFlags
    , compilerVersion :: String
compilerVersion             = Version -> String
Data.Version.showVersion Version
System.Info.compilerVersion
    , compilerName :: String
compilerName                = String
System.Info.compilerName
    , operatingSystem :: String
operatingSystem             = String
System.Info.os
    , machineArchitecture :: String
machineArchitecture         = String
System.Info.arch
    , gitRevison :: String
gitRevison                  = Text -> String
T.unpack Text
gitRev
    , ledgerApplicationMode :: String
ledgerApplicationMode       = case LedgerApplicationMode
lgrAppMode of
        LedgerApplicationMode
LedgerApply   -> String
"full-application"
        LedgerApplicationMode
LedgerReapply -> String
"reapplication"
    }