@@ -0,0 +1,77 @@
1+{-# LANGUAGE OverloadedStrings #-}
4+import qualified Data.Attoparsec.Text as Atto
5+import qualified Data.IntMap as IntMap
6+import qualified Data.Text as Text
7+import qualified Data.Text.IO as Text
8+import qualified GHC.RTS.TimeAllocProfile as Prof
9+import qualified GHC.RTS.TimeAllocProfile.Types as Prof
10+import qualified Text.Tabular as Table
11+import qualified Text.Tabular.AsciiArt as Table
17+ profToTable "elm-make.prof"
20+profToTable :: FilePath -> IO ()
21+profToTable filePath =
22+ do text <- Text.readFile filePath
23+ case Atto.parseOnly Prof.timeAllocProfile text of
25+ putStrLn $ "Error parsing " ++ filePath ++ ": " ++ err
28+ printTable (extractCostCentres profile)
32+-- FILTER NAMED COST CENTRES
35+extractCostCentres :: Prof.TimeAllocProfile -> [Prof.CostCentre]
36+extractCostCentres profile =
39+ IntMap.elems (Prof.costCentreNodes (Prof.profileCostCentreTree profile))
41+ filter (Text.isPrefixOf "elm_" . Prof.costCentreName) nodes
48+printTable :: [Prof.CostCentre] -> IO ()
49+printTable costCentres =
52+ Table.Group Table.NoLine $
53+ map (Table.Header . Text.unpack . Prof.costCentreName) costCentres
56+ Table.Table rowHeaders colHeaders (map toRow costCentres)
58+ putStrLn (Table.render id id id table)
61+colHeaders :: Table.Header String
63+ Table.Group Table.NoLine
64+ [ Table.Header " total time"
65+ , Table.Header " local time"
66+ , Table.Header " total alloc"
67+ , Table.Header " local alloc"
71+toRow :: Prof.CostCentre -> [String]
73+ [ show $ Prof.costCentreInhTime costCentre
74+ , show $ Prof.costCentreIndTime costCentre
75+ , show $ Prof.costCentreInhAlloc costCentre
76+ , show $ Prof.costCentreIndAlloc costCentre