Merge pull request #213 from objectionary/208-support-metrics-report-…

…generation 208 support metrics report generation
objectionary · Mar 25, 2024 · aec361c · aec361c · 0pdd · Mar 25, 2024
2 parents dc33eac + fa4e5ce
commit aec361c
Show file tree

Hide file tree

Showing 20 changed files with 1,248 additions and 164 deletions.
diff --git a/.github/workflows/ghc.yml b/.github/workflows/ghc.yml
@@ -57,10 +57,13 @@ jobs:
           submodules: true
 
       - name: 🧰 Setup Stack
-        uses: freckle/stack-action@v5
+        # TODO #208:10m replace with freckle/stack-action after https://github.com/freckle/stack-action/pull/69 is merged
+        uses: deemp/stack-action@main
         with:
           stack-build-arguments: ${{ github.ref_name != 'master' && '--fast' || '' }} --pedantic
-          test: ${{ matrix.os != 'windows-latest' }}
+          # TODO #213:10m enable macos test after https://github.com/objectionary/normalizer/issues/180 is resolved
+          # TODO #98:10m enable windows tests after https://github.com/objectionary/normalizer/issues/185 is resolved
+          test: ${{ matrix.os != 'windows-latest' && matrix.os != 'macos-latest'}}
 
       - uses: actions/setup-node@v4
         with:
@@ -75,6 +78,49 @@ jobs:
         shell: bash
         run: ./scripts/pipeline.sh
 
+      - name: Upload pipeline artifact
+        id: pipeline-artifact
+        if: always()
+        uses: actions/upload-artifact@v4
+        with:
+          name: pipeline-${{ runner.os }}-${{ hashFiles('pipeline/eo/*.eo') }}
+          overwrite: true
+          path: |
+            pipeline
+            !pipeline/**/.eoc
+            !pipeline/yaml
+            report
+
+      - name: Write about the artifact in the job summary
+        if: always()
+        shell: bash
+        run: |
+          cat << EOF >> $GITHUB_STEP_SUMMARY
+          <h2>Artifact</h2>
+          <p>
+            The artifact
+            <a href="${{ steps.pipeline-artifact.outputs.artifact-url }}">
+              pipeline-${{ runner.os }}-${{ hashFiles('pipeline/eo/*.eo') }}
+            </a> contains files used or produced during the pipeline run:
+          </p>
+          <ul>
+            <li>EO and PHI programs</li>
+            <li>Reports</li>
+          </ul>
+          EOF
+
+      - name: Write the report in the job summary
+        if: success()
+        shell: bash
+        run: |
+          cat << EOF >> $GITHUB_STEP_SUMMARY
+          <h2>Report</h2>
+          <details>
+            <summary>Click to expand</summary>
+            $(cat report/report.md)
+          </details>
+          EOF
+
   docs:
     needs: pipeline
     if: ${{ github.ref_name == 'master' }}
@@ -86,15 +132,17 @@ jobs:
         uses: actions/checkout@v4
 
       - name: 🧰 Setup Stack
-        uses: freckle/stack-action@v5
+        # TODO #208:10m replace with freckle/stack-action after https://github.com/freckle/stack-action/pull/69 is merged
+        uses: deemp/stack-action@main
         with:
           test: false
+          stack-build-arguments: --fast --haddock
 
