@@ -0,0 +1,77 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Main where
3+
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
12+
13+
14+
15+main :: IO ()
16+main =
17+ profToTable "elm-make.prof"
18+
19+
20+profToTable :: FilePath -> IO ()
21+profToTable filePath =
22+ do text <- Text.readFile filePath
23+ case Atto.parseOnly Prof.timeAllocProfile text of
24+ Left err ->
25+ putStrLn $ "Error parsing " ++ filePath ++ ": " ++ err
26+
27+ Right profile ->
28+ printTable (extractCostCentres profile)
29+
30+
31+
32+-- FILTER NAMED COST CENTRES
33+
34+
35+extractCostCentres :: Prof.TimeAllocProfile -> [Prof.CostCentre]
36+extractCostCentres profile =
37+ let
38+ nodes =
39+ IntMap.elems (Prof.costCentreNodes (Prof.profileCostCentreTree profile))
40+ in
41+ filter (Text.isPrefixOf "elm_" . Prof.costCentreName) nodes
42+
43+
44+
45+-- CREATE A TABLE
46+
47+
48+printTable :: [Prof.CostCentre] -> IO ()
49+printTable costCentres =
50+ let
51+ rowHeaders =
52+ Table.Group Table.NoLine $
53+ map (Table.Header . Text.unpack . Prof.costCentreName) costCentres
54+
55+ table =
56+ Table.Table rowHeaders colHeaders (map toRow costCentres)
57+ in
58+ putStrLn (Table.render id id id table)
59+
60+
61+colHeaders :: Table.Header String
62+colHeaders =
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"
68+ ]
69+
70+
71+toRow :: Prof.CostCentre -> [String]
72+toRow costCentre =
73+ [ show $ Prof.costCentreInhTime costCentre
74+ , show $ Prof.costCentreIndTime costCentre
75+ , show $ Prof.costCentreInhAlloc costCentre
76+ , show $ Prof.costCentreIndAlloc costCentre
77+ ]