{- FOURMOLU_DISABLE -}
-- The MIT License (MIT)

-- Copyright (c) 2016-2024 Objectionary.com

-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to deal
-- in the Software without restriction, including without limitation the rights
-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-- copies of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:

-- The above copyright notice and this permission notice shall be included
-- in all copies or substantial portions of the Software.

-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NON-INFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-- SOFTWARE.
{- FOURMOLU_ENABLE -}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-partial-fields #-}

module Language.EO.Phi.Report.Html where

import Data.FileEmbed (embedFileRelative)
import Data.Functor ((<&>))
import Data.List (intercalate)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Language.EO.Phi.Metrics.Data (Metrics (..), MetricsCount, toListMetrics)
import Language.EO.Phi.Pipeline.Config
import Language.EO.Phi.Report.Data
import PyF (fmt)
import Text.Blaze.Html.Renderer.String (renderHtml)
import Text.Blaze.Html5 hiding (i)
import Text.Blaze.Html5 qualified as TBH
import Text.Blaze.Html5.Attributes (charset, class_, colspan, content, id, lang, onclick, type_, value)
import Text.Blaze.Html5.Attributes qualified as TBHA
import Prelude hiding (div, id, span)
import Prelude qualified

-- $setup
-- >>> import Text.Blaze.Html.Renderer.String (renderHtml)

-- | JavaScript file to embed into HTML reports
reportJS :: String
reportJS :: String
reportJS = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 $(embedFileRelative "report/main.js")

-- | CSS file to embed into HTML reports
reportCSS :: String
reportCSS :: String
reportCSS = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 $(embedFileRelative "report/styles.css")

metricsNames :: Metrics String
metricsNames :: Metrics String
metricsNames =
  Metrics
    { $sel:dataless:Metrics :: String
dataless = String
"Dataless formations"
    , $sel:applications:Metrics :: String
applications = String
"Applications"
    , $sel:formations:Metrics :: String
formations = String
"Formations"
    , $sel:dispatches:Metrics :: String
dispatches = String
"Dispatches"
    }

toHtmlReportTableHeader :: Html
toHtmlReportTableHeader :: Html
toHtmlReportTableHeader =
  Html -> Html
