{-# 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.Html
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))

-- Dynamically bound in ccs tree
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) => { " ]
-- 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.
  [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
htmlHeader :: Maybe HeapProfileData -> Maybe TickyProfileData -> Args -> Html
htmlHeader 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
    -- Include this last to overwrite some milligram styling
    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
perTabFooter :: Header -> Html
perTabFooter 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")