Analyze.hs

module Main where

import Control.Monad (when, forM_)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Maybe (isNothing)
import System.FilePath (replaceExtension, takeFileName)
import Text.Parsec.String (parseFromFile)

import GHC.RTS.Events.Analyze.Analysis
import GHC.RTS.Events.Analyze.Options
import GHC.RTS.Events.Analyze.Reports.Timed     qualified as Timed
import GHC.RTS.Events.Analyze.Reports.Timed.SVG qualified as TimedSVG
import GHC.RTS.Events.Analyze.Reports.Totals    qualified as Totals
import GHC.RTS.Events.Analyze.Script
import GHC.RTS.Events.Analyze.Script.Standard

main :: IO ()
main = do
    options@Options{..} <- parseOptions
    analyses            <- analyze options <$> readEventLog optionsInput

    (timedScriptName,  timedScript)  <- getScript optionsScriptTimed  defaultScriptTimed
    (totalsScriptName, totalsScript) <- getScript optionsScriptTotals defaultScriptTotals

    let writeReport :: Bool
                    -> String
                    -> String
                    -> (FilePath -> IO ())
                    -> IO ()
        writeReport isEnabled
                    scriptName
                    newExt
                    mkReport = when isEnabled $ do
          let output = replaceExtension (takeFileName optionsInput) newExt
          mkReport output
          putStrLn $ "Generated " ++ output ++ " using " ++ scriptName

        prefixAnalysisNumber :: Int -> String -> String
        prefixAnalysisNumber i filename
          | isNothing optionsWindowEvent = filename
          | otherwise                    = show i ++ "." ++ filename

    forM_ (zip [0..] (NonEmpty.toList analyses)) $ \ (i,analysis) -> do

      let quantized = quantize optionsNumBuckets analysis
          totals    = Totals.createReport analysis totalsScript
          timed     = Timed.createReport analysis quantized timedScript

      writeReport optionsGenerateTotalsText
                  totalsScriptName
                  (prefixAnalysisNumber i "totals.txt")
                  (Totals.writeReport totals)

      writeReport optionsGenerateTimedSVG
                  timedScriptName
                  (prefixAnalysisNumber i "timed.svg")
                  (TimedSVG.writeReport options quantized timed)

      writeReport optionsGenerateTimedText
                  timedScriptName
                  (prefixAnalysisNumber i "timed.txt")
                  (Timed.writeReport timed)

getScript :: FilePath -> Script String -> IO (String, Script String)
getScript ""   def = return ("default script", def)
getScript path _   = do
  mScript <- parseFromFile pScript path
  case mScript of
    Left  err    -> fail (show err)
    Right script -> return (path, script)