{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE QuasiQuotes #-}
module Eventlog.Ticky where
import Eventlog.Types
import qualified Data.Map as Map
import Data.Word
import Data.String
import qualified Data.Text as T
import qualified Text.Blaze.Html5 as H
import Text.Blaze.Html5 as H
( preEscapedToHtml,
toHtml,
dataAttribute,
preEscapedStringValue,
stringComment,
Html,
(!),
AttributeValue,
body,
button,
code,
div,
docTypeHtml,
h1,
head,
link,
meta,
script,
style,
table,
td,
th,
thead,
title,
tr )
import Text.Blaze.Html5.Attributes as A
( charset, class_, hidden, href, id, onclick, rel, src)
import Text.Blaze (customAttribute)
import Text.Blaze.Html.Renderer.String
import Eventlog.Javascript
import Eventlog.Args
import Eventlog.AssetVersions
import Paths_eventlog2html
import Data.Version ( showVersion )
import Text.RawString.QQ
import Data.Fixed
import Control.Monad
import Data.List (foldl', sortBy)
import Data.Ord
renderTicky :: Word64 -> Map.Map TickyCounterId TickyCounter
-> Map.Map InfoTablePtr InfoTableLoc
-> [TickySample] -> (Double, Html)
renderTicky :: Word64
-> Map TickyCounterId TickyCounter
-> Map InfoTablePtr InfoTableLoc
-> [TickySample]
-> (Double, Html)
renderTicky Word64
total_allocs Map TickyCounterId TickyCounter
counters Map InfoTablePtr InfoTableLoc
ipes [TickySample]
samples = (Double
percentage_ticked, Bool
-> Map
TickyCounterId
(InfoTableLocStatus, (TickyCounter, AccumStats, Double))
-> Html
renderTickyInfo (Bool -> Bool
not (forall k a. Map k a -> Bool
Map.null Map InfoTablePtr InfoTableLoc
ipes)) Map
TickyCounterId
(InfoTableLocStatus, (TickyCounter, AccumStats, Double))
joined_with_ipe)
where
percentage_ticked :: Double
percentage_ticked = forall a b. (Real a, Fractional b) => a -> b
realToFrac (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map AccumStats -> Word64
allocs Map TickyCounterId AccumStats
accum_samples)) forall a. Fractional a => a -> a -> a
/ forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
total_allocs
joined_with_ipe :: Map
TickyCounterId
(InfoTableLocStatus, (TickyCounter, AccumStats, Double))
joined_with_ipe = forall k a.
(k -> a -> InfoTablePtr)
-> Map k a
-> Map InfoTablePtr InfoTableLoc
-> Map k (InfoTableLocStatus, a)
mkClosureInfo (\TickyCounterId
_ (TickyCounter
v, AccumStats
_, Double
_) -> TickyCounter -> InfoTablePtr
tickyCtrInfo TickyCounter
v) Map TickyCounterId (TickyCounter, AccumStats, Double)
joined_data Map InfoTablePtr InfoTableLoc
ipes
joined_data :: Map TickyCounterId (TickyCounter, AccumStats, Double)
joined_data = forall k a b c.
Ord k =>
(k -> a -> b -> Maybe c)
-> (Map k a -> Map k c)
-> (Map k b -> Map k c)
-> Map k a
-> Map k b
-> Map k c
Map.mergeWithKey (\TickyCounterId
_ TickyCounter
b AccumStats
c -> forall a. a -> Maybe a
Just (TickyCounter
b, AccumStats
c, forall a b. (Real a, Fractional b) => a -> b
realToFrac (AccumStats -> Word64
allocs AccumStats
c) forall a. Fractional a => a -> a -> a
/ forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
total_allocs)) (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty) (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty) Map TickyCounterId TickyCounter
counters Map TickyCounterId AccumStats
accum_samples
accum_samples :: Map TickyCounterId AccumStats
accum_samples = [TickySample] -> Map TickyCounterId AccumStats
accumulateSamples [TickySample]
samples
data AccumStats = AccumStats { AccumStats -> Word64
entries :: !Word64, AccumStats -> Word64
allocs :: !Word64, AccumStats -> Word64
allocd :: !Word64, AccumStats -> [(Double, Word64, Word64)]
series :: ![(Double, Word64 , Word64 )] } deriving Int -> AccumStats -> ShowS
[AccumStats] -> ShowS
AccumStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccumStats] -> ShowS
$cshowList :: [AccumStats] -> ShowS
show :: AccumStats -> String
$cshow :: AccumStats -> String
showsPrec :: Int -> AccumStats -> ShowS
$cshowsPrec :: Int -> AccumStats -> ShowS
Show
emptyAccumStats :: AccumStats
emptyAccumStats :: AccumStats
emptyAccumStats = Word64
-> Word64 -> Word64 -> [(Double, Word64, Word64)] -> AccumStats
AccumStats Word64
0 Word64
0 Word64
0 []
insertSample :: TickySample -> AccumStats -> AccumStats
insertSample :: TickySample -> AccumStats -> AccumStats
insertSample (TickySample Word64
_ids Word64
entries Word64
allocs Word64
allocd Double
time) (AccumStats Word64
aentries Word64
aalloc Word64
aallocd [(Double, Word64, Word64)]
aseries ) =
(Word64
-> Word64 -> Word64 -> [(Double, Word64, Word64)] -> AccumStats
AccumStats (Word64
aentries forall a. Num a => a -> a -> a
+ Word64
entries) (Word64
aalloc forall a. Num a => a -> a -> a
+ Word64
allocs) (Word64
allocd forall a. Num a => a -> a -> a
+ Word64
aallocd) ((Double
time, Word64
allocd forall a. Num a => a -> a -> a
+ Word64
aallocd, Word64
aentries forall a. Num a => a -> a -> a
+ Word64
entries ) forall a. a -> [a] -> [a]
: [(Double, Word64, Word64)]
aseries))
initStats :: TickySample -> AccumStats
initStats :: TickySample -> AccumStats
initStats = forall a b c. (a -> b -> c) -> b -> a -> c
flip TickySample -> AccumStats -> AccumStats
insertSample AccumStats
emptyAccumStats
accumulateSamples :: [TickySample] -> Map.Map TickyCounterId AccumStats
accumulateSamples :: [TickySample] -> Map TickyCounterId AccumStats
accumulateSamples [TickySample]
samples =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map TickyCounterId AccumStats
smap TickySample
ts -> forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (\AccumStats
_new AccumStats
old -> TickySample -> AccumStats -> AccumStats
insertSample TickySample
ts AccumStats
old) (Word64 -> TickyCounterId
TickyCounterId forall a b. (a -> b) -> a -> b
$ TickySample -> Word64
tickyCtrSampleId TickySample
ts) (TickySample -> AccumStats
initStats TickySample
ts) Map TickyCounterId AccumStats
smap) forall k a. Map k a
Map.empty
(forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing TickySample -> Double
tickySampleTime) [TickySample]
samples)
jsScript :: String -> Html
jsScript :: String -> Html
jsScript String
url = Html -> Html
script forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
src (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
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 :: Args -> Html
Args
as =
Html -> Html
H.head forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.title Html
"eventlog2html - Ticky Profile"
Html
meta forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
charset AttributeValue
"utf-8"
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
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
H.style forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
datatablesCSS
Html -> Html
H.style forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
datatablesButtonsCSS
Html -> Html
script forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
datatables
Html -> Html
script forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
datatablesButtons
Html -> Html
script forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
datatablesHtml5
Html -> Html
H.style forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
imagesCSS
Html -> Html
script forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
sparkline
else do
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
AttributeValue -> Html
css AttributeValue
"https://fonts.googleapis.com/css?family=Roboto:300,300italic,700,700italic"
String -> Html
jsScript String
fancyTableURL
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
String -> Html
jsScript String
sparklinesURL
Html -> Html
script forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
datatablesEllipsis
Html -> Html
H.style forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
stylesheet
template :: Header -> Word64 -> Double -> Html -> Args -> Html
template :: Header -> Word64 -> Double -> Html -> Args -> Html
template Header
header' Word64
total Double
ticked_percen Html
v Args
as = Html -> Html
docTypeHtml forall a b. (a -> b) -> a -> b
$ do
String -> Html
H.stringComment forall a b. (a -> b) -> a -> b
$ String
"Generated with eventlog2html-" forall a. Semigroup a => a -> a -> a
<> Version -> String
showVersion Version
version
Args -> Html
htmlHeader 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
H.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'
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
"Total Allocations: "
Html -> Html
code forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml Word64
total
Html -> Html
H.div forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"column cheader" forall a b. (a -> b) -> a -> b
$ do
Html
"Allocations Ticked (%): "
Html -> Html
code forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml (Fixed E2 -> String
render forall a b. (a -> b) -> a -> b
$ Double -> Fixed E2
trunc (Double
ticked_percen forall a. Num a => a -> a -> a
* Double
100))
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('table', this)" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"defaultOpen" forall a b. (a -> b) -> a -> b
$ Html
"Table"
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
A.id AttributeValue
"table" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"tabviz" forall a b. (a -> b) -> a -> b
$ Html
v
Html -> Html
script forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
tablogic
tickyTemplateString :: Header -> Word64 -> Double -> Html -> Args -> String
tickyTemplateString :: Header -> Word64 -> Double -> Html -> Args -> String
tickyTemplateString Header
header' Word64
tot_allocs Double
ticked_per Html
ticky_table Args
as =
Html -> String
renderHtml forall a b. (a -> b) -> a -> b
$ Header -> Word64 -> Double -> Html -> Args -> Html
template Header
header' Word64
tot_allocs Double
ticked_per Html
ticky_table Args
as
trunc :: Double -> Fixed E2
trunc :: Double -> Fixed E2
trunc = forall a b. (Real a, Fractional b) => a -> b
realToFrac
render :: Fixed E2 -> String
render :: Fixed E2 -> String
render = forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True
renderTickyInfo :: Bool
-> Map.Map TickyCounterId (InfoTableLocStatus, (TickyCounter, AccumStats, Double))
-> Html
renderTickyInfo :: Bool
-> Map
TickyCounterId
(InfoTableLocStatus, (TickyCounter, AccumStats, Double))
-> Html
renderTickyInfo Bool
with_ipe Map
TickyCounterId
(InfoTableLocStatus, (TickyCounter, AccumStats, Double))
ticky_samples = do
Html -> Html
H.table forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"closure_table" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"table table-striped closureTable" forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.hidden AttributeValue
"true" forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.thead forall a b. (a -> b) -> a -> b
$ Html -> Html
H.tr forall a b. (a -> b) -> a -> b
$ Html
headFoot
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr (\(InfoTableLocStatus, (TickyCounter, AccumStats, Double))
a Html
res -> (InfoTableLocStatus, (TickyCounter, AccumStats, Double)) -> Html
renderEntry (InfoTableLocStatus, (TickyCounter, AccumStats, Double))
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
res) (forall a. Monoid a => a
mempty :: Html) Map
TickyCounterId
(InfoTableLocStatus, (TickyCounter, AccumStats, Double))
ticky_samples
Html -> Html
H.tfoot forall a b. (a -> b) -> a -> b
$ Html -> Html
H.tr forall a b. (a -> b) -> a -> b
$ Html
headFoot
Html -> Html
H.script forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml (Bool -> Text
initTable Bool
with_ipe)
where
headFoot :: Html
headFoot = do
Html -> Html
H.th Html
"Label"
Html -> Html
H.th Html
"FVs"
Html -> Html
H.th Html
"Args"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
with_ipe) forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.th Html
"Description"
Html -> Html
H.th Html
"CTy"
Html -> Html
H.th Html
"Type"
Html -> Html
H.th Html
"Module"
Html -> Html
H.th Html
"Loc"
Html -> Html
numTh Html
"Allocs"
Html -> Html
numTh Html
"Allocs (%)"
Html -> Html
numTh Html
"Allocd"
Html -> Html
numTh Html
"Allocd #"
Html -> Html
numTh Html
"Entries"
Html -> Html
numTh Html
"Allocs/Entries"
Html -> Html
numTh Html
"Allocd #/Entries"
numTh :: Html -> Html
numTh Html
lbl = Html -> Html
H.th forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
H.dataAttribute Tag
"sortas" AttributeValue
"numeric" forall a b. (a -> b) -> a -> b
$ Html
lbl
renderInfoTableLoc :: InfoTableLoc -> Html
renderInfoTableLoc :: InfoTableLoc -> Html
renderInfoTableLoc (InfoTableLoc Text
table_name ClosureType
cd Text
tydesc Text
_lbl Text
m Text
sloc) = do
Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml Text
table_name)
Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml (forall a. Show a => a -> String
show @ClosureType ClosureType
cd))
Html -> Html
H.td (forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
tydesc)
Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml Text
m)
Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml Text
sloc)
renderInfoTableLocStatus :: InfoTableLocStatus -> Html
renderInfoTableLocStatus :: InfoTableLocStatus -> Html
renderInfoTableLocStatus InfoTableLocStatus
_ | Bool -> Bool
not Bool
with_ipe = forall a. Monoid a => a
mempty
renderInfoTableLocStatus InfoTableLocStatus
itls =
case InfoTableLocStatus
itls of
Here InfoTableLoc
itl -> InfoTableLoc -> Html
renderInfoTableLoc InfoTableLoc
itl
InfoTableLocStatus
Missing -> Html
emptyItlColumns
InfoTableLocStatus
None -> forall a. Monoid a => a
mempty
emptyItlColumns :: Html
emptyItlColumns = do
Html -> Html
H.td Html
""
Html -> Html
H.td Html
""
Html -> Html
H.td Html
""
Html -> Html
H.td Html
""
Html -> Html
H.td Html
""
renderEntry :: (InfoTableLocStatus, (TickyCounter, AccumStats, Double)) -> Html
renderEntry :: (InfoTableLocStatus, (TickyCounter, AccumStats, Double)) -> Html
renderEntry (InfoTableLocStatus
loc, ((TickyCounter Word64
_id Word16
_arity TickyCounterArgs
kinds Text
label InfoTablePtr
_), AccumStats {[(Double, Word64, Word64)]
Word64
series :: [(Double, Word64, Word64)]
allocd :: Word64
allocs :: Word64
entries :: Word64
series :: AccumStats -> [(Double, Word64, Word64)]
allocd :: AccumStats -> Word64
entries :: AccumStats -> Word64
allocs :: AccumStats -> Word64
..}, Double
percent)) = do
let fvs :: String
fvs = TickyCounterArgs -> String
tickyCounterFVs TickyCounterArgs
kinds
ticky_args :: String
ticky_args = TickyCounterArgs -> String
tickyCounterArgs TickyCounterArgs
kinds
size :: Int
size = Int -> Int -> Int
closureSize (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
fvs) (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
ticky_args)
alloc_no :: Int
alloc_no = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
allocd forall a. Integral a => a -> a -> a
`Prelude.div` Int
size
Html -> Html
H.tr forall a b. (a -> b) -> a -> b
$ do
Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml Text
label)
Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml String
fvs)
Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml String
ticky_args)
InfoTableLocStatus -> Html
renderInfoTableLocStatus InfoTableLocStatus
loc
Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml Word64
allocs)
Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml forall a b. (a -> b) -> a -> b
$ Fixed E2 -> String
render forall a b. (a -> b) -> a -> b
$ Double -> Fixed E2
trunc (Double
percent forall a. Num a => a -> a -> a
* Double
100))
Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml Word64
allocd)
Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml Int
alloc_no)
Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml Word64
entries)
Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml (case Word64
entries of
Word64
0 -> Word64
0
Word64
_ -> Word64
allocs forall a. Integral a => a -> a -> a
`Prelude.div` Word64
entries))
Html -> Html
H.td (case Word64
entries of
Word64
0 -> Html
"NaN"
Word64
_ ->
case Word64
allocd of
Word64
0 -> Html
"None"
Word64
_ -> forall a. ToMarkup a => a -> Html
toHtml (Fixed E2 -> String
render (Double -> Fixed E2
trunc (forall a b. (Real a, Fractional b) => a -> b
realToFrac Word64
entries forall a. Fractional a => a -> a -> a
/ forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
alloc_no))))
closureSize :: Int -> Int -> Int
closureSize :: Int -> Int -> Int
closureSize Int
fvs Int
cl_args
| Int
cl_args forall a. Eq a => a -> a -> Bool
== Int
0 = (Int
2 forall a. Num a => a -> a -> a
+ Int
fvs) forall a. Num a => a -> a -> a
* Int
8
| Bool
otherwise = (Int
1 forall a. Num a => a -> a -> a
+ Int
fvs) forall a. Num a => a -> a -> a
* Int
8
renderSpark :: Int -> [(Double, Word64, Word64)] -> Html
renderSpark :: Int -> [(Double, Word64, Word64)] -> Html
renderSpark Int
size [(Double, Word64, Word64)]
vs = Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"linechart"
forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
customAttribute Tag
"data-allocd" (Text -> AttributeValue
H.preEscapedTextValue forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"," (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {c}. (Show a, Integral a) => (Double, a, c) -> Text
renderLine [(Double, Word64, Word64)]
vs))
forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
customAttribute Tag
"data-entries" (Text -> AttributeValue
H.preEscapedTextValue forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"," (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. Show a => (Double, b, a) -> Text
renderLineEntries [(Double, Word64, Word64)]
vs))
forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
customAttribute Tag
"sparkChartRangeMax" (forall a. ToValue a => a -> AttributeValue
H.toValue Word64
max_alloc_n)
forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty
where
rdouble :: Double -> Text
rdouble = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac @Double @(Fixed E2)
renderLine :: (Double, a, c) -> Text
renderLine (Double
x,a
w, c
_) = Double -> Text
rdouble Double
x forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show (a
w forall a. Integral a => a -> a -> a
`Prelude.div` forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size))
renderLineEntries :: (Double, b, a) -> Text
renderLineEntries (Double
x,b
_, a
e) = Double -> Text
rdouble Double
x forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show a
e)
max_alloc_n :: Word64
max_alloc_n = Word64
last_allocd forall a. Integral a => a -> a -> a
`Prelude.div` (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
(Double
_, Word64
last_allocd, Word64
_) = forall a. [a] -> a
Prelude.head [(Double, Word64, Word64)]
vs
initTable :: Bool -> T.Text
initTable :: Bool -> Text
initTable Bool
ipe =
Text
"var ipe = " forall a. Semigroup a => a -> a -> a
<> (if Bool
ipe then Text
"true" else Text
"false") forall a. Semigroup a => a -> a -> a
<> Text
";\n" forall a. Semigroup a => a -> a -> a
<>
[r|// Setup - add a text input to each footer cell
$(document).ready(function(){
$('.closureTable tfoot th').each( function () {
var title = $(this).text();
// if (! ($(this).data("sortas") == "numeric")){
$(this).html( '<input type="text" style="width:100%"; placeholder="Search"/>' );
// }
// else {
// $(this).html('')
// }
} );
function init_spark(){
$('.linechart').sparkline('html', { enableTagOptions: true, tagOptionPrefix: 'allocd-', tagValuesAttribute: 'data-allocd' });
$('.linechart').sparkline('html', { composite: true, lineColor: 'red', enableTagOptions: true, tagOptionPrefix: 'entries-', tagValuesAttribute: 'data-entries' });
$.sparkline_display_visible();
}
// DataTable
var table = $('.closureTable').DataTable({
"order": [[ ipe ? 8 : 3, "desc" ]],
"autoWidth": true,
"dom": 'Bfrtip',
"buttons": [
{
text: 'TSV',
extend: 'csvHtml5',
fieldSeparator: '\t',
extension: '.tsv'
}
],
"columnDefs": [
{ "orderSequence": ["desc", "asc"], "targets": (ipe ? [8,9,10,11,12,13,14] : [ 3,4,5,6,7,8,9])}
, {"render": $.fn.dataTable.render.ellipsis( 30, true, false ), "targets": (ipe ? [5] : []) }
],
"deferRender" : true,
initComplete: function () {
// Apply the search
$(".closureTable").removeAttr("hidden");
this.api().columns().every( function () {
var that = this;
$( 'input', this.footer() ).on( 'blur', function () {
if ( that.search() !== this.value ) {
that
.search( this.value )
.draw();
}
} );
$.fn.sparkline.defaults.common.chartRangeMin = 0;
$.fn.sparkline.defaults.common.width = 200;
init_spark();
} );
}
});
table.on( 'draw', function () {
init_spark();
} );
})
|]