{-# LANGUAGE DeriveGeneric #-}

module Cardano.Tools.DBAnalyser.Analysis.BenchmarkLedgerOps.SlotDataPoint (
    BlockStats (BlockStats, unBlockStats)
  , SlotDataPoint (..)
  ) where

import           Cardano.Slotting.Slot (SlotNo)
import           Data.Aeson as Aeson
import qualified Data.Aeson.Encoding as Aeson.Encoding
import           Data.Int (Int64)
import           Data.Word (Word32, Word64)
import           GHC.Generics (Generic)
import qualified Text.Builder as Builder
import           Text.Builder (Builder)

-- | Information about the time spent processing the block corresponding to
-- 'slot', divided into the five major operations:
--
--  0. Forecast.
--  1. Header tick.
--  2. Header application.
--  3. Block tick.
--  4. Block application.
--
-- It is up to the user of a slot data point to decide which units the data
-- represent (eg milliseconds, nanoseconds, etc)
data SlotDataPoint =
    SlotDataPoint
      { -- | Slot in which the 5 ledger operations were applied.
        SlotDataPoint -> SlotNo
slot            :: !SlotNo
        -- | Gap to the previous slot.
      , SlotDataPoint -> Word64
slotGap         :: !Word64
        -- | Total time spent in the 5 ledger operations at 'slot'.
      , SlotDataPoint -> Int64
totalTime       :: !Int64
        -- | Time spent by the mutator while performing the 5 ledger operations
        -- at 'slot'.
      , SlotDataPoint -> Int64
mut             :: !Int64
        -- | Time spent in garbage collection while performing the 5 ledger
        -- operations at 'slot'.
      , SlotDataPoint -> Int64
gc              :: !Int64
        -- | Total number of __major__ garbage collections that took place while
        -- performing the 5 ledger operations at 'slot'.
      , SlotDataPoint -> Word32
majGcCount      :: !Word32
        -- | Total number of __minor__ garbage collections that took place while
        -- performing the 5 ledger operations at 'slot'.
      , SlotDataPoint -> Word32
minGcCount      :: !Word32
        -- | Allocated bytes while performing the 5 ledger operations
        -- at 'slot'.
      , SlotDataPoint -> Word64
allocatedBytes  :: !Word64
        -- | Difference of the GC.mutator_elapsed_ns field when computing the
        -- forecast.
      , SlotDataPoint -> Int64
mut_forecast    :: !Int64
      , SlotDataPoint -> Int64
mut_headerTick  :: !Int64
      , SlotDataPoint -> Int64
mut_headerApply :: !Int64
      , SlotDataPoint -> Int64
mut_blockTick   :: !Int64
      , SlotDataPoint -> Int64
mut_blockApply  :: !Int64
      , SlotDataPoint -> Word32
blockByteSize   :: !Word32
      -- | Free-form information about the block.
      , SlotDataPoint -> BlockStats
blockStats      :: !BlockStats
      } deriving ((forall x. SlotDataPoint -> Rep SlotDataPoint x)
-> (forall x. Rep SlotDataPoint x -> SlotDataPoint)
-> Generic SlotDataPoint
forall x. Rep SlotDataPoint x -> SlotDataPoint
forall x. SlotDataPoint -> Rep SlotDataPoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SlotDataPoint -> Rep SlotDataPoint x
from :: forall x. SlotDataPoint -> Rep SlotDataPoint x
$cto :: forall x. Rep SlotDataPoint x -> SlotDataPoint
to :: forall x. Rep SlotDataPoint x -> SlotDataPoint
Generic, Int -> SlotDataPoint -> ShowS
[SlotDataPoint] -> ShowS
SlotDataPoint -> String
(Int -> SlotDataPoint -> ShowS)
-> (SlotDataPoint -> String)
-> ([SlotDataPoint] -> ShowS)
-> Show SlotDataPoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SlotDataPoint -> ShowS
showsPrec :: Int -> SlotDataPoint -> ShowS
$cshow :: SlotDataPoint -> String
show :: SlotDataPoint -> String
$cshowList :: [SlotDataPoint] -> ShowS
showList :: [SlotDataPoint] -> ShowS
Show)

newtype BlockStats = BlockStats { BlockStats -> [Builder]
unBlockStats :: [Builder] }
  deriving ((forall x. BlockStats -> Rep BlockStats x)
-> (forall x. Rep BlockStats x -> BlockStats) -> Generic BlockStats
forall x. Rep BlockStats x -> BlockStats
forall x. BlockStats -> Rep BlockStats x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BlockStats -> Rep BlockStats x
from :: forall x. BlockStats -> Rep BlockStats x
$cto :: forall x. Rep BlockStats x -> BlockStats
to :: forall x. Rep BlockStats x -> BlockStats
Generic, Int -> BlockStats -> ShowS
[BlockStats] -> ShowS
BlockStats -> String
(Int -> BlockStats -> ShowS)
-> (BlockStats -> String)
-> ([BlockStats] -> ShowS)
-> Show BlockStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockStats -> ShowS
showsPrec :: Int -> BlockStats -> ShowS
$cshow :: BlockStats -> String
show :: BlockStats -> String
$cshowList :: [BlockStats] -> ShowS
showList :: [BlockStats] -> ShowS
Show)

instance ToJSON BlockStats where
  -- We convert the blocks stats to a 'Vector Text'.
  toJSON :: BlockStats -> Value
toJSON = [Text] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Text] -> Value) -> (BlockStats -> [Text]) -> BlockStats -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> Text) -> [Builder] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Builder -> Text
Builder.run ([Builder] -> [Text])
-> (BlockStats -> [Builder]) -> BlockStats -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockStats -> [Builder]
unBlockStats

  toEncoding :: BlockStats -> Encoding
toEncoding = (Builder -> Encoding) -> [Builder] -> Encoding
forall a. (a -> Encoding) -> [a] -> Encoding
Aeson.Encoding.list (Text -> Encoding
forall a. Text -> Encoding' a
Aeson.Encoding.text (Text -> Encoding) -> (Builder -> Text) -> Builder -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Builder.run) ([Builder] -> Encoding)
-> (BlockStats -> [Builder]) -> BlockStats -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockStats -> [Builder]
unBlockStats

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