{-# LANGUAGE OverloadedStrings #-}
module Eventlog.HtmlTemplate where

import Data.Aeson (Value, encode)
import Data.Aeson.Text (encodeToLazyText)
import Data.String
import Data.Text (Text, append)
import qualified Data.Text as T
import qualified Data.Text.Lazy.Encoding as T
import qualified Data.Text.Lazy as TL
--import Text.Blaze.Html
import Text.Blaze.Html5            as H
import Text.Blaze.Html5.Attributes as A
import Text.Blaze.Html.Renderer.String

import Eventlog.Javascript
import Eventlog.Args
import Eventlog.Types (Header(..), HeapProfBreakdown(..))
import Eventlog.VegaTemplate
import Eventlog.AssetVersions
import Paths_eventlog2html
import Data.Version
import Control.Monad
import Data.Maybe

type VizID = Int

insertJsonData :: Value -> Html
insertJsonData :: Value -> Html
insertJsonData Value
dat = forall a. ToMarkup a => a -> Html
preEscapedToHtml forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [
    Text
"data_json= " Text -> Text -> Text
`append` Text
dat' Text -> Text -> Text
`append` Text
";"
  , Text
"console.log(data_json);" ]
  where
    dat' :: Text
dat' = Text -> Text
TL.toStrict (ByteString -> Text
T.decodeUtf8 (forall a. ToJSON a => a -> ByteString
encode Value
dat))

insertJsonDesc :: Value -> Html
insertJsonDesc :: Value -> Html
insertJsonDesc Value
dat = forall a. ToMarkup a => a -> Html
preEscapedToHtml forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [
    Text
"desc_json= " Text -> Text -> Text
`append` Text
dat' Text -> Text -> Text
`append` Text
";"
  , Text
"console.log(desc_json);" ]
  where
    dat' :: Text
dat' = Text -> Text
TL.toStrict (ByteString -> Text
T.decodeUtf8 (forall a. ToJSON a => a -> ByteString
encode Value
dat))

-- Dynamically bound in ccs tree
insertColourScheme :: Text -> Html
insertColourScheme :: Text -> Html
insertColourScheme Text
scheme = forall a. ToMarkup a => a -> Html
preEscapedToHtml forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [
    Text
"colour_scheme= \"" Text -> Text -> Text
`append` Text
scheme Text -> Text -> Text
`append` Text
"\";"
  , Text
"console.log(colour_scheme);" ]


data_sets :: [Text] -> [Text]
data_sets :: [Text] -> [Text]
data_sets [Text]
itd = forall a b. (a -> b) -> [a] -> [b]
Prelude.map forall {a}. (Semigroup a, IsString a) => a -> a
line [Text]
itd
 where
  line :: a -> a
line a
t = a
"res.view.insert(\"data_json_" forall a. Semigroup a => a -> a -> a
<> a
t forall a. Semigroup a => a -> a -> a
<>a
"\", data_json."forall a. Semigroup a => a -> a -> a
<> a
t forall a. Semigroup a => a -> a -> a
<>a
");"

data IncludeTraceData = TraceData | NoTraceData

encloseScript :: [Text] -> VizID -> Text -> Html
encloseScript :: [Text] -> Int -> Text -> Html
encloseScript = [Text] -> Int -> Text -> Html
encloseScriptX

encloseRawVegaScript :: VizID -> Text -> Html
encloseRawVegaScript :: Int -> Text -> Html
encloseRawVegaScript = [Text] -> Int -> Text -> Html
encloseScriptX []

encloseScriptX :: [Text] -> VizID -> Text -> Html
encloseScriptX :: [Text] -> Int -> Text -> Html
encloseScriptX [Text]
insert_data_sets Int
vid Text
vegaspec = forall a. ToMarkup a => a -> Html
preEscapedToHtml forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([
  Text
"var yourVlSpec" Text -> Text -> Text
`append` Text
vidt Text -> Text -> Text
`append`Text
"= " Text -> Text -> Text
`append` Text
vegaspec  Text -> Text -> Text
`append` Text
";"
  , Text
"vegaEmbed('#vis" Text -> Text -> Text
`append` Text
vidt Text -> Text -> Text
`append` Text
"', yourVlSpec" Text -> Text -> Text
`append` Text
vidt Text -> Text -> Text
`append` Text
")"
  , Text
".then((res) => { " ]
-- For the 4 vega lite charts we dynamically insert the data after the
-- chart is created to avoid duplicating it. For the vega chart, this
-- causes a harmless error so we just don't do it.
  forall a. [a] -> [a] -> [a]
++ ([Text] -> [Text]
data_sets [Text]
insert_data_sets) forall a. [a] -> [a] -> [a]
++
  [ Text
"; res.view.resize()"
  , Text
"; res.view.runAsync()"
  , Text
"})" ])
  where
    vidt :: Text
vidt = [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Int
vid

jsScript :: String -> Html
jsScript :: [Char] -> Html
jsScript [Char]
url = Html -> Html
script forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
src (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char]
url) forall a b. (a -> b) -> a -> b
$ Html
""
css :: AttributeValue -> Html
css :: AttributeValue -> Html
css AttributeValue
url = Html
link forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
rel AttributeValue
"stylesheet" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href AttributeValue
url

htmlHeader :: Value -> Maybe Value -> Args -> Html
htmlHeader :: Value -> Maybe Value -> Args -> Html
htmlHeader Value
dat Maybe Value
desc Args
as =
    Html -> Html
H.head forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
H.title Html
"eventlog2html - Heap Profile"
    Html
meta forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
charset AttributeValue
"UTF-8"
    Html -> Html
script forall a b. (a -> b) -> a -> b
$ Value -> Html
insertJsonData Value
dat
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Html -> Html
script forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Html
insertJsonDesc) Maybe Value
desc
    Html -> Html
