Analyze.hs

{-# LANGUAGE CPP #-}
module Main where

import Control.Monad (when, forM_)
import qualified Data.List.NonEmpty 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 qualified GHC.RTS.Events.Analyze.Reports.Totals    as Totals
import qualified GHC.RTS.Events.Analyze.Reports.Timed     as Timed
import qualified GHC.RTS.Events.Analyze.Reports.Timed.SVG as TimedSVG
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)