{-# 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 qualified Text.Builder as Builder
import           Text.Builder (Builder, decimal)

{-------------------------------------------------------------------------------
  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 :: Builder
csvSeparator :: Builder
csvSeparator = Builder
"\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 -> [(Builder, SlotDataPoint -> Builder)] -> IO ()
forall a. Handle -> Separator -> [(Builder, a)] -> IO ()
CSV.writeHeaderLine Handle
outFileHandle (Builder -> Separator
CSV.Separator Builder
csvSeparator) [(Builder, SlotDataPoint -> Builder)]
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
-> [(Builder, SlotDataPoint -> Builder)]
-> SlotDataPoint
-> IO ()
forall a b.
Handle -> Separator -> [(a, b -> Builder)] -> b -> IO ()
CSV.computeAndWriteLinePure
        Handle
outFileHandle (Builder -> Separator
CSV.Separator Builder
csvSeparator) [(Builder, SlotDataPoint -> Builder)]
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 :: [(Builder, SlotDataPoint -> Builder)]
dataPointCsvBuilder :: [(Builder, SlotDataPoint -> Builder)]
dataPointCsvBuilder =
    [ (Builder
"slot"                  , Word64 -> Builder
forall a. Integral a => a -> Builder
decimal (Word64 -> Builder)
-> (SlotDataPoint -> Word64) -> SlotDataPoint -> Builder
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)
    , (Builder
"slotGap"               , Word64 -> Builder
forall a. Integral a => a -> Builder
decimal (Word64 -> Builder)
-> (SlotDataPoint -> Word64) -> SlotDataPoint -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Word64
DP.slotGap)
    , (Builder
"totalTime"             , Int64 -> Builder
forall a. Integral a => a -> Builder
decimal (Int64 -> Builder)
-> (SlotDataPoint -> Int64) -> SlotDataPoint -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Int64
DP.totalTime)
    , (Builder
"mut"                   , Int64 -> Builder
forall a. Integral a => a -> Builder
decimal (Int64 -> Builder)
-> (SlotDataPoint -> Int64) -> SlotDataPoint -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Int64
DP.mut)
    , (Builder
"gc"                    , Int64 -> Builder
forall a. Integral a => a -> Builder
decimal (Int64 -> Builder)
-> (SlotDataPoint -> Int64) -> SlotDataPoint -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Int64
DP.gc)
    , (Builder
"majGcCount"            , Word32 -> Builder
forall a. Integral a => a -> Builder
decimal (Word32 -> Builder)
-> (SlotDataPoint -> Word32) -> SlotDataPoint -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Word32
DP.majGcCount)
    , (Builder
"minGcCount"            , Word32 -> Builder
forall a. Integral a => a -> Builder
decimal (Word32 -> Builder)
-> (SlotDataPoint -> Word32) -> SlotDataPoint -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Word32
DP.minGcCount)
    , (Builder
"allocatedBytes"        , Word64 -> Builder
forall a. Integral a => a -> Builder
decimal (Word64 -> Builder)
-> (SlotDataPoint -> Word64) -> SlotDataPoint -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Word64
DP.allocatedBytes)
    , (Builder
"mut_forecast"          , Int64 -> Builder
forall a. Integral a => a -> Builder
decimal (Int64 -> Builder)
-> (SlotDataPoint -> Int64) -> SlotDataPoint -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Int64
DP.mut_forecast)
    , (Builder
"mut_headerTick"        , Int64 -> Builder
forall a. Integral a => a -> Builder
decimal (Int64 -> Builder)
-> (SlotDataPoint -> Int64) -> SlotDataPoint -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Int64
DP.mut_headerTick)
    , (Builder
"mut_headerApply"       , Int64 -> Builder
forall a. Integral a => a -> Builder
decimal (Int64 -> Builder)
-> (SlotDataPoint -> Int64) -> SlotDataPoint -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Int64
DP.mut_headerApply)
    , (Builder
"mut_blockTick"         , Int64 -> Builder
forall a. Integral a => a -> Builder
decimal (Int64 -> Builder)
-> (SlotDataPoint -> Int64) -> SlotDataPoint -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Int64
DP.mut_blockTick)
    , (Builder
"mut_blockApply"        , Int64 -> Builder
forall a. Integral a => a -> Builder
decimal (Int64 -> Builder)
-> (SlotDataPoint -> Int64) -> SlotDataPoint -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Int64
DP.mut_blockApply)
    , (Builder
"blockBytes"            , Word32 -> Builder
forall a. Integral a => a -> Builder
decimal (Word32 -> Builder)
-> (SlotDataPoint -> Word32) -> SlotDataPoint -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> Word32
DP.blockByteSize)
    , (Builder
"...era-specific stats" , Builder -> [Builder] -> Builder
forall (foldable :: * -> *).
Foldable foldable =>
Builder -> foldable Builder -> Builder
Builder.intercalate Builder
csvSeparator ([Builder] -> Builder)
-> (SlotDataPoint -> [Builder]) -> SlotDataPoint -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockStats -> [Builder]
DP.unBlockStats (BlockStats -> [Builder])
-> (SlotDataPoint -> BlockStats) -> SlotDataPoint -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotDataPoint -> BlockStats
DP.blockStats)
    ]