@@ -1,77 +0,0 @@
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− ]