{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Eventlog.Detailed where

import qualified Data.Map as Map
import Eventlog.Types
import qualified Data.Text as T

import Text.Blaze.Html
import qualified Text.Blaze.Html5            as H
import qualified Text.Blaze.Html5.Attributes as A
import Data.Array.Unboxed (UArray, bounds)
import qualified Data.Array.Unboxed as A
import Data.Fixed
import Control.Monad
import Data.Maybe



renderClosureInfo :: (UArray Int Double, UArray (Int, Int) Double)
                  -- Raw Data
                  -> Maybe (Map.Map InfoTablePtr InfoTableLoc)
                  -- Do we have IPE information?
                  -> Map.Map Bucket (Int, BucketInfo)
                  -- Buckets
                  -> Html
renderClosureInfo :: (UArray Int Double, UArray (Int, Int) Double)
-> Maybe (Map InfoTablePtr InfoTableLoc)
-> Map Bucket (Int, BucketInfo)
-> Html
renderClosureInfo (UArray Int Double
ts, UArray (Int, Int) Double
bs) Maybe (Map InfoTablePtr InfoTableLoc)
mipes Map Bucket (Int, BucketInfo)
raw_bs = do
  let cs :: Map Bucket (InfoTableLocStatus, (Int, BucketInfo))
cs = case Maybe (Map InfoTablePtr InfoTableLoc)
mipes of
             Just Map InfoTablePtr InfoTableLoc
ipes -> forall k a.
(k -> a -> InfoTablePtr)
-> Map k a
-> Map InfoTablePtr InfoTableLoc
-> Map k (InfoTableLocStatus, a)
mkClosureInfo (\Bucket
k (Int, BucketInfo)
_ -> Bucket -> InfoTablePtr
toItblPointer Bucket
k) Map Bucket (Int, BucketInfo)
raw_bs Map InfoTablePtr InfoTableLoc
ipes
             Maybe (Map InfoTablePtr InfoTableLoc)
Nothing   -> forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\(Int, BucketInfo)
v -> (InfoTableLocStatus
None, (Int, BucketInfo)
v)) Map Bucket (Int, BucketInfo)
raw_bs

  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
$ do
      Html -> Html
H.th Html
"Profile"
      Html -> Html
numTh Html
"n"
      Html -> Html
H.th Html
"Label"
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe (Map InfoTablePtr InfoTableLoc)
mipes) 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
"Integrated Size" forall a. Semigroup a => a -> a -> a
<> Html
H.br forall a. Semigroup a => a -> a -> a
<> Html
"(MiB s)")
      Html -> Html
numTh Html
"Stddev (MiB) "
      Html -> Html
numTh Html
"Intercept"
      Html -> Html
numTh Html
"Slope"
      Html -> Html
numTh Html
"Fit (R²)"
    forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr (\(InfoTableLocStatus, (Int, BucketInfo))
a Html
res -> (InfoTableLocStatus, (Int, BucketInfo)) -> Html
renderEntry (InfoTableLocStatus, (Int, BucketInfo))
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
res) (forall a. Monoid a => a
mempty :: Html) Map Bucket (InfoTableLocStatus, (Int, BucketInfo))
cs
  Html -> Html
H.script forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
initTable
  where
    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
    trunc :: Double -> Fixed E2
    trunc :: Double -> Fixed E2
trunc = forall a b. (Real a, Fractional b) => a -> b
realToFrac
    render :: Fixed E2 -> String
render = forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True

    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
toHtml 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
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, (Int, BucketInfo)) -> Html
renderEntry (InfoTableLocStatus
mitl, (Int
n, BucketInfo Text
shortDesc Maybe [Word32]
_ Double
tot Double
std Maybe (Double, Double, Double)
mg)) = do
          let (String
a, String
b, String
r2) =
                case Maybe (Double, Double, Double)
mg of
                  Maybe (Double, Double, Double)
Nothing -> (String
"", String
"", String
"")
                  Just (Double
ad, Double
bd, Double
r2d) -> (Fixed E2 -> String
render forall a b. (a -> b) -> a -> b
$ Double -> Fixed E2
trunc Double
ad
                                       , Fixed E2 -> String
render forall a b. (a -> b) -> a -> b
$ Double -> Fixed E2
trunc Double
bd
                                       , Fixed E2 -> String
render forall a b. (a -> b) -> a -> b
$ Double -> Fixed E2
trunc Double
r2d)
          Html -> Html
H.tr forall a b. (a -> b) -> a -> b
$ do
            Html -> Html
H.td ([(Double, Double)] -> Html
renderSpark (Int
-> (UArray Int Double, UArray (Int, Int) Double)
-> [(Double, Double)]
getBandValues Int
n (UArray Int Double
ts, UArray (Int, Int) Double
bs)))
            Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml Int
n)
            Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml Text
shortDesc)
            InfoTableLocStatus -> Html
renderInfoTableLocStatus InfoTableLocStatus
mitl
            Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml (Fixed E2 -> String
render forall a b. (a -> b) -> a -> b
$ Double -> Fixed E2
trunc (Double
tot forall a. Fractional a => a -> a -> a
/ Double
1e6)))
            Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml (Fixed E2 -> String
render forall a b. (a -> b) -> a -> b
$ Double -> Fixed E2
trunc (Double
std forall a. Fractional a => a -> a -> a
/ Double
1e6)))
            Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml String
a)
            Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml String
b)
            Html -> Html
H.td (forall a. ToMarkup a => a -> Html
toHtml String
r2)

renderSpark :: [(Double, Double)] -> Html
renderSpark :: [(Double, Double)] -> Html
renderSpark [(Double, Double)]
vs = Html -> Html
H.span forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"linechart" forall a b. (a -> b) -> a -> b
$ forall a. ToMarkup a => a -> Html
toHtml (Text -> [Text] -> Text
T.intercalate Text
"," (forall a b. (a -> b) -> [a] -> [b]
map (Double, Double) -> Text
renderLine [(Double, Double)]
vs))
  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, Double) -> Text
renderLine (Double
x,Double
y) = Double -> Text
rdouble Double
x forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Double -> Text
rdouble Double
y

initTable :: T.Text
initTable :: Text
initTable = Text
"$(document).ready(function() {\
        \$(\".closureTable\").fancyTable({\
        \    sortColumn: 1,\
        \    pagination: true,\
        \    perPage:10,\
        \    globalSearch:false,\
        \    globalSearchExcludes: [7,8,9,10,11,12],\
        \    sortOrder: 'descending',\
        \    onUpdate: function(){$.sparkline_display_visible()}\
        \});\
        \$.fn.sparkline.defaults.common.chartRangeMin = 0;\
        \$.fn.sparkline.defaults.common.width = 200;\
        \$('.linechart').sparkline();\
        \$(\".closureTable\").removeAttr(\"hidden\")\
\});"

getBandValues :: Int
            -> (UArray Int Double, UArray (Int, Int) Double)
            -> [(Double, Double)]
getBandValues :: Int
-> (UArray Int Double, UArray (Int, Int) Double)
-> [(Double, Double)]
getBandValues Int
k (UArray Int Double
ts, UArray (Int, Int) Double
vs) =
  let (Int
t1, Int
tn) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray Int Double
ts
      go :: Int -> [(Double, Double)]
go Int
i = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [Int
t1 .. Int
tn] forall a b. (a -> b) -> a -> b
$ \Int
t -> ((UArray Int Double
ts forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
A.! Int
t), (UArray (Int, Int) Double
vs forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
A.! (Int
i, Int
t)))

  in Int -> [(Double, Double)]
go Int
k