{-# 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)