{-# LANGUAGE CPP #-} module Main where import Control.Monad (when, forM_) import Data.Maybe (isNothing) import System.FilePath (replaceExtension, takeFileName) import Text.Parsec.String (parseFromFile) #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif 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..] 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)