thead (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
    [Html] -> Html
forall a. ToMarkup a => a -> Html
toHtml
      [ Html -> Html
tr (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
          [Html] -> Html
forall a. ToMarkup a => a -> Html
toHtml
            [ Html -> Html
th (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
colspan AttributeValue
"1" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"no-sort" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
""
            , Html -> Html
th (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
colspan AttributeValue
"2" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"no-sort" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"Attribute"
            , Html -> Html
th (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
colspan AttributeValue
"4" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"no-sort" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"Change"
            , Html -> Html
th (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
colspan AttributeValue
"4" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"no-sort" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"Initial"
            , Html -> Html
th (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
colspan AttributeValue
"4" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"no-sort" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"Normalized"
            , Html -> Html
th (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
colspan AttributeValue
"4" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"no-sort" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"Location"
            ]
      , Html -> Html
tr (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
forall a. ToMarkup a => a -> Html
toHtml ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$
          Html -> Html
th
            (Html -> Html) -> [Html] -> [Html]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ Html
"Test #"
                , Html
"Attribute Initial"
                , Html
"Attribute Normalized"
                ]
              [Html] -> [Html] -> [Html]
forall a. Semigroup a => a -> a -> a
<> ( [[Html]] -> [Html]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    ([[Html]] -> [Html])
-> ([String] -> [[Html]]) -> [String] -> [Html]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Html] -> [[Html]]
forall a. Int -> a -> [a]
replicate Int
3
                    ([Html] -> [[Html]])
-> ([String] -> [Html]) -> [String] -> [[Html]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Html
forall a. ToMarkup a => a -> Html
toHtml (String -> Html) -> [String] -> [Html]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
                    ([String] -> [Html]) -> [String] -> [Html]
forall a b. (a -> b) -> a -> b
$ Metrics String -> [String]
forall a. Metrics a -> [a]
toListMetrics Metrics String
metricsNames
                 )
              [Html] -> [Html] -> [Html]
forall a. Semigroup a => a -> a -> a
<> [ Html
"File Initial"
                 , Html
"Bindings Path Initial"
                 , Html
"File Normalized"
                 , Html
"Bindings Path Normalized"
                 ]
      ]

instance ToMarkup Percent where
  toMarkup :: Percent -> Markup
  toMarkup :: Percent -> Html
toMarkup = String -> Html
forall a. ToMarkup a => a -> Html
toMarkup (String -> Html) -> (Percent -> String) -> Percent -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Percent -> String
forall a. Show a => a -> String
show

class (Num a) => ToDataSort a where
  toDataSort :: a -> Integer

-- TODO #389:30m
-- I couldn't make PyF pad doubles with zeros using {n:05} syntax
-- because PyF also counts the digits after .
instance ToDataSort Double where
  toDataSort :: Double -> Integer
  toDataSort :: Double -> Integer
toDataSort Double
number = Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ Double
number Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000

instance ToDataSort Percent where
  toDataSort :: Percent -> Integer
  toDataSort :: Percent -> Integer
toDataSort (Percent Double
number) = Double -> Integer
forall a. ToDataSort a => a -> Integer
toDataSort Double
number

instance ToDataSort Integer where
  toDataSort :: Integer -> Integer
  toDataSort :: Integer -> Integer
toDataSort Integer
x = Integer
x

mkDataSortAttribute :: AttributeValue -> Attribute
mkDataSortAttribute :: AttributeValue -> Attribute
mkDataSortAttribute = Tag -> AttributeValue -> Attribute
dataAttribute Tag
"sort"

-- >>> pipelineConfig = ReportFormat'Markdown
--
-- >>> renderHtml $ toHtmlChange pipelineConfig (MetricsChange'Bad (Percent 0.2))
-- "<td class=\"number bad\" data-sort=\"1000200\">20.00%\128308</td>"
--
-- >>> renderHtml $ toHtmlChange pipelineConfig (MetricsChange'Good (Percent 0.5))
-- "<td class=\"number good\" data-sort=\"1000500\">50.00%\128994</td>"
-- >>> renderHtml $ toHtmlChange pipelineConfig (MetricsChange'NA :: MetricsChangeCategory Percent)
-- "<td class=\"number not-applicable\" data-sort=\"0000000\">N/A\128995</td>"
toHtmlChange :: forall a. (ToMarkup a, ToDataSort a) => ReportFormat -> MetricsChangeCategory a -> Html
toHtmlChange :: forall a.
(ToMarkup a, ToDataSort a) =>
ReportFormat -> MetricsChangeCategory a -> Html
toHtmlChange ReportFormat
reportFormat = \case
  MetricsChangeCategory a
MetricsChange'NA -> Html -> Html
td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ [fmt|{number} not-applicable|] (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Attribute
mkDataSortAttributeNA (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
toHtml String
na Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> String -> Html
forall a. ToMarkup a => a -> Html
toHtml [Char
'🟣' | Bool
isMarkdown]
  MetricsChange'Bad{a
change :: a
$sel:change:MetricsChange'Good :: forall a. MetricsChangeCategory a -> a
..} -> Html -> Html
td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ [fmt|{number} bad|] (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! a -> Attribute
forall {a}. ToDataSort a => a -> Attribute
mkDataSortAttributeChange a
change (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ a -> Html
forall a. ToMarkup a => a -> Html
toHtml a
change Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> String -> Html
forall a. ToMarkup a => a -> Html
toHtml [Char
'🔴' | Bool
isMarkdown]
  MetricsChange'Good{a
$sel:change:MetricsChange'Good :: forall a. MetricsChangeCategory a -> a
change :: a
..} -> Html -> Html
td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ [fmt|{number} good|] (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! a -> Attribute
forall {a}. ToDataSort a => a -> Attribute
mkDataSortAttributeChange a
change (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ a -> Html
forall a. ToMarkup a => a -> Html
toHtml a
change Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> String -> Html
forall a. ToMarkup a => a -> Html
toHtml [Char
'🟢' | Bool
isMarkdown]
 where
  isMarkdown :: Bool
isMarkdown = ReportFormat
reportFormat ReportFormat -> ReportFormat -> Bool
forall a. Eq a => a -> a -> Bool
== ReportFormat
ReportFormat'Markdown
  mkDataSortAttributeChange :: a -> Attribute
mkDataSortAttributeChange a
change = AttributeValue -> Attribute
mkDataSortAttribute [fmt|1{toDataSort change:06}|]
  mkDataSortAttributeNA :: Attribute
mkDataSortAttributeNA = AttributeValue -> Attribute
mkDataSortAttribute [fmt|0{(toDataSort (Percent 0.0)):06}|]
  na :: String
  na :: String
na = String
"N/A"
  number :: String
  number :: String
number = String
"number"

toHtmlMetricsChange :: ReportFormat -> MetricsChangeCategorized -> [Html]
toHtmlMetricsChange :: ReportFormat -> MetricsChangeCategorized -> [Html]
toHtmlMetricsChange ReportFormat
reportFormat MetricsChangeCategorized
change = ReportFormat -> MetricsChangeCategory Percent -> Html
forall a.
(ToMarkup a, ToDataSort a) =>
ReportFormat -> MetricsChangeCategory a -> Html
toHtmlChange ReportFormat
reportFormat (MetricsChangeCategory Percent -> Html)
-> [MetricsChangeCategory Percent] -> [Html]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MetricsChangeCategorized -> [MetricsChangeCategory Percent]
forall a. Metrics a -> [a]
toListMetrics MetricsChangeCategorized
change

toHtmlMetrics :: MetricsCount -> [Html]
toHtmlMetrics :: MetricsCount -> [Html]
toHtmlMetrics MetricsCount
metrics =
  MetricsCount -> [Int]
forall a. Metrics a -> [a]
toListMetrics MetricsCount
metrics
    [Int] -> (Int -> Html) -> [Html]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\Int
x -> Html -> Html
td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"number" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
mkDataSortAttribute [fmt|{x:06}|] (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Int -> Html
forall a. ToMarkup a => a -> Html
toHtml Int
x)

toHtmlReportRow :: ReportFormat -> Int -> ReportRow -> Html
toHtmlReportRow :: ReportFormat -> Int -> ReportRow -> Html
toHtmlReportRow ReportFormat
reportFormat Int
index ReportRow
reportRow =
  Html -> Html
tr (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
forall a. ToMarkup a => a -> Html
toHtml ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$
    ( Html -> Html
td
        (Html -> Html) -> (String -> Html) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Html
forall a. ToMarkup a => a -> Html
toHtml
        (String -> Html) -> [String] -> [Html]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ [fmt|{index}|]
            , String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
na ReportRow
reportRow.attributeInitial
            , String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
na ReportRow
reportRow.attributeNormalized
            ]
    )
      [Html] -> [Html] -> [Html]
forall a. Semigroup a => a -> a -> a
<> ReportFormat -> MetricsChangeCategorized -> [Html]
toHtmlMetricsChange ReportFormat
reportFormat ReportRow
reportRow.metricsChange
      [Html] -> [Html] -> [Html]
forall a. Semigroup a => a -> a -> a
<> MetricsCount -> [Html]
toHtmlMetrics ReportRow
reportRow.metricsInitial
      [Html] -> [Html] -> [Html]
forall a. Semigroup a => a -> a -> a
<> MetricsCount -> [Html]
toHtmlMetrics ReportRow
reportRow.metricsNormalized
      [Html] -> [Html] -> [Html]
forall a. Semigroup a => a -> a -> a
<> ( Html -> Html
td
            (Html -> Html) -> (String -> Html) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Html
forall a. ToMarkup a => a -> Html
toHtml
            (String -> Html) -> [String] -> [Html]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
allPrograms ReportRow
reportRow.fileInitial
                , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [String
wholeProgram] ReportRow
reportRow.bindingsPathInitial
                , String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
allPrograms ReportRow
reportRow.fileNormalized
                , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [String
wholeProgram] ReportRow
reportRow.bindingsPathNormalized
                ]
         )
 where
  wholeProgram :: String
wholeProgram = String
"[whole program]"
  allPrograms :: String
allPrograms = String
"[all programs]"
  na :: String
na = String
"[N/A]"

toHtmlReport :: ReportFormat -> PipelineConfig -> Report -> Html
toHtmlReport :: ReportFormat -> PipelineConfig -> Report -> Html
toHtmlReport ReportFormat
reportFormat PipelineConfig
pipelineConfig Report
report =
  [Html] -> Html
forall a. ToMarkup a => a -> Html
toHtml
    [ Html -> Html
forall {a}. Monoid a => a -> a
memptyIfMarkdown Html
docType
    , (Html -> Html) -> Html -> Html
forall {a}. (a -> a) -> a -> a
idIfMarkdown (Html -> Html
TBH.html (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
lang AttributeValue
"en-US") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
        [Html] -> Html
forall a. ToMarkup a => a -> Html
toHtml
          [ (Html -> Html) -> Html -> Html
forall {a}. (a -> a) -> a -> a
idIfMarkdown Html -> Html
TBH.head (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
              Html -> Html
forall {a}. Monoid a => a -> a
memptyIfMarkdown (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
forall a. ToMarkup a => a -> Html
toHtml ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$
                [ Html
meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
charset AttributeValue
"utf-8"
                , Html
meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
TBHA.name AttributeValue
"viewport" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
content AttributeValue
"width=device-width, initial-scale=1.0"
                , Html -> Html
TBH.title Html
"Report"
                , -- https://stackoverflow.com/a/55743302
                  -- https://stackoverflow.com/a/3169849
                  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
$
                    [fmt|
                      function copytable(el) {{
                        var urlField = document.getElementById(el)
                        var range = document.createRange()
                        range.selectNode(urlField)
                        window.getSelection().addRange(range)
                        document.execCommand('copy')

                        if (window.getSelection().empty) {{  // Chrome
                          window.getSelection().empty();
                        }} else if (window.getSelection().removeAllRanges) {{  // Firefox
                          window.getSelection().removeAllRanges();
                        }}
                      }}
                    |]
                ]
                  [Html] -> [Html] -> [Html]
forall a. Semigroup a => a -> a -> a
<> [Maybe Html] -> [Html]
forall a. [Maybe a] -> [a]
catMaybes
                    [ PipelineConfig
pipelineConfig.report.input Maybe ReportInput -> (ReportInput -> Maybe String) -> Maybe String
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (.js) Maybe String -> (String -> Maybe Html) -> Maybe Html
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
js -> Html -> Maybe Html
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html -> Html
script (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
toHtml String
js)
                    , PipelineConfig
pipelineConfig.report.input Maybe ReportInput -> (ReportInput -> Maybe String) -> Maybe String
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (.css) Maybe String -> (String -> Maybe Html) -> Maybe Html
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
css -> Html -> Maybe Html
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html -> Html
style (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"text/css" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
toHtml String
css)
                    ]
          , (Html -> Html) -> Html -> Html
forall {a}. (a -> a) -> a -> a
idIfMarkdown Html -> Html
body (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
              [Html] -> Html
forall a. ToMarkup a => a -> Html
toHtml ([Html] -> Html) -> ([[Html]] -> [Html]) -> [[Html]] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Html] -> Html
forall a. ToMarkup a => a -> Html
toHtml ([Html] -> Html) -> [[Html]] -> [Html]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([[Html]] -> Html) -> [[Html]] -> Html
forall a b. (a -> b) -> a -> b
$
                [
                  [ Html -> Html
h2 Html
"Overview"
                  , Html -> Html
p
                      [fmt|
                        We translate EO files into initial PHI programs.
                        Next, we normalize these programs and get normalized PHI programs.
                        Then, we collect metrics for initial and normalized PHI programs.
                      |]
                  , Html -> Html
h2 Html
"Metrics"
                  , Html -> Html
p
                      [fmt|
                        An EO file contains multiple test objects.
                        After translation, these test objects become attributes in PHI programs.
                        We call these attributes "tests".
                      |]
                  , Html -> Html
p
                      [fmt|
                        We collect metrics on the number of {intercalate ", " (toListMetrics metricsNames)} in tests.
                        We want normalized tests to have less such elements than initial tests do.
                      |]
                  , Html -> Html
p Html
"A metric change for a test is calculated by the formula"
                  , Html -> Html
p (Html -> Html
code Html
"(metric_initial - metric_normalized) / metric_initial")
                  , Html -> Html
p Html
"where:"
                  , Html -> Html
ul
                      ( [Html] -> Html
forall a. ToMarkup a => a -> Html
toHtml
                          [ Html -> Html
li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
code Html
"metric_initial" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
" is the metric for the initial test"
                          , Html -> Html
li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
code Html
"metric_normalized" Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
" is the metric for the normalized test"
                          ]
                      )
                  , Html -> Html
h3 Html
"Expected"
                  , Html -> Html
p [fmt|Metric changes are expected to be as follows or greater:|]
                  , Html -> Html
ul
                      ( [Html] -> Html
forall a. ToMarkup a => a -> Html
toHtml ([Html] -> Html)
-> (Metrics Html -> [Html]) -> Metrics Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metrics Html -> [Html]
forall a. Metrics a -> [a]
toListMetrics (Metrics Html -> Html) -> Metrics Html -> Html
forall a b. (a -> b) -> a -> b
$
                          String -> Percent -> Html
mkPercentItem
                            (String -> Percent -> Html)
-> Metrics String -> Metrics (Percent -> Html)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Metrics String
metricsNames
                            Metrics (Percent -> Html) -> Metrics Percent -> Metrics Html
forall a b. Metrics (a -> b) -> Metrics a -> Metrics b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PipelineConfig
pipelineConfig.report.expectedMetricsChange
                      )
                  , Html -> Html
p
                      ( let expectedImprovedProgramsPercentage :: Percent
expectedImprovedProgramsPercentage = PipelineConfig
pipelineConfig.report.expectedImprovedProgramsPercentage
                         in [fmt|We expect such changes for at least {expectedImprovedProgramsPercentage:s} of tests.|]
                      )
                  , Html -> Html
h3 Html
"Actual"
                  , Html -> Html
p [fmt|We normalized {testsCount} tests.|]
                  , Html -> Html
p [fmt|All metrics were improved for {mkNumber allGoodMetricsCount testsCount} tests.|]
                  , Html -> Html
p [fmt|Tests where a particular metric was improved:|]
                  , Html -> Html
ul
                      ( [Html] -> Html
forall a. ToMarkup a => a -> Html
toHtml ([Html] -> Html)
-> (Metrics Html -> [Html]) -> Metrics Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metrics Html -> [Html]
forall a. Metrics a -> [a]
toListMetrics (Metrics Html -> Html) -> Metrics Html -> Html
forall a b. (a -> b) -> a -> b
$
                          String -> Int -> Html
mkItem'
                            (String -> Int -> Html) -> Metrics String -> Metrics (Int -> Html)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Metrics String
metricsNames
                            Metrics (Int -> Html) -> MetricsCount -> Metrics Html
forall a b. Metrics (a -> b) -> Metrics a -> Metrics b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MetricsCount
particularMetricsChangeGoodCount
                      )
                  , Html -> Html
h2 Html
"Table"
                  , Html -> Html
p [fmt|The table below provides detailed information about tests.|]
                  ]
                , [Html] -> [Html]
forall {a}. Monoid a => a -> a
memptyIfMarkdown
                    [ Html
TBH.input Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"button" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value AttributeValue
"Copy to Clipboard" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
onclick AttributeValue
"copytable('table')"
                    , Html -> Html
h3 Html
"Columns"
                    , Html -> Html
p Html
"Columns in this table are sortable."
                    , Html -> Html
p Html
"Hover over a header cell from the second row of header cells (Attribute Initial, etc.) to see a triangle demonstrating the sorting order."
                    , Html -> Html
ul
                        ( [Html] -> Html
forall a. ToMarkup a => a -> Html
toHtml
                            [ Html -> Html
li Html
"▾: descending"
                            , Html -> Html
li Html
"▴: ascending"
                            , Html -> Html
li Html
"▸: unordered"
                            ]
                        )
                    , Html -> Html
p Html
"Click on the triangle to change the sorting order in the corresponding column."
                    ]
                ,
                  [ Html -> Html
table (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"sortable" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
id AttributeValue
"table" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
                      [Html] -> Html
forall a. ToMarkup a => a -> Html
toHtml
                        [ Html
toHtmlReportTableHeader
                        , Html -> Html
tbody (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Html] -> Html
forall a. ToMarkup a => a -> Html
toHtml ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$
                            (Int -> ReportRow -> Html) -> (Int, ReportRow) -> Html
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ReportFormat -> Int -> ReportRow -> Html
toHtmlReportRow ReportFormat
reportFormat)
                              ((Int, ReportRow) -> Html) -> [(Int, ReportRow)] -> [Html]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> [ReportRow] -> [(Int, ReportRow)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] ([[ReportRow]] -> [ReportRow]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ProgramReport
programReport.bindingsRows | ProgramReport
programReport <- Report
report.programReports])
                        ]
                  ]
                ]
          ]
    ]
 where
  isMarkdown :: Bool
isMarkdown = ReportFormat
reportFormat ReportFormat -> ReportFormat -> Bool
forall a. Eq a => a -> a -> Bool
== ReportFormat
ReportFormat'Markdown
  idIfMarkdown :: (a -> a) -> a -> a
idIfMarkdown a -> a
f = if Bool
isMarkdown then a -> a
forall a. a -> a
Prelude.id else a -> a
f
  memptyIfMarkdown :: a -> a
memptyIfMarkdown a
f = if Bool
isMarkdown then a
forall a. Monoid a => a
mempty else a
f

  tests :: [ReportRow]
tests = (ProgramReport -> [ReportRow]) -> [ProgramReport] -> [ReportRow]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (.bindingsRows) Report
report.programReports

  testsCount :: Int
testsCount = [ReportRow] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ReportRow]
tests

  metricsChanges :: [MetricsChangeCategorized]
metricsChanges = (.metricsChange) (ReportRow -> MetricsChangeCategorized)
-> [ReportRow] -> [MetricsChangeCategorized]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProgramReport -> [ReportRow]) -> [ProgramReport] -> [ReportRow]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (.bindingsRows) Report
report.programReports

  isGood :: MetricsChangeCategory a -> Bool
isGood = \case
    MetricsChange'Good a
_ -> Bool
True
    MetricsChangeCategory a
_ -> Bool
False

  countAllMetricsSatisfyingCondition :: (MetricsChangeCategory Percent -> Bool) -> Int
countAllMetricsSatisfyingCondition MetricsChangeCategory Percent -> Bool
cond = [MetricsChangeCategorized] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([MetricsChangeCategorized] -> Int)
-> [MetricsChangeCategorized] -> Int
forall a b. (a -> b) -> a -> b
$ (MetricsChangeCategorized -> Bool)
-> [MetricsChangeCategorized] -> [MetricsChangeCategorized]
forall a. (a -> Bool) -> [a] -> [a]
filter ((MetricsChangeCategory Percent -> Bool)
-> MetricsChangeCategorized -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all MetricsChangeCategory Percent -> Bool
cond) [MetricsChangeCategorized]
metricsChanges
  allGoodMetricsCount :: Int
allGoodMetricsCount = (MetricsChangeCategory Percent -> Bool) -> Int
countAllMetricsSatisfyingCondition MetricsChangeCategory Percent -> Bool
forall {a}. MetricsChangeCategory a -> Bool
isGood

  particularMetricsChangeGoodCount :: Metrics Int
  particularMetricsChangeGoodCount :: MetricsCount
particularMetricsChangeGoodCount = [MetricsCount] -> MetricsCount
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([MetricsCount] -> MetricsCount) -> [MetricsCount] -> MetricsCount
forall a b. (a -> b) -> a -> b
$ ((\Bool
x -> if Bool
x then Int
1 else Int
0) (Bool -> Int)
-> (MetricsChangeCategory Percent -> Bool)
-> MetricsChangeCategory Percent
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetricsChangeCategory Percent -> Bool
forall {a}. MetricsChangeCategory a -> Bool
isGood (MetricsChangeCategory Percent -> Int)
-> MetricsChangeCategorized -> MetricsCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (MetricsChangeCategorized -> MetricsCount)
-> [MetricsChangeCategorized] -> [MetricsCount]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MetricsChangeCategorized]
metricsChanges

  mkItem' :: String -> Int -> Html
mkItem' = Int -> String -> Int -> Html
mkItem Int
testsCount

-- |
-- >>> renderHtml (mkItem 10 "foo" 4)
-- "<li><b>foo: </b>4 (40.00%)</li>"
mkItem :: Int -> String -> Int -> Html
mkItem :: Int -> String -> Int -> Html
mkItem Int
total String
name Int
part = Html -> Html
li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
b [fmt|{name}: |] Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> String -> Html
forall a. ToMarkup a => a -> Html
toHtml (Int -> Int -> String
mkNumber Int
part Int
total)

mkPercentItem :: String -> Percent -> Html
mkPercentItem :: String -> Percent -> Html
mkPercentItem String
name Percent
percent = Html -> Html
li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
b [fmt|{name}: |] Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Percent -> Html
forall a. ToMarkup a => a -> Html
toHtml Percent
percent

mkPercentage :: Int -> Int -> Percent
mkPercentage :: Int -> Int -> Percent
mkPercentage Int
part Int
total = Double -> Percent
Percent (Double -> Percent) -> Double -> Percent
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
part Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
total

-- |
-- >>> mkNumber 3 5
-- "3 (60.00%)"
mkNumber :: Int -> Int -> String
mkNumber :: Int -> Int -> String
mkNumber Int
part Int
total = [fmt|{part} ({mkPercentage part total:s})|]

toStringReport :: ReportFormat -> PipelineConfig -> Report -> String
toStringReport :: ReportFormat -> PipelineConfig -> Report -> String
toStringReport ReportFormat
reportFormat PipelineConfig
pipelineConfig Report
report = Html -> String
renderHtml (Html -> String) -> Html -> String
forall a b. (a -> b) -> a -> b
$ ReportFormat -> PipelineConfig -> Report -> Html
toHtmlReport ReportFormat
reportFormat PipelineConfig
pipelineConfig Report
report