script forall a b. (a -> b) -> a -> b
$ Text -> Html
insertColourScheme (Args -> Text
userColourScheme Args
as)
    if Bool -> Bool
not (Args -> Bool
noIncludejs Args
as)
      then do
        Html -> Html
script forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
vegaLite
        Html -> Html
script forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
vega
        Html -> Html
script forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
vegaEmbed
        Html -> Html
script forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
jquery
        Html -> Html
H.style  forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
bootstrapCSS
        Html -> Html
script forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
bootstrap
        Html -> Html
script forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
fancytable
        Html -> Html
script forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
sparkline
      else do
        [Char] -> Html
jsScript [Char]
vegaURL
        [Char] -> Html
jsScript [Char]
vegaLiteURL
        [Char] -> Html
jsScript [Char]
vegaEmbedURL
        [Char] -> Html
jsScript [Char]
jqueryURL
        AttributeValue -> Html
css ([Char] -> AttributeValue
preEscapedStringValue [Char]
bootstrapCSSURL)
        [Char] -> Html
jsScript [Char]
bootstrapURL
        AttributeValue -> Html
css AttributeValue
"//fonts.googleapis.com/css?family=Roboto:300,300italic,700,700italic"
        [Char] -> Html
jsScript [Char]
fancyTableURL
        [Char] -> Html
jsScript [Char]
sparklinesURL
    -- Include this last to overwrite some milligram styling
    Html -> Html
H.style forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
stylesheet


template :: Header -> Value -> Maybe Value -> Maybe Html -> Args -> Html
template :: Header -> Value -> Maybe Value -> Maybe Html -> Args -> Html
template Header
header' Value
dat Maybe Value
cc_descs Maybe Html
closure_descs Args
as = Html -> Html
docTypeHtml forall a b. (a -> b) -> a -> b
$ do
  [Char] -> Html
H.stringComment forall a b. (a -> b) -> a -> b
$ [Char]
"Generated with eventlog2html-" forall a. Semigroup a => a -> a -> a
<> Version -> [Char]
showVersion Version
version
  Value -> Maybe Value -> Args -> Html
htmlHeader Value
dat Maybe Value
cc_descs Args
as
  Html -> Html
body forall a b. (a -> b) -> a -> b
$ Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"container" forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"row" forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"column" forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
h1 forall a b. (a -> b) -> a -> b
$ Html -> Html
a forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href AttributeValue
"https://mpickering.github.io/eventlog2html" forall a b. (a -> b) -> a -> b
$ Html
"eventlog2html"

    Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"row" forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"column" forall a b. (a -> b) -> a -> b
$ do
        Html
"Options: "
        Html -> Html
code forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ Header -> Text
hJob Header
header'

    Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"row" forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"column" forall a b. (a -> b) -> a -> b
$ do
        Html
"Created at: "
        Html -> Html
code forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ Header -> Text
hDate Header
header'

    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Header -> Maybe HeapProfBreakdown
