{-# LANGUAGE OverloadedStrings #-}

module Cardano.Tools.DBAnalyser.Analysis.BenchmarkLedgerOps.FileWriting
  ( -- * Output format
    OutputFormat
  , getOutputFormat

    -- * File writing functions
  , writeDataPoint
  , writeHeader
  , writeMetadata
  ) where

import Cardano.Slotting.Slot (SlotNo (unSlotNo))
import qualified Cardano.Tools.DBAnalyser.Analysis.BenchmarkLedgerOps.Metadata as BenchmarkLedgerOps.Metadata
import Cardano.Tools.DBAnalyser.Analysis.BenchmarkLedgerOps.SlotDataPoint
  ( SlotDataPoint
  )
import qualified Cardano.Tools.DBAnalyser.Analysis.BenchmarkLedgerOps.SlotDataPoint as DP
import qualified Cardano.Tools.DBAnalyser.CSV as CSV
import Cardano.Tools.DBAnalyser.Types (LedgerApplicationMode)
import Data.Aeson as Aeson
import qualified Data.ByteString.Lazy as BSL
import System.FilePath.Posix (takeExtension)
import qualified System.IO as IO
import TextBuilder (TextBuilder, decimal)
import qualified TextBuilder as Builder

{-------------------------------------------------------------------------------
  Output format
-------------------------------------------------------------------------------}

data OutputFormat = CSV | JSON
  deriving (Int -> OutputFormat -> ShowS
[OutputFormat] -> ShowS
OutputFormat -> String
(Int -> OutputFormat -> ShowS)
-> (OutputFormat -> String)
-> ([OutputFormat] -> ShowS)
-> Show OutputFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutputFormat -> ShowS
showsPrec :: Int -> OutputFormat -> ShowS
$cshow :: OutputFormat -> String
show :: OutputFormat -> String
$cshowList :: [OutputFormat] -> ShowS
showList :: [OutputFormat] -> ShowS
Show, OutputFormat -> OutputFormat -> Bool
(OutputFormat -> OutputFormat -> Bool)
-> (OutputFormat -> OutputFormat -> Bool) -> Eq OutputFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutputFormat -> OutputFormat -> Bool
== :: OutputFormat -> OutputFormat -> Bool
$c/= :: OutputFormat -> OutputFormat -> Bool
/= :: OutputFormat -> OutputFormat -> Bool
Eq)

-- | Use the provided 'Maybe FilePath' to determine the output format.
--
-- The output format is based on the extension (see 'OutputFormat').
--
-- If the extension is not supported the output format defaults to
-- CSV, and this function prints a warning informing the user of this
-- choice.
getOutputFormat :: Maybe FilePath -> IO OutputFormat
getOutputFormat :: Maybe String -> IO OutputFormat
getOutputFormat (Just String
filePath) =
  case ShowS
takeExtension String
filePath of
    String
".csv" -> OutputFormat -> IO OutputFormat
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OutputFormat
CSV
    String
".json" -> OutputFormat -> IO OutputFormat
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OutputFormat
JSON
    String
ext -> do
      Handle -> String -> IO ()
IO.hPutStr Handle
IO.stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Unsupported extension '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
ext String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'. Defaulting to CSV."
      OutputFormat -> IO OutputFormat
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OutputFormat
CSV
getOutputFormat Maybe String
Nothing = OutputFormat -> IO OutputFormat
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OutputFormat
CSV

{-------------------------------------------------------------------------------
  File writing functions
-------------------------------------------------------------------------------}

-- | Separator used for CSV output.
csvSeparator :: TextBuilder
csvSeparator :: TextBuilder
csvSeparator = TextBuilder
"\t"

-- | Write a header for the data points.
--
-- This is only needed for the CSV output format.
--
-- The position of each header matches the position in which the corresponding
-- field value is written in 'writeDatapoint'. Eg, if 'writeHeader' writes:
--
-- > "slot slotGap totalTime" ...
--
-- then the third value written by 'writeDataPoint' will correspond to 'totalTime'.
writeHeader :: IO.Handle -> OutputFormat -> IO ()
writeHeader :: Handle -> OutputFormat -> IO ()
writeHeader Handle
outFileHandle OutputFormat
CSV =
  Handle
-> Separator
-> [(TextBuilder, SlotDataPoint -> TextBuilder)]
-> IO ()
forall a. Handle -> Separator -> [(TextBuilder, a)] -> IO ()
CSV.writeHeaderLine Handle
outFileHandle (TextBuilder -> Separator
CSV.Separator TextBuilder
csvSeparator) [(TextBuilder, SlotDataPoint -> TextBuilder)]
dataPointCsvBuilder
writeHeader Handle
_ OutputFormat
JSON = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | NOTE: This function is not thread safe.
writeDataPoint ::
  IO.Handle ->
  OutputFormat ->
  SlotDataPoint ->
  IO ()
writeDataPoint :: Handle -> OutputFormat -> SlotDataPoint -> IO ()
writeDataPoint Handle
outFileHandle OutputFormat
CSV SlotDataPoint
slotDataPoint =
  Handle
-> Separator
-> [(TextBuilder, SlotDataPoint -> TextBuilder)]
-> SlotDataPoint
-> IO ()
forall a b.
Handle -> Separator -> [(a, b -> TextBuilder)] -> b -> IO ()
CSV.computeAndWriteLinePure
    Handle
outFileHandle
    (TextBuilder -> Separator
CSV.Separator TextBuilder
csvSeparator)
    [(TextBuilder, SlotDataPoint -> TextBuilder)]
dataPointCsvBuilder
    SlotDataPoint
slotDataPoint
writeDataPoint Handle
outFileHandle OutputFormat
JSON SlotDataPoint
slotDataPoint =
  Handle -> ByteString -> IO ()
BSL.hPut Handle
outFileHandle (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ SlotDataPoint -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode SlotDataPoint
slotDataPoint

-- | Write metadata to a JSON file if this is the selected
-- format. Perform a no-op otherwise.
writeMetadata :: IO.Handle -> OutputFormat -> LedgerApplicationMode -> IO ()
writeMetadata :: Handle -> OutputFormat -> LedgerApplicationMode -> IO ()
writeMetadata Handle
_outFileHandle OutputFormat
CSV LedgerApplicationMode
_lgrAppMode = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
writeMetadata Handle
outFileHandle OutputFormat
JSON LedgerApplicationMode
lgrAppMode =
  LedgerApplicationMode -> IO Metadata
BenchmarkLedgerOps.Metadata.getMetadata LedgerApplicationMode
lgrAppMode
    IO Metadata -> (Metadata -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> ByteString -> IO ()
BSL.hPut Handle
outFileHandle (ByteString -> IO ())
-> (Metadata -> ByteString) -> Metadata -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode

{-------------------------------------------------------------------------------
  Operations to assist CSV printing
-------------------------------------------------------------------------------}

dataPointCsvBuilder :: [(TextBuilder, SlotDataPoint -> TextBuilder)]
dataPointCsvBuilder :: [(TextBuilder, SlotDataPoint -> TextBuilder)]
dataPointCsvBuilder =
  [ (TextBuilder
"slot", Word64 -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal (Word64 -> TextBuilder)
-> (SlotDataPoint -> Word64) -> SlotDataPoint -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotNo -> Word64
unSlotNo (SlotNo -> Word64)
-> (SlotDataPoint -> SlotNo) -> SlotDataPoint -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> SlotNo
DP.slot)
  , (TextBuilder
"slotGap", Word64 -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal (Word64 -> TextBuilder)
-> (SlotDataPoint -> Word64) -> SlotDataPoint -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Word64
DP.slotGap)
  , (TextBuilder
"totalTime", Int64 -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal (Int64 -> TextBuilder)
-> (SlotDataPoint -> Int64) -> SlotDataPoint -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Int64
DP.totalTime)
  , (TextBuilder
"mut", Int64 -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal (Int64 -> TextBuilder)
-> (SlotDataPoint -> Int64) -> SlotDataPoint -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Int64
DP.mut)
  , (TextBuilder
"gc", Int64 -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal (Int64 -> TextBuilder)
-> (SlotDataPoint -> Int64) -> SlotDataPoint -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Int64
DP.gc)
  , (TextBuilder
"majGcCount", Word32 -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal (Word32 -> TextBuilder)
-> (SlotDataPoint -> Word32) -> SlotDataPoint -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Word32
DP.majGcCount)
  , (TextBuilder
"minGcCount", Word32 -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal (Word32 -> TextBuilder)
-> (SlotDataPoint -> Word32) -> SlotDataPoint -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Word32
DP.minGcCount)
  , (TextBuilder
"allocatedBytes", Word64 -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal (Word64 -> TextBuilder)
-> (SlotDataPoint -> Word64) -> SlotDataPoint -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Word64
DP.allocatedBytes)
  , (TextBuilder
"mut_forecast", Int64 -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal (Int64 -> TextBuilder)
-> (SlotDataPoint -> Int64) -> SlotDataPoint -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Int64
DP.mut_forecast)
  , (TextBuilder
"mut_headerTick", Int64 -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal (Int64 -> TextBuilder)
-> (SlotDataPoint -> Int64) -> SlotDataPoint -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Int64
DP.mut_headerTick)
  , (TextBuilder
"mut_headerApply", Int64 -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal (Int64 -> TextBuilder)
-> (SlotDataPoint -> Int64) -> SlotDataPoint -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Int64
DP.mut_headerApply)
  , (TextBuilder
"mut_blockTick", Int64 -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal (Int64 -> TextBuilder)
-> (SlotDataPoint -> Int64) -> SlotDataPoint -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Int64
DP.mut_blockTick)
  , (TextBuilder
"mut_blockApply", Int64 -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal (Int64 -> TextBuilder)
-> (SlotDataPoint -> Int64) -> SlotDataPoint -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Int64
DP.mut_blockApply)
  , (TextBuilder
"blockBytes", Word32 -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal (Word32 -> TextBuilder)
-> (SlotDataPoint -> Word32) -> SlotDataPoint -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Word32
DP.blockByteSize)
  , (TextBuilder
"...era-specific stats", TextBuilder -> [TextBuilder] -> TextBuilder
forall (f :: * -> *).
Foldable f =>
TextBuilder -> f TextBuilder -> TextBuilder
Builder.intercalate TextBuilder
csvSeparator ([TextBuilder] -> TextBuilder)
-> (SlotDataPoint -> [TextBuilder]) -> SlotDataPoint -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockStats -> [TextBuilder]
DP.unBlockStats (BlockStats -> [TextBuilder])
-> (SlotDataPoint -> BlockStats) -> SlotDataPoint -> [TextBuilder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> BlockStats
DP.blockStats)
  ]