{-# 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

data InfoTableLocStatus = None -- None of the entries have InfoTableLoc
                        | Missing -- This one is just missing
                        | Here InfoTableLoc -- Here is is

mkMissing :: Maybe InfoTableLoc -> InfoTableLocStatus
mkMissing :: Maybe InfoTableLoc -> InfoTableLocStatus
mkMissing = InfoTableLocStatus
-> (InfoTableLoc -> InfoTableLocStatus)
-> Maybe InfoTableLoc
-> InfoTableLocStatus
forall b a. b -> (a -> b) -> Maybe a -> b
maybe InfoTableLocStatus
Missing InfoTableLoc -> InfoTableLocStatus
Here


mkClosureInfo :: Map.Map Bucket a
              -> Map.Map InfoTablePtr InfoTableLoc
              -> Map.Map Bucket (InfoTableLocStatus, a)
mkClosureInfo :: forall a.
Map Bucket a
-> Map InfoTablePtr InfoTableLoc
-> Map Bucket (InfoTableLocStatus, a)
mkClosureInfo Map Bucket a
b Map InfoTablePtr InfoTableLoc
ipes =
  (Bucket -> a -> (InfoTableLocStatus, a))
-> Map Bucket a -> Map Bucket (InfoTableLocStatus, a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\Bucket
k a
v -> (Maybe InfoTableLoc -> InfoTableLocStatus
mkMissing (Maybe InfoTableLoc -> InfoTableLocStatus)
-> Maybe InfoTableLoc -> InfoTableLocStatus
forall a b. (a -> b) -> a -> b
$ InfoTablePtr -> Map InfoTablePtr InfoTableLoc -> Maybe InfoTableLoc
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Bucket -> InfoTablePtr
toItblPointer Bucket
k) Map InfoTablePtr InfoTableLoc
ipes, a
v)) Map Bucket a
b


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 -> Map Bucket (Int, BucketInfo)
-> Map InfoTablePtr InfoTableLoc
-> Map Bucket (InfoTableLocStatus, (Int, BucketInfo))
forall a.
Map Bucket a
-> Map InfoTablePtr InfoTableLoc
-> Map Bucket (InfoTableLocStatus, a)
mkClosureInfo Map Bucket (Int, BucketInfo)
raw_bs Map InfoTablePtr InfoTableLoc
ipes
             Maybe (Map InfoTablePtr InfoTableLoc)
Nothing   -> ((Int, BucketInfo) -> (InfoTableLocStatus, (Int, BucketInfo)))
-> Map Bucket (Int, BucketInfo)
-> Map Bucket (InfoTableLocStatus, (Int, BucketInfo))
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 (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"closure_table" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"table table-striped closureTable" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.hidden AttributeValue
"true" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
H.thead (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.tr (Html -> Html) -> Html -> Html
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"
      Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Map InfoTablePtr InfoTableLoc) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Map InfoTablePtr InfoTableLoc)
mipes) (Html -> Html) -> Html -> Html
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" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
H.br Html -> Html -> Html
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²)"
    ((InfoTableLocStatus, (Int, BucketInfo)) -> Html -> Html)
-> Html
-> Map Bucket (InfoTableLocStatus, (Int, BucketInfo))
-> Html
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 Html -> Html -> Html
forall a b. MarkupM a -> MarkupM b -> MarkupM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
res) (Html
forall a. Monoid a => a
mempty :: Html) Map Bucket (InfoTableLocStatus, (Int, BucketInfo))
cs
  Html -> Html
H.script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
preEscapedToHtml Text
initTable
  where
    numTh :: Html -> Html
numTh Html
lbl = Html -> Html
H.th (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Tag -> AttributeValue -> Attribute
H.dataAttribute Tag
"sortas" AttributeValue
"numeric" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
lbl
    trunc :: Double -> Fixed E2
    trunc :: Double -> Fixed E2
trunc = Double -> Fixed E2
forall a b. (Real a, Fractional b) => a -> b
realToFrac
    render :: Fixed E2 -> String
render = Bool -> Fixed E2 -> String
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 (Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
table_name)
      Html -> Html
H.td (String -> Html
forall a. ToMarkup a => a -> Html
toHtml (forall a. Show a => a -> String
show @ClosureType ClosureType
cd))
      Html -> Html
H.td (Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
tydesc)
      Html -> Html
H.td (Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
m)
      Html -> Html
H.td (Text -> Html
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     -> Html
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 (Fixed E2 -> String) -> Fixed E2 -> String
forall a b. (a -> b) -> a -> b
$ Double -> Fixed E2
trunc Double
ad
                                       , Fixed E2 -> String
render (Fixed E2 -> String) -> Fixed E2 -> String
forall a b. (a -> b) -> a -> b
$ Double -> Fixed E2
trunc Double
bd
                                       , Fixed E2 -> String
render (Fixed E2 -> String) -> Fixed E2 -> String
forall a b. (a -> b) -> a -> b
$ Double -> Fixed E2
trunc Double
r2d)
          Html -> Html
H.tr (Html -> Html) -> Html -> Html
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 (Int -> Html
forall a. ToMarkup a => a -> Html
toHtml Int
n)
            Html -> Html
H.td (Text -> Html
forall a. ToMarkup a => a -> Html
toHtml Text
shortDesc)
            InfoTableLocStatus -> Html
renderInfoTableLocStatus InfoTableLocStatus
mitl
            Html -> Html
H.td (String -> Html
forall a. ToMarkup a => a -> Html
toHtml (Fixed E2 -> String
render (Fixed E2 -> String) -> Fixed E2 -> String
forall a b. (a -> b) -> a -> b
$ Double -> Fixed E2
trunc (Double
tot Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e6)))
            Html -> Html
H.td (String -> Html
forall a. ToMarkup a => a -> Html
toHtml (Fixed E2 -> String
render (Fixed E2 -> String) -> Fixed E2 -> String
forall a b. (a -> b) -> a -> b
$ Double -> Fixed E2
trunc (Double
std Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e6)))
            Html -> Html
H.td (String -> Html
forall a. ToMarkup a => a -> Html
toHtml String
a)
            Html -> Html
H.td (String -> Html
forall a. ToMarkup a => a -> Html
toHtml String
b)
            Html -> Html
H.td (String -> Html
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 (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"linechart" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
toHtml (Text -> [Text] -> Text
T.intercalate Text
"," (((Double, Double) -> Text) -> [(Double, Double)] -> [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 (String -> Text) -> (Double -> String) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Fixed E2 -> String
forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
True (Fixed E2 -> String) -> (Double -> Fixed E2) -> Double -> String
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> 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) = UArray Int Double -> (Int, Int)
forall i. Ix i => UArray i Double -> (i, i)
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 = ((Int -> (Double, Double)) -> [Int] -> [(Double, Double)])
-> [Int] -> (Int -> (Double, Double)) -> [(Double, Double)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> (Double, Double)) -> [Int] -> [(Double, Double)]
forall a b. (a -> b) -> [a] -> [b]
map [Int
t1 .. Int
tn] ((Int -> (Double, Double)) -> [(Double, Double)])
-> (Int -> (Double, Double)) -> [(Double, Double)]
forall a b. (a -> b) -> a -> b
$ \Int
t -> ((UArray Int Double
ts UArray Int Double -> Int -> Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
A.! Int
t), (UArray (Int, Int) Double
vs UArray (Int, Int) Double -> (Int, Int) -> Double
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