-      - name: 🔨 Build Haddock Documentation (with Stack)
-        run: |
-          stack haddock
-          mkdir -p dist/haddock
-          mv $(stack path --local-doc-root)/* dist/haddock
+      - name: Download pipeline artifact
+        uses: actions/download-artifact@v4
+        with:
+          pattern: pipeline-${{ runner.os }}-*
+          merge-multiple: true
 
       - name: Setup mdBook
         uses: peaceiris/actions-mdbook@v1
@@ -103,12 +151,22 @@ jobs:
 
       - name: Build site
         run: |
+          ROOT=$PWD
+
+          mkdir -p dist/haddock
+          mv $(stack path --local-doc-root)/* dist/haddock
+
           cd site/docs
           mdbook build
           mv docs ../../dist
+          cd ../..
 
-          cd ..
+          cd site
           mv index.html ../dist
+          cd ..
+
+          mkdir -p dist/report
+          cp report/report.html dist/report/index.html
 
       - name: 🚀 Publish Site
         uses: JamesIves/github-pages-deploy-action@v4

diff --git a/eo-phi-normalizer/app/Main.hs b/eo-phi-normalizer/app/Main.hs
@@ -6,13 +6,15 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ParallelListComp #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -24,26 +26,31 @@
 
 module Main (main) where
 
-import Control.Monad (unless, when)
+import Control.Monad (forM, unless, when)
 import Data.Foldable (forM_)
 
 import Control.Exception (Exception (..), SomeException, catch, throw)
-import Control.Lens ((^.))
 import Data.Aeson (ToJSON)
 import Data.Aeson.Encode.Pretty (Config (..), Indent (..), defConfig, encodePrettyToTextBuilder')
 import Data.List (intercalate)
 import Data.String.Interpolate (i, iii)
 import Data.Text.Internal.Builder (toLazyText)
-import Data.Text.Lazy.Lens
+import Data.Text.Lazy as TL (unpack)
+import Data.Yaml (decodeFileThrow)
 import GHC.Generics (Generic)
 import Language.EO.Phi (Bytes (Bytes), Object (Formation), Program (Program), parseProgram, printTree)
 import Language.EO.Phi.Dataize (dataizeRecursively, dataizeRecursivelyChain, dataizeStep, dataizeStepChain)
-import Language.EO.Phi.Metrics (ProgramMetrics, getProgramMetrics, splitPath)
+import Language.EO.Phi.Metrics.Collect as Metrics (getProgramMetrics)
+import Language.EO.Phi.Metrics.Data as Metrics (ProgramMetrics (..), splitPath)
+import Language.EO.Phi.Report.Data (Report'InputConfig (..), Report'OutputConfig (..), ReportConfig (..), ReportItem (..), makeProgramReport, makeReport)
+import Language.EO.Phi.Report.Html (ReportFormat (..), reportCSS, reportJS, toStringReport)
+import Language.EO.Phi.Report.Html qualified as ReportHtml (ReportConfig (..))
 import Language.EO.Phi.Rules.Common (ApplicationLimits (ApplicationLimits), applyRulesChainWith, applyRulesWith, defaultContext, objectSize, propagateName1)
 import Language.EO.Phi.Rules.Yaml (RuleSet (rules, title), convertRuleNamed, parseRuleSetFromFile)
 import Options.Applicative hiding (metavar)
 import Options.Applicative qualified as Optparse (metavar)
-import System.Directory (doesFileExist)
+import System.Directory (createDirectoryIfMissing, doesFileExist)
+import System.FilePath (takeDirectory)
 import System.IO (IOMode (WriteMode), getContents', hFlush, hPutStr, hPutStrLn, openFile, stdout)
 
 data CLI'TransformPhi = CLI'TransformPhi
@@ -74,10 +81,16 @@ data CLI'MetricsPhi = CLI'MetricsPhi
   }
   deriving (Show)
 
+newtype CLI'ReportPhi = CLI'ReportPhi
+  { configFile :: FilePath
+  }
+  deriving (Show)
+
 data CLI
   = CLI'TransformPhi' CLI'TransformPhi
   | CLI'DataizePhi' CLI'DataizePhi
   | CLI'MetricsPhi' CLI'MetricsPhi
+  | CLI'ReportPhi' CLI'ReportPhi
   deriving (Show)
 
 fileMetavarName :: String
@@ -150,6 +163,7 @@ data CommandParser = CommandParser
   { metrics :: Parser CLI'MetricsPhi
   , transform :: Parser CLI'TransformPhi
   , dataize :: Parser CLI'DataizePhi
+  , report :: Parser CLI'ReportPhi
   }
 
 commandParser :: CommandParser
@@ -185,11 +199,17 @@ commandParser =
     recursive <- switch (long "recursive" <> help "Apply dataization + normalization recursively.")
     chain <- switch (long "chain" <> help "Display all the intermediate steps.")
     pure CLI'DataizePhi{..}
+  report = do
+    configFile <-
+      let file' = metavarName.file
+       in strOption (long "config" <> short 'c' <> metavar.file <> help [i|The #{file'} with a report configuration.|])
+    pure CLI'ReportPhi{..}
 
 data CommandParserInfo = CommandParserInfo
   { metrics :: ParserInfo CLI
   , transform :: ParserInfo CLI
   , dataize :: ParserInfo CLI
+  , report :: ParserInfo CLI
   }
 
 commandParserInfo :: CommandParserInfo
@@ -198,12 +218,14 @@ commandParserInfo =
     { metrics = info (CLI'MetricsPhi' <$> commandParser.metrics) (progDesc "Collect metrics for a PHI program.")
     , transform = info (CLI'TransformPhi' <$> commandParser.transform) (progDesc "Transform a PHI program.")
     , dataize = info (CLI'DataizePhi' <$> commandParser.dataize) (progDesc "Dataize a PHI program.")
+    , report = info (CLI'ReportPhi' <$> commandParser.report) (progDesc "Generate reports about initial and normalized PHI programs.")
     }
 
 data CommandNames = CommandNames
   { transform :: String
   , metrics :: String
   , dataize :: String
+  , report :: String
   }
 
 commandNames :: CommandNames
@@ -212,6 +234,7 @@ commandNames =
     { transform = "transform"
     , metrics = "metrics"
     , dataize = "dataize"
+    , report = "report"
     }
 
 cli :: Parser CLI
@@ -220,6 +243,7 @@ cli =
     ( command commandNames.transform commandParserInfo.transform
         <> command commandNames.metrics commandParserInfo.metrics
         <> command commandNames.dataize commandParserInfo.dataize
+        <> command commandNames.report commandParserInfo.report
     )
 
 cliOpts :: ParserInfo CLI
@@ -235,7 +259,7 @@ data StructuredJSON = StructuredJSON
   deriving (Generic, ToJSON)
 
 encodeToJSONString :: (ToJSON a) => a -> String
-encodeToJSONString = (^. unpacked) . toLazyText . encodePrettyToTextBuilder' defConfig{confIndent = Spaces 2}
+encodeToJSONString = TL.unpack . toLazyText . encodePrettyToTextBuilder' defConfig{confIndent = Spaces 2}
 
 pprefs :: ParserPrefs
 pprefs = prefs (showHelpOnEmpty <> showHelpOnError)
@@ -389,3 +413,46 @@ main = do
               Left obj -> logStrLn (printAsProgramOrAsObject obj)
               Right (Bytes bytes) -> logStrLn bytes
         )
+    CLI'ReportPhi' CLI'ReportPhi{..} -> do
+      reportConfig <- decodeFileThrow configFile
+
+      programReports <- forM reportConfig.items $ \item -> do
+        metricsPhi <- getMetrics item.bindingsPathPhi (Just item.phi)
+        metricsPhiNormalized <- getMetrics item.bindingsPathPhiNormalized (Just item.phiNormalized)
+        pure $ makeProgramReport reportConfig item metricsPhi metricsPhiNormalized
+
+      css <- maybe (pure reportCSS) readFile (reportConfig.input >>= (.css))
+      js <- maybe (pure reportJS) readFile (reportConfig.input >>= (.js))
+
+      let report = makeReport reportConfig programReports
+
+          reportConfigHtml =
+            ReportHtml.ReportConfig
+              { expectedMetricsChange = reportConfig.expectedMetricsChange
+              , format =
+                  ReportFormat'Html
+                    { ..
+                    }
+              }
+          reportHtml = toStringReport reportConfigHtml report
+
+          reportJson = encodeToJSONString report
+
+          reportConfigMarkdown =
+            ReportHtml.ReportConfig
+              { expectedMetricsChange = reportConfig.expectedMetricsChange
+              , format = ReportFormat'Markdown
+              }
+          reportMarkdown = toStringReport reportConfigMarkdown report
+
+      forM_ @[]
+        [ (x, y)
+        | (Just x, y) <-
+            [ (reportConfig.output.html, reportHtml)
+            , (reportConfig.output.json, reportJson)
+            , (reportConfig.output.markdown, reportMarkdown)
+            ]
+        ]
+        $ \(path, reportString) -> do
+          createDirectoryIfMissing True (takeDirectory path)
+          writeFile path reportString
diff --git a/eo-phi-normalizer/eo-phi-normalizer.cabal b/eo-phi-normalizer/eo-phi-normalizer.cabal
@@ -20,6 +20,8 @@ extra-source-files:
     README.md
     CHANGELOG.md
     grammar/EO/Phi/Syntax.cf
+    report/main.js
+    report/styles.css
 
 source-repository head
   type: git
@@ -35,8 +37,11 @@ library
   exposed-modules:
       Language.EO.Phi
       Language.EO.Phi.Dataize
-      Language.EO.Phi.Metrics
+      Language.EO.Phi.Metrics.Collect
+      Language.EO.Phi.Metrics.Data
       Language.EO.Phi.Normalize
+      Language.EO.Phi.Report.Data
+      Language.EO.Phi.Report.Html
       Language.EO.Phi.Rules.Common
       Language.EO.Phi.Rules.PhiPaper
       Language.EO.Phi.Rules.Yaml
@@ -62,11 +67,15 @@ library
       aeson
     , array >=0.5.5.0
     , base >=4.7 && <5
+    , blaze-html
+    , blaze-markup
     , directory
+    , file-embed
     , filepath
     , generic-lens
     , lens
     , mtl
+    , scientific
     , string-interpolate
     , template-haskell
     , text
@@ -92,13 +101,17 @@ executable normalizer
     , aeson-pretty
     , array >=0.5.5.0
     , base >=4.7 && <5
+    , blaze-html
+    , blaze-markup
     , directory
     , eo-phi-normalizer
+    , file-embed
     , filepath
     , generic-lens
     , lens
     , mtl
     , optparse-applicative
+    , scientific
     , string-interpolate
     , template-haskell
     , text
@@ -132,14 +145,18 @@ test-suite spec
     , aeson
     , array >=0.5.5.0
     , base >=4.7 && <5
+    , blaze-html
+    , blaze-markup
     , directory
     , eo-phi-normalizer
+    , file-embed
     , filepath
     , generic-lens
     , hspec
     , hspec-discover
     , lens
     , mtl
+    , scientific
     , string-interpolate
     , template-haskell
     , text

diff --git a/eo-phi-normalizer/package.yaml b/eo-phi-normalizer/package.yaml
@@ -11,6 +11,7 @@ extra-source-files:
   - README.md
   - CHANGELOG.md
   - grammar/EO/Phi/Syntax.cf
+  - report/*
 
 verbatim:
   cabal-version: 1.24
@@ -48,6 +49,10 @@ dependencies:
   - generic-lens
   - text
   - template-haskell
+  - blaze-html
+  - blaze-markup
+  - scientific
+  - file-embed
 
 default-extensions:
   - ImportQualifiedPost