{- 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 DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-partial-fields #-}

module Language.EO.Phi.Report.Data where

import Language.EO.Phi.Metrics.Data (BindingMetrics (..), Metrics (..), MetricsCount, ProgramMetrics)
import Language.EO.Phi.Metrics.Data qualified as Metrics
import Language.EO.Phi.Pipeline.Config
import Language.EO.Phi.TH (deriveJSON)
import Prelude hiding (div, id, span)

data ReportRow = ReportRow
  { ReportRow -> Maybe FilePath
fileInitial :: Maybe FilePath
  , ReportRow -> Maybe FilePath
fileNormalized :: Maybe FilePath
  , ReportRow -> Maybe Path
bindingsPathInitial :: Maybe Metrics.Path
  , ReportRow -> Maybe Path
bindingsPathNormalized :: Maybe Metrics.Path
  , ReportRow -> Maybe FilePath
attributeInitial :: Maybe String
  , ReportRow -> Maybe FilePath
attributeNormalized :: Maybe String
  , ReportRow -> MetricsChangeCategorized
metricsChange :: MetricsChangeCategorized
  , ReportRow -> Metrics Int
metricsInitial :: Metrics Int
  , ReportRow -> Metrics Int
metricsNormalized :: Metrics Int
  }

$(deriveJSON ''ReportRow)

data ProgramReport = ProgramReport
  { ProgramReport -> ReportRow
programRow :: ReportRow
  , ProgramReport -> [ReportRow]
bindingsRows :: [ReportRow]
  }

$(deriveJSON ''ProgramReport)

data Report = Report
  { Report -> ReportRow
totalRow :: ReportRow
  , Report -> [ProgramReport]
programReports :: [ProgramReport]
  }

$(deriveJSON ''Report)

-- >>> calculateMetricsChange Metrics { dataless = 0.1, applications = 0.2, formations = 0.2, dispatches = 0.2 } Metrics { dataless = 100, applications = 0, formations = 100, dispatches = 100 } Metrics { dataless = 90, applications = 0, formations = 93, dispatches = 60 }
-- Metrics {formations = MetricsChange'Bad {change = 7.00%}, dataless = MetricsChange'Good {change = 10.00%}, applications = MetricsChange'NA, dispatches = MetricsChange'Good {change = 40.00%}}
calculateMetricsChange :: MetricsChange -> MetricsCount -> MetricsCount -> MetricsChangeCategorized
calculateMetricsChange :: MetricsChange
-> Metrics Int -> Metrics Int -> MetricsChangeCategorized
calculateMetricsChange MetricsChange
expectedMetricsChange Metrics Int
countInitial Metrics Int
countNormalized =
  Percent -> Percent -> MetricsChangeCategory Percent
getMetricsChangeClassified (Percent -> Percent -> MetricsChangeCategory Percent)
-> MetricsChange
-> Metrics (Percent -> MetricsChangeCategory Percent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MetricsChange
expectedMetricsChange Metrics (Percent -> MetricsChangeCategory Percent)
-> MetricsChange -> MetricsChangeCategorized
forall a b. Metrics (a -> b) -> Metrics a -> Metrics b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MetricsChange
actualMetricsChange
 where
  isFinite :: (RealFloat a) => a -> Bool
  isFinite :: forall a. RealFloat a => a -> Bool
isFinite a
x = Bool -> Bool
not (a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x)

  getMetricsChangeClassified :: Percent -> Percent -> MetricsChangeCategory Percent
  getMetricsChangeClassified :: Percent -> Percent -> MetricsChangeCategory Percent
getMetricsChangeClassified Percent
expected Percent
actual
    | Percent -> Bool
forall a. RealFloat a => a -> Bool
isFinite Percent
expected Bool -> Bool -> Bool
&& Percent -> Bool
forall a. RealFloat a => a -> Bool
isFinite Percent
actual =
        if Percent
actual Percent -> Percent -> Bool
forall a. Ord a => a -> a -> Bool
>= Percent
expected
          then Percent -> MetricsChangeCategory Percent
forall a. a -> MetricsChangeCategory a
MetricsChange'Good Percent
actual
          else Percent -> MetricsChangeCategory Percent
forall a. a -> MetricsChangeCategory a
MetricsChange'Bad Percent
actual
    | Bool
otherwise = MetricsChangeCategory Percent
forall a. MetricsChangeCategory a
MetricsChange'NA

  actualMetricsChange :: MetricsChange
  actualMetricsChange :: MetricsChange
actualMetricsChange = (MetricsChange
initial MetricsChange -> MetricsChange -> MetricsChange
forall a. Num a => a -> a -> a
- MetricsChange
normalized) MetricsChange -> MetricsChange -> MetricsChange
forall a. Fractional a => a -> a -> a
/ MetricsChange
initial
  initial :: MetricsChange
initial = Int -> Percent
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Percent) -> Metrics Int -> MetricsChange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Metrics Int
countInitial
  normalized :: MetricsChange
normalized = Int -> Percent
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Percent) -> Metrics Int -> MetricsChange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Metrics Int
countNormalized

