Analyze.hs

module Main where

import Control.Applicative ((<$>))
import Control.Monad (when, forM_)
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
          | null optionsWindowEvent = filename
          | otherwise               = show i ++ "." ++ filename

    forM_ (zip [0..] 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 -> IO (String, Script)
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)