{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
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.Encoding as T
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Text.Lazy as TL
import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
import Text.Blaze.Html.Renderer.String
import Data.FileEmbed
import Eventlog.Data
import Eventlog.Javascript
import Eventlog.Args
import Eventlog.Types (Header(..), HeapProfBreakdown(..))
import Eventlog.Rendering.Bootstrap
import Eventlog.Rendering.Types
import Eventlog.VegaTemplate
import Eventlog.AssetVersions
import Eventlog.Ticky (tickyTab)
import Paths_eventlog2html
import Data.Version
import Control.Monad
import Data.Maybe
insertJsonData :: Value -> Html
insertJsonData :: Value -> Html
insertJsonData Value
dat = Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml (Text -> Html) -> Text -> Html
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
TL.decodeUtf8 (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
dat))
insertJsonDesc :: Value -> Html
insertJsonDesc :: Value -> Html
insertJsonDesc Value
dat = Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml (Text -> Html) -> Text -> Html
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
TL.decodeUtf8 (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
dat))
insertColourScheme :: Text -> Html
insertColourScheme :: Text -> Html
insertColourScheme Text
scheme = Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml (Text -> Html) -> Text -> Html
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 = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
line [Text]
itd
where
line :: a -> a
line a
t = a
"res.view.insert(\"data_json_" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
t a -> a -> a
forall a. Semigroup a => a -> a -> a
<>a
"\", data_json."a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
t a -> a -> a
forall a. Semigroup a => a -> a -> a
<>a
");"
encloseScript :: [Text] -> TabID -> Text -> Html
encloseScript :: [Text] -> TabID -> Text -> Html
encloseScript = [Text] -> TabID -> Text -> Html
encloseScriptX
encloseRawVegaScript :: TabID -> Text -> Html
encloseRawVegaScript :: TabID -> Text -> Html
encloseRawVegaScript = [Text] -> TabID -> Text -> Html
encloseScriptX []
encloseScriptX :: [Text] -> TabID -> Text -> Html
encloseScriptX :: [Text] -> TabID -> Text -> Html
encloseScriptX [Text]
insert_data_sets (TabID Text
vidt) Text
vegaspec = Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml (Text -> Html) -> Text -> Html
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) => { " ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ ([Text] -> [Text]
data_sets [Text]
insert_data_sets) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
[ Text
"; res.view.resize()"
, Text
"; res.view.runAsync()"
, Text
"})" ])
jsScript :: String -> Html
jsScript :: String -> Html
jsScript String
url = Html -> Html
script (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
src (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue) -> String -> AttributeValue
forall a b. (a -> b) -> a -> b
$ String
url) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
""
css :: AttributeValue -> Html
css :: AttributeValue -> Html
css AttributeValue
url = Html
link Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
rel AttributeValue
"stylesheet" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href AttributeValue
url
htmlHeader :: Maybe HeapProfileData -> Maybe TickyProfileData -> Args -> Html
Maybe HeapProfileData
mb_hpd Maybe TickyProfileData
mb_ticky Args
as =
Html -> Html
H.head (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.title Html
"eventlog2html - Heap Profile"
Html
meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
charset AttributeValue
"UTF-8"
Maybe HeapProfileData -> (HeapProfileData -> Html) -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe HeapProfileData
mb_hpd ((HeapProfileData -> Html) -> Html)
-> (HeapProfileData -> Html) -> Html
forall a b. (a -> b) -> a -> b
$ \ (HeapProfileData Value
dat Maybe Value
desc Maybe Html
_) -> do
Html -> Html
script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Value -> Html
insertJsonData Value
dat
Html -> (Value -> Html) -> Maybe Value -> Html
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Html
forall a. a -> MarkupM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Html -> Html
script (Html -> Html) -> (Value -> Html) -> Value -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Html
insertJsonDesc) Maybe Value
desc
Html -> Html
script (Html -> Html) -> Html -> Html
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 (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
popper
Html -> Html
script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
vegaLite
Html -> Html
script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
vega
Html -> Html
script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
vegaEmbed
Html -> Html
script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
jquery
Html -> Html
H.style (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
bootstrapCSS
Html -> Html
script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
bootstrap
Html -> Html
script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
fancytable
Html -> Html
script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
sparkline
Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
has_ticky (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.style (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
datatablesCSS
Html -> Html
H.style (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
datatablesButtonsCSS
Html -> Html
script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
datatables
Html -> Html
script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
datatablesButtons
Html -> Html
script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
datatablesHtml5
Html -> Html
H.style (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
imagesCSS
else do
String -> Html
jsScript String
popperURL
String -> Html
jsScript String
vegaURL
String -> Html
jsScript String
vegaLiteURL
String -> Html
jsScript String
vegaEmbedURL
String -> Html
jsScript String
jqueryURL
AttributeValue -> Html
css (String -> AttributeValue
preEscapedStringValue String
bootstrapCSSURL)
String -> Html
jsScript String
bootstrapURL
String -> Html
jsScript String
fancyTableURL
String -> Html
jsScript String
sparklinesURL
Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
has_ticky (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
AttributeValue -> Html
css (String -> AttributeValue
preEscapedStringValue String
datatablesCSSURL)
AttributeValue -> Html
css (String -> AttributeValue
preEscapedStringValue String
datatablesButtonsCSSURL)
String -> Html
jsScript String
datatablesURL
String -> Html
jsScript String
datatablesButtonsURL
String -> Html
jsScript String
datatablesButtonsHTML5URL
Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
has_ticky (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
Html -> Html
script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
datatablesEllipsis
Html -> Html
H.style (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
stylesheet
where
has_ticky :: Bool
has_ticky = Maybe TickyProfileData -> Bool
forall a. Maybe a -> Bool
isJust Maybe TickyProfileData
mb_ticky
template :: EventlogType
-> Args
-> [TabGroup]
-> Html
template :: EventlogType -> Args -> [TabGroup] -> Html
template (EventlogType Header
header' Maybe HeapProfileData
x Maybe TickyProfileData
y) Args
as [TabGroup]
tab_groups = Html -> Html
docTypeHtml (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
String -> Html
H.stringComment (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ String
"Generated with eventlog2html-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Version -> String
showVersion Version
version
Maybe HeapProfileData -> Maybe TickyProfileData -> Args -> Html
htmlHeader Maybe HeapProfileData
x Maybe TickyProfileData
y Args
as
Html -> Html
body (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"container-fluid" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [TabGroup] -> Html
navbar [TabGroup]
tab_groups
Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"col tab-content custom-tab" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
[TabGroup] -> (TabGroup -> Html) -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TabGroup]
tab_groups ((TabGroup -> Html) -> Html) -> (TabGroup -> Html) -> Html
forall a b. (a -> b) -> a -> b
$ \TabGroup
group -> do
case TabGroup
group of
SingleTab Tab
tab -> Header -> Tab -> Html
renderTab Header
header' Tab
tab
ManyTabs String
_ [Tab]
tabs -> (Tab -> Html) -> [Tab] -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Header -> Tab -> Html
renderTab Header
header') [Tab]
tabs
Html -> Html
script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
tablogic
renderTab :: Header -> Tab -> Html
renderTab :: Header -> Tab -> Html
renderTab Header
header' Tab
tab =
Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (TabID -> Text
tabIDToTabID (Tab -> TabID
tabId Tab
tab))) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ (AttributeValue
"tab-pane tabviz " AttributeValue -> AttributeValue -> AttributeValue
forall a. Semigroup a => a -> a -> a
<> AttributeValue
status) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Maybe Html -> (Html -> Html) -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Tab -> Maybe Html
tabContent Tab
tab) ((Html -> Html) -> Html) -> (Html -> Html) -> Html
forall a b. (a -> b) -> a -> b
$ \Html
stuff -> Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"col" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html
stuff
Header -> Html
perTabFooter Header
header'
Maybe Html -> (Html -> Html) -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Tab -> Maybe Html
tabDocs Tab
tab) ((Html -> Html) -> Html) -> (Html -> Html) -> Html
forall a b. (a -> b) -> a -> b
$ \Html
docs -> Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"col" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
docs
where
status :: AttributeValue
status = if Tab -> Bool
tabActive Tab
tab then AttributeValue
"show active" else AttributeValue
""
perTabFooter :: Header -> Html
Header
header' = do
Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"col" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
-> (HeapProfBreakdown -> Text) -> Maybe HeapProfBreakdown -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"No heap profile" HeapProfBreakdown -> Text
ppHeapProfileType (Header -> Maybe HeapProfBreakdown
hHeapProfileType Header
header')
Html
", created at "
Html -> Html
code (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Header -> Text
hDate Header
header'
Html
" by "
Html -> Html
code (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Header -> Text
hJob Header
header'
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"] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"traces" | IncludeTraceData
TraceData <- [IncludeTraceData
itd]]
where
prof_data :: [Text]
prof_data = [Text
"samples"] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"traces" | IncludeTraceData
TraceData <- [IncludeTraceData
itd]]
htmlConf :: Args -> ChartType -> ChartConfig
htmlConf :: Args -> ChartType -> ChartConfig
htmlConf Args
as ChartType
ct =
ChartConfig
{ cwidth :: Double
cwidth = Double
1200
, cheight :: Double
cheight = Double
1000
, traces :: Bool
traces = Bool -> Bool
not (Args -> Bool
noTraces Args
as)
, colourScheme :: Text
colourScheme = Args -> Text
userColourScheme Args
as
, lineColourScheme :: Text
lineColourScheme = Text
"set1"
, chartType :: ChartType
chartType = ChartType
ct
, fixedYAxisExtent :: Maybe Double
fixedYAxisExtent = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Maybe Int -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Args -> Maybe Int
fixedYAxis Args
as
}
renderChart :: IncludeTraceData -> ChartType -> Bool -> TabID -> Text -> Html
renderChart :: IncludeTraceData -> ChartType -> Bool -> TabID -> Text -> Html
renderChart IncludeTraceData
itd ChartType
ct Bool
vega_lite TabID
vid Text
vegaSpec = do
let fields :: [Text]
fields = IncludeTraceData -> ChartType -> [Text]
select_data IncludeTraceData
itd ChartType
ct
Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (Text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (TabID -> Text
tabIDToVizID TabID
vid)) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"chart" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
""
Html -> Html
script (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"text/javascript" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
if Bool
vega_lite
then [Text] -> TabID -> Text -> Html
encloseScript [Text]
fields TabID
vid Text
vegaSpec
else TabID -> Text -> Html
encloseRawVegaScript TabID
vid Text
vegaSpec
renderChartWithJson :: IncludeTraceData -> ChartType -> TabID -> Value -> Text -> Html
renderChartWithJson :: IncludeTraceData -> ChartType -> TabID -> Value -> Text -> Html
renderChartWithJson IncludeTraceData
itd ChartType
ct TabID
k Value
dat Text
vegaSpec = do
Html -> Html
script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Value -> Html
insertJsonData Value
dat
IncludeTraceData -> ChartType -> Bool -> TabID -> Text -> Html
renderChart IncludeTraceData
itd ChartType
ct Bool
True TabID
k Text
vegaSpec
templateString :: EventlogType
-> Args
-> String
templateString :: EventlogType -> Args -> String
templateString EventlogType
x Args
as =
Html -> String
renderHtml (Html -> String) -> Html -> String
forall a b. (a -> b) -> a -> b
$ EventlogType -> Args -> [TabGroup] -> Html
template EventlogType
x Args
as ([TabGroup] -> Html) -> [TabGroup] -> Html
forall a b. (a -> b) -> a -> b
$ EventlogType -> Args -> [TabGroup]
allTabs EventlogType
x 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)"
allTabs :: EventlogType
-> Args
-> [TabGroup]
allTabs :: EventlogType -> Args -> [TabGroup]
allTabs (EventlogType Header
h Maybe HeapProfileData
x Maybe TickyProfileData
y) Args
as =
[Tab -> TabGroup
SingleTab (Header -> Args -> Tab
metaTab Header
h Args
as)] [TabGroup] -> [TabGroup] -> [TabGroup]
forall a. [a] -> [a] -> [a]
++
[TabGroup]
-> (HeapProfileData -> [TabGroup])
-> Maybe HeapProfileData
-> [TabGroup]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Header -> Args -> HeapProfileData -> [TabGroup]
allHeapTabs Header
h Args
as) Maybe HeapProfileData
x [TabGroup] -> [TabGroup] -> [TabGroup]
forall a. [a] -> [a] -> [a]
++
[Maybe TickyProfileData -> TabGroup
tickyProfileTabs Maybe TickyProfileData
y]
metaTab :: Header -> Args -> Tab
metaTab :: Header -> Args -> Tab
metaTab Header
header' Args
_as =
(String -> TabID -> Html -> Maybe Html -> Tab
mkTab String
"Meta" TabID
"meta" Html
metadata Maybe Html
forall a. Maybe a
Nothing) { tabActive = True }
where
metadata :: Html
metadata = do
Html
"Rendered by "
Html -> Html
a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href AttributeValue
"https://mpickering.github.io/eventlog2html" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"eventlog2html " Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> String -> Html
forall a. ToMarkup a => a -> Html
toHtml (Version -> String
showVersion Version
version)
Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Header -> Bool
has_heap_profile Header
header') (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"row" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"col" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
Html
"Sampling rate: "
Html -> Html
code (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Header -> Text
hSamplingRate Header
header'
Html
" seconds between heap samples"
has_heap_profile :: Header -> Bool
has_heap_profile :: Header -> Bool
has_heap_profile Header
h = Maybe HeapProfBreakdown -> Bool
forall a. Maybe a -> Bool
isJust (Header -> Maybe HeapProfBreakdown
hHeapProfileType Header
h)
allHeapTabs :: Header -> Args -> HeapProfileData -> [TabGroup]
allHeapTabs :: Header -> Args -> HeapProfileData -> [TabGroup]
allHeapTabs Header
header' Args
as HeapProfileData
x =
[ Args -> TabGroup
heapTab Args
as
, Header -> Args -> HeapProfileData -> TabGroup
heapProfileTabs Header
header' Args
as HeapProfileData
x
, Args -> HeapProfileData -> TabGroup
costCentresTab Args
as HeapProfileData
x
, HeapProfileData -> TabGroup
detailedTab HeapProfileData
x
]
heapTab :: Args -> TabGroup
heapTab :: Args -> TabGroup
heapTab Args
as = Tab -> TabGroup
SingleTab (Tab -> TabGroup) -> Tab -> TabGroup
forall a b. (a -> b) -> a -> b
$ String -> TabID -> Html -> Maybe Html -> Tab
mkTab String
"Heap" TabID
tabid (Args -> ChartType -> TabID -> Html
mk Args
as ChartType
HeapChart TabID
tabid) (Html -> Maybe Html
forall a. a -> Maybe a
Just Html
heapDocs)
where
tabid :: TabID
tabid = TabID
"heapchart"
heapDocs :: Html
heapDocs :: Html
heapDocs = Html -> Html
H.div (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 $(embedFile "inline-docs/heap.html")
heapProfileTabs :: Header -> Args -> HeapProfileData -> TabGroup
heapProfileTabs :: Header -> Args -> HeapProfileData -> TabGroup
heapProfileTabs Header
header' Args
as HeapProfileData
_
| Header -> Bool
has_heap_profile Header
header' = String -> [Tab] -> TabGroup
ManyTabs String
"Heap Profile" ([Tab] -> TabGroup) -> [Tab] -> TabGroup
forall a b. (a -> b) -> a -> b
$
[ String -> TabID -> Html -> Maybe Html -> Tab
mkTab String
"Area Chart" TabID
"areachart" (Args -> ChartType -> TabID -> Html
mk Args
as (AreaChartType -> ChartType
AreaChart AreaChartType
Stacked) TabID
"areachart") Maybe Html
noDocs
, String -> TabID -> Html -> Maybe Html -> Tab
mkTab String
"Normalized" TabID
"normalizedchart" (Args -> ChartType -> TabID -> Html
mk Args
as (AreaChartType -> ChartType
AreaChart AreaChartType
Normalized) TabID
"normalizedchart") Maybe Html
noDocs
, String -> TabID -> Html -> Maybe Html -> Tab
mkTab String
"Streamgraph" TabID
"streamgraph" (Args -> ChartType -> TabID -> Html
mk Args
as (AreaChartType -> ChartType
AreaChart AreaChartType
StreamGraph) TabID
"streamgraph") Maybe Html
noDocs
, String -> TabID -> Html -> Maybe Html -> Tab
mkTab String
"Linechart" TabID
"linechart" (Args -> ChartType -> TabID -> Html
mk Args
as ChartType
LineChart TabID
"linechart") Maybe Html
noDocs
]
| Bool
otherwise = Tab -> TabGroup
SingleTab Tab
noHeapProfileTab
noHeapProfileTab :: Tab
noHeapProfileTab :: Tab
noHeapProfileTab = String -> TabID -> Html -> Tab
mkUnavailableTab String
"Heap Profile" TabID
"heap_profile" Html
noHeapProfileDocs
noHeapProfileDocs :: Html
noHeapProfileDocs :: Html
noHeapProfileDocs = Html -> Html
H.div (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 $(embedFile "inline-docs/no-heap-profile.html")
mk :: Args -> ChartType -> TabID -> Html
mk :: Args -> ChartType -> TabID -> Html
mk Args
as ChartType
conf TabID
vid = IncludeTraceData -> ChartType -> Bool -> TabID -> Text -> Html
renderChart IncludeTraceData
itd ChartType
conf Bool
True TabID
vid
(Text -> Text
TL.toStrict (Value -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText (ChartConfig -> Value
vegaJson (Args -> ChartType -> ChartConfig
htmlConf Args
as ChartType
conf))))
where
itd :: IncludeTraceData
itd = if Args -> Bool
noTraces Args
as then IncludeTraceData
NoTraceData else IncludeTraceData
TraceData
detailedTab :: HeapProfileData -> TabGroup
detailedTab :: HeapProfileData -> TabGroup
detailedTab (HeapProfileData Value
_dat Maybe Value
_cc_descs Maybe Html
closure_descs) =
Tab -> TabGroup
SingleTab (Tab -> TabGroup) -> Tab -> TabGroup
forall a b. (a -> b) -> a -> b
$ String
-> TabID
-> (Html -> Html)
-> Maybe Html
-> Html
-> Maybe Html
-> Tab
forall a.
String
-> TabID -> (a -> Html) -> Maybe Html -> Html -> Maybe a -> Tab
mkOptionalTab String
"Detailed" TabID
"closures" Html -> Html
forall a. a -> a
Prelude.id Maybe Html
noDocs Html
noDetailedDocs Maybe Html
closure_descs
noDetailedDocs :: Html
noDetailedDocs :: Html
noDetailedDocs = Html -> Html
H.div (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 $(embedFile "inline-docs/no-detailed.html")
costCentresTab :: Args -> HeapProfileData -> TabGroup
costCentresTab :: Args -> HeapProfileData -> TabGroup
costCentresTab Args
as (HeapProfileData Value
_dat Maybe Value
cc_descs Maybe Html
_) =
Tab -> TabGroup
SingleTab (Tab -> TabGroup) -> Tab -> TabGroup
forall a b. (a -> b) -> a -> b
$ String
-> TabID
-> (Value -> Html)
-> Maybe Html
-> Html
-> Maybe Value
-> Tab
forall a.
String
-> TabID -> (a -> Html) -> Maybe Html -> Html -> Maybe a -> Tab
mkOptionalTab String
"Cost Centres" TabID
"costcentres" (Html -> Value -> Html
forall a b. a -> b -> a
const Html
stuff) Maybe Html
noDocs Html
noCostCentresDocs Maybe Value
cc_descs
where
tabIx :: TabID
tabIx = TabID
"costcentres"
itd :: IncludeTraceData
itd = if Args -> Bool
noTraces Args
as then IncludeTraceData
NoTraceData else IncludeTraceData
TraceData
stuff :: Html
stuff = IncludeTraceData -> ChartType -> Bool -> TabID -> Text -> Html
renderChart IncludeTraceData
itd ChartType
LineChart Bool
False TabID
tabIx Text
treevega
noCostCentresDocs :: Html
noCostCentresDocs :: Html
noCostCentresDocs = Html -> Html
H.div (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 $(embedFile "inline-docs/no-cost-centres.html")
tickyProfileTabs :: Maybe TickyProfileData -> TabGroup
tickyProfileTabs :: Maybe TickyProfileData -> TabGroup
tickyProfileTabs = Tab -> TabGroup
SingleTab (Tab -> TabGroup)
-> (Maybe TickyProfileData -> Tab)
-> Maybe TickyProfileData
-> TabGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> TabID
-> (TickyProfileData -> Html)
-> Maybe Html
-> Html
-> Maybe TickyProfileData
-> Tab
forall a.
String
-> TabID -> (a -> Html) -> Maybe Html -> Html -> Maybe a -> Tab
mkOptionalTab String
"Ticky" TabID
"ticky" TickyProfileData -> Html
tickyTab Maybe Html
noDocs Html
noTickyDocs
noTickyDocs :: Html
noTickyDocs :: Html
noTickyDocs = Html -> Html
H.div (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 $(embedFile "inline-docs/no-ticky.html")