hHeapProfileType Header
header') forall a b. (a -> b) -> a -> b
$ \HeapProfBreakdown
prof_type -> do
      Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"row" forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"column" forall a b. (a -> b) -> a -> b
$ do
          Html
"Type of profile: "
          Html -> Html
code forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ HeapProfBreakdown -> Text
ppHeapProfileType HeapProfBreakdown
prof_type

    Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"row" forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"column" forall a b. (a -> b) -> a -> b
$ do
        Html
"Sampling rate in seconds: "
        Html -> Html
code forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ Header -> Text
hSamplingRate Header
header'

    Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"row" forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"column" forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
button forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"tablink button-black" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
onclick AttributeValue
"changeTab('areachart', this)" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"defaultOpen" forall a b. (a -> b) -> a -> b
$ Html
"Area Chart"
        Html -> Html
button forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"tablink button-black" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
onclick AttributeValue
"changeTab('normalizedchart', this)" forall a b. (a -> b) -> a -> b
$ Html
"Normalized"
        Html -> Html
button forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"tablink button-black" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
onclick AttributeValue
"changeTab('streamgraph', this)" forall a b. (a -> b) -> a -> b
$ Html
"Streamgraph"
        Html -> Html
button forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"tablink button-black" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
onclick AttributeValue
"changeTab('linechart', this)" forall a b. (a -> b) -> a -> b
$ Html
"Linechart"
        Html -> Html
button forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"tablink button-black" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
onclick AttributeValue
"changeTab('heapchart', this)" forall a b. (a -> b) -> a -> b
$ Html
"Heap"
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe Value
cc_descs) forall a b. (a -> b) -> a -> b
$ do
          Html -> Html
button forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"tablink button-black" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
onclick AttributeValue
"changeTab('cost-centres', this)" forall a b. (a -> b) -> a -> b
$ Html
"Cost Centres"
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe Html
closure_descs) forall a b. (a -> b) -> a -> b
$ do
          Html -> Html
button forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"tablink button-black" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
onclick AttributeValue
"changeTab('closures', this)" forall a b. (a -> b) -> a -> b
$ Html
"Detailed"
    Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"row" forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"column" forall a b. (a -> b) -> a -> b
$ do
        let itd :: IncludeTraceData
itd = if (Args -> Bool
noTraces Args
as) then IncludeTraceData
NoTraceData else IncludeTraceData
TraceData
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
vid, AttributeValue
chartname, ChartType
conf) ->
                  Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
chartname forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"tabviz" forall a b. (a -> b) -> a -> b
$ do
                    IncludeTraceData -> ChartType -> Bool -> Int -> Text -> Html
renderChart IncludeTraceData
itd ChartType
conf Bool
True Int
vid
                      (Text -> Text
TL.toStrict (forall a. ToJSON a => a -> Text
encodeToLazyText (ChartConfig -> Value
vegaJson (Args -> ChartType -> ChartConfig
htmlConf Args
as ChartType
conf)))))
          [(Int
1, AttributeValue
"areachart",  AreaChartType -> ChartType
AreaChart AreaChartType
Stacked)
          ,(Int
2, AttributeValue
"normalizedchart", AreaChartType -> ChartType
AreaChart AreaChartType
Normalized)
          ,(Int
3, AttributeValue
"streamgraph", AreaChartType -> ChartType
AreaChart AreaChartType
StreamGraph)
          ,(Int
4, AttributeValue
"linechart", ChartType
LineChart)
          ,(Int
5, AttributeValue
"heapchart", ChartType
HeapChart) ]

        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe Value
cc_descs) forall a b. (a -> b) -> a -> b
$ do
          Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"cost-centres" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"tabviz" forall a b. (a -> b) -> a -> b
$ do
            IncludeTraceData -> ChartType -> Bool -> Int -> Text -> Html
renderChart IncludeTraceData
itd ChartType
LineChart Bool
False Int
6 Text
treevega
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Html
closure_descs forall a b. (a -> b) -> a -> b
$ \Html
v -> do
          Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"closures" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"tabviz" forall a b. (a -> b) -> a -> b
$ do
            Html
v
    Html -> Html
script forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
tablogic


select_data :: IncludeTraceData -> ChartType -> [Text]
select_data :: IncludeTraceData -> ChartType -> [Text]
select_data IncludeTraceData
itd ChartType
c =
  case ChartType
c of
    AreaChart {} -> [Text]
prof_data
    LineChart {} -> [Text]
prof_data
    HeapChart {} -> [Text
"heap"] forall a. [a] -> [a] -> [a]
++ [Text
"traces" | IncludeTraceData
TraceData <- [IncludeTraceData
itd]]
  where
    prof_data :: [Text]
prof_data =  [Text
"samples"] forall a. [a] -> [a] -> [a]
++ [Text
"traces" | IncludeTraceData
TraceData <- [IncludeTraceData
itd]]



htmlConf :: Args -> ChartType -> ChartConfig
htmlConf :: Args -> ChartType -> ChartConfig
htmlConf Args
as ChartType
ct = Double
-> Double
-> Bool
-> Text
-> Text
-> ChartType
-> Maybe Double
-> ChartConfig
ChartConfig Double
1200 Double
1000 (Bool -> Bool
not (Args -> Bool
noTraces Args
as)) (Args -> Text
userColourScheme Args
as) Text
"set1" ChartType
ct (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Args -> Maybe Int
fixedYAxis Args
as))

renderChart :: IncludeTraceData -> ChartType -> Bool -> VizID -> Text -> Html
renderChart :: IncludeTraceData -> ChartType -> Bool -> Int -> Text -> Html
renderChart IncludeTraceData
itd ChartType
ct Bool
vega_lite Int
vid Text
vegaSpec = do
    let fields :: [Text]
fields = IncludeTraceData -> ChartType -> [Text]
select_data IncludeTraceData
itd ChartType
ct
    Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ [Char]
"vis" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
vid) forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"chart" forall a b. (a -> b) -> a -> b
$ Html
""
    Html -> Html
script forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"text/javascript" forall a b. (a -> b) -> a -> b
$ do
      if Bool
vega_lite
        then [Text] -> Int -> Text -> Html
encloseScript [Text]
fields Int
vid Text
vegaSpec
        else Int -> Text -> Html
encloseRawVegaScript Int
vid Text
vegaSpec

renderChartWithJson :: IncludeTraceData -> ChartType -> Int -> Value -> Text -> Html
renderChartWithJson :: IncludeTraceData -> ChartType -> Int -> Value -> Text -> Html
renderChartWithJson IncludeTraceData
itd ChartType
ct Int
k Value
dat Text
vegaSpec = do
    Html -> Html
script forall a b. (a -> b) -> a -> b
$ Value -> Html
insertJsonData Value
dat
    IncludeTraceData -> ChartType -> Bool -> Int -> Text -> Html
renderChart IncludeTraceData
itd ChartType
ct Bool
True Int
k Text
vegaSpec


templateString :: Header -> Value -> Maybe Value -> Maybe Html -> Args -> String
templateString :: Header -> Value -> Maybe Value -> Maybe Html -> Args -> [Char]
templateString Header
header' Value
dat Maybe Value
cc_descs Maybe Html
closure_descs Args
as =
  Html -> [Char]
renderHtml forall a b. (a -> b) -> a -> b
$ Header -> Value -> Maybe Value -> Maybe Html -> Args -> Html
template Header
header' Value
dat Maybe Value
cc_descs Maybe Html
closure_descs Args
as

ppHeapProfileType :: HeapProfBreakdown -> Text
ppHeapProfileType :: HeapProfBreakdown -> Text
ppHeapProfileType (HeapProfBreakdown
HeapProfBreakdownCostCentre) = Text
"Cost centre profiling (implied by -hc)"
ppHeapProfileType (HeapProfBreakdown
HeapProfBreakdownModule) = Text
"Profiling by module (implied by -hm)"
ppHeapProfileType (HeapProfBreakdown
HeapProfBreakdownClosureDescr) = Text
"Profiling by closure description (implied by -hd)"
ppHeapProfileType (HeapProfBreakdown
HeapProfBreakdownTypeDescr) = Text
"Profiling by type (implied by -hy)"
ppHeapProfileType (HeapProfBreakdown
HeapProfBreakdownRetainer) = Text
"Retainer profiling (implied by -hr)"
ppHeapProfileType (HeapProfBreakdown
HeapProfBreakdownBiography) = Text
"Biographical profiling (implied by -hb)"
ppHeapProfileType (HeapProfBreakdown
HeapProfBreakdownClosureType) = Text
"Basic heap profile (implied by -hT)"
ppHeapProfileType (HeapProfBreakdown
HeapProfBreakdownInfoTable) = Text
"Info table profile (implied by -hi)"