makeProgramReport :: PipelineConfig -> TestSetPhi -> ProgramMetrics -> ProgramMetrics -> ProgramReport
makeProgramReport :: PipelineConfig
-> TestSetPhi -> ProgramMetrics -> ProgramMetrics -> ProgramReport
makeProgramReport PipelineConfig
pipelineConfig TestSetPhi
testSet ProgramMetrics
metricsPhi ProgramMetrics
metricsPhiNormalized =
  ProgramReport{[ReportRow]
ReportRow
$sel:programRow:ProgramReport :: ReportRow
$sel:bindingsRows:ProgramReport :: [ReportRow]
bindingsRows :: [ReportRow]
programRow :: ReportRow
..}
 where
  bindingsRows :: [ReportRow]
bindingsRows =
    case (ProgramMetrics
metricsPhi.bindingsByPathMetrics, ProgramMetrics
metricsPhiNormalized.bindingsByPathMetrics) of
      (Just BindingsByPathMetrics
bindingsMetricsInitial, Just BindingsByPathMetrics
bindingsMetricsNormalized) ->
        [ ReportRow
          { $sel:fileInitial:ReportRow :: Maybe FilePath
fileInitial = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just TestSetPhi
testSet.initial
          , $sel:fileNormalized:ReportRow :: Maybe FilePath
fileNormalized = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just TestSetPhi
testSet.normalized
          , $sel:bindingsPathInitial:ReportRow :: Maybe Path
bindingsPathInitial = Path -> Maybe Path
forall a. a -> Maybe a
Just BindingsByPathMetrics
bindingsMetricsInitial.path
          , $sel:bindingsPathNormalized:ReportRow :: Maybe Path
bindingsPathNormalized = Path -> Maybe Path
forall a. a -> Maybe a
Just BindingsByPathMetrics
bindingsMetricsNormalized.path
          , $sel:attributeInitial:ReportRow :: Maybe FilePath
attributeInitial = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
attributeInitial
          , $sel:attributeNormalized:ReportRow :: Maybe FilePath
attributeNormalized = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
attributeNormalized
          , $sel:metricsChange:ReportRow :: MetricsChangeCategorized
metricsChange = MetricsChange
-> Metrics Int -> Metrics Int -> MetricsChangeCategorized
calculateMetricsChange PipelineConfig
pipelineConfig.report.expectedMetricsChange Metrics Int
metricsInitial Metrics Int
metricsNormalized
          , $sel:metricsInitial:ReportRow :: Metrics Int
metricsInitial = Metrics Int
metricsInitial
          , $sel:metricsNormalized:ReportRow :: Metrics Int
metricsNormalized = Metrics Int
metricsNormalized
          }
        | BindingMetrics{$sel:name:BindingMetrics :: BindingMetrics -> FilePath
name = FilePath
attributeInitial, $sel:metrics:BindingMetrics :: BindingMetrics -> Metrics Int
metrics = Metrics Int
metricsInitial} <- BindingsByPathMetrics
bindingsMetricsInitial.bindingsMetrics
        | BindingMetrics{$sel:name:BindingMetrics :: BindingMetrics -> FilePath
name = FilePath
attributeNormalized, $sel:metrics:BindingMetrics :: BindingMetrics -> Metrics Int
metrics = Metrics Int
metricsNormalized} <- BindingsByPathMetrics
bindingsMetricsNormalized.bindingsMetrics
        ]
      (Maybe BindingsByPathMetrics, Maybe BindingsByPathMetrics)
_ -> []
  programRow :: ReportRow
programRow =
    ReportRow
      { $sel:fileInitial:ReportRow :: Maybe FilePath
fileInitial = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just TestSetPhi
testSet.initial
      , $sel:fileNormalized:ReportRow :: Maybe FilePath
fileNormalized = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just TestSetPhi
testSet.normalized
      , $sel:bindingsPathInitial:ReportRow :: Maybe Path
bindingsPathInitial = Maybe Path
forall a. Maybe a
Nothing
      , $sel:bindingsPathNormalized:ReportRow :: Maybe Path
bindingsPathNormalized = Maybe Path
forall a. Maybe a
Nothing
      , $sel:attributeInitial:ReportRow :: Maybe FilePath
attributeInitial = Maybe FilePath
forall a. Maybe a
Nothing
      , $sel:attributeNormalized:ReportRow :: Maybe FilePath
attributeNormalized = Maybe FilePath
forall a. Maybe a
Nothing
      , $sel:metricsChange:ReportRow :: MetricsChangeCategorized
metricsChange = MetricsChange
-> Metrics Int -> Metrics Int -> MetricsChangeCategorized
calculateMetricsChange PipelineConfig
pipelineConfig.report.expectedMetricsChange ProgramMetrics
metricsPhi.programMetrics ProgramMetrics
metricsPhiNormalized.programMetrics
      , $sel:metricsInitial:ReportRow :: Metrics Int
metricsInitial = ProgramMetrics
metricsPhi.programMetrics
      , $sel:metricsNormalized:ReportRow :: Metrics Int
metricsNormalized = ProgramMetrics
metricsPhiNormalized.programMetrics
      }

makeReport :: PipelineConfig -> [ProgramReport] -> Report
makeReport :: PipelineConfig -> [ProgramReport] -> Report
makeReport PipelineConfig
pipelineConfig [ProgramReport]
programReports =
  Report{[ProgramReport]
ReportRow
$sel:totalRow:Report :: ReportRow
$sel:programReports:Report :: [ProgramReport]
programReports :: [ProgramReport]
totalRow :: ReportRow
..}
 where
  programRows :: [ReportRow]
programRows = (.programRow) (ProgramReport -> ReportRow) -> [ProgramReport] -> [ReportRow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ProgramReport]
programReports
  metricsInitial :: Metrics Int
metricsInitial = (ReportRow -> Metrics Int) -> [ReportRow] -> Metrics Int
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (.metricsInitial) [ReportRow]
programRows
  metricsNormalized :: Metrics Int
metricsNormalized = (ReportRow -> Metrics Int) -> [ReportRow] -> Metrics Int
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (.metricsNormalized) [ReportRow]
programRows
  metricsChange :: MetricsChangeCategorized
metricsChange = MetricsChange
-> Metrics Int -> Metrics Int -> MetricsChangeCategorized
calculateMetricsChange PipelineConfig
pipelineConfig.report.expectedMetricsChange Metrics Int
metricsInitial Metrics Int
metricsNormalized
  totalRow :: ReportRow
totalRow =
    ReportRow
      { $sel:fileInitial:ReportRow :: Maybe FilePath
fileInitial = Maybe FilePath
forall a. Maybe a
Nothing
      , $sel:fileNormalized:ReportRow :: Maybe FilePath
fileNormalized = Maybe FilePath
forall a. Maybe a
Nothing
      , $sel:bindingsPathInitial:ReportRow :: Maybe Path
bindingsPathInitial = Maybe Path
forall a. Maybe a
Nothing
      , $sel:bindingsPathNormalized:ReportRow :: Maybe Path
bindingsPathNormalized = Maybe Path
forall a. Maybe a
Nothing
      , $sel:attributeInitial:ReportRow :: Maybe FilePath
attributeInitial = Maybe FilePath
forall a. Maybe a
Nothing
      , $sel:attributeNormalized:ReportRow :: Maybe FilePath
attributeNormalized = Maybe FilePath
forall a. Maybe a
Nothing
      , Metrics Int
MetricsChangeCategorized
$sel:metricsChange:ReportRow :: MetricsChangeCategorized
$sel:metricsInitial:ReportRow :: Metrics Int
$sel:metricsNormalized:ReportRow :: Metrics Int
metricsInitial :: Metrics Int
metricsNormalized :: Metrics Int
metricsChange :: MetricsChangeCategorized
..
      }