From 2aaa275011717ef3d51c3562cc83f9d1821dd35f Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Sat, 20 Mar 2021 10:26:25 -0400
Subject: Display hotspots graph and stacked line charts

I think I should change the colors a bit... to be done later I suppose.
---
 Biz/Devalloc.hs | 223 ++++++++++++++++++++++++++++++++++++--------------------
 Biz/Look.hs     |   9 +++
 2 files changed, 153 insertions(+), 79 deletions(-)

diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs
index 2131983..0f6bf94 100644
--- a/Biz/Devalloc.hs
+++ b/Biz/Devalloc.hs
@@ -304,13 +304,15 @@ data Analysis = Analysis
     liabilities :: [Text],
     -- | Map of path to number of commits, for detecting paths that continually
     -- get rewritten.
-    hotspotMap :: Map FilePath Int,
+    hotspotMap :: Map FilePath Integer,
     -- | Files that have not been touched in 6 months
-    stale :: [(FilePath, Int)],
+    stale :: [(FilePath, Integer)],
     -- | Total score for the repo
     score :: Integer,
     -- | Total number of files
     totalFiles :: Integer,
+    -- | The total number of commits
+    totalCommits :: Integer,
     -- | List of all the active users we care about
     activeAuthors :: [Text],
     -- | Which commit this analysis was run against.
@@ -326,6 +328,8 @@ instance SafeCopy.Migrate Analysis where
     Analysis
       { analysisId = Id.mk (Proxy :: Proxy Analysis) <| Id.untag analysisId,
         hotspotMap = mempty,
+        totalCommits = 0,
+        stale = map (second toInteger) stale,
         ..
       }
 
@@ -690,6 +694,7 @@ instance (Lucid.ToHtml a, App.HasCss a) => Lucid.ToHtml (App.Html a) where
         jsRef "//unpkg.com/turbolinks@5.2.0/dist/turbolinks.js"
         -- base styles
         style baseStyle
+        cssRef "//unpkg.com/charts.css/dist/charts.min.css"
         -- page styles
         style <| App.cssFor x
       Lucid.body_ (Lucid.toHtml x)
@@ -702,6 +707,12 @@ instance (Lucid.ToHtml a, App.HasCss a) => Lucid.ToHtml (App.Html a) where
             Lucid.makeAttribute "async" mempty,
             Lucid.makeAttribute "defer" mempty
           ]
+      cssRef _href =
+        Lucid.with
+          (Lucid.link_ mempty)
+          [ Lucid.makeAttribute "rel" "stylesheet",
+            Lucid.makeAttribute "href" _href
+          ]
 
 -- | All of the routes in the app.
 data Paths path = Paths
@@ -1334,92 +1345,139 @@ instance Lucid.ToHtml AnalysisDisplay where
 
 instance App.HasCss Analysis where
   cssFor _ = do
-    Clay.display Clay.grid
-    Clay.justifyContent Clay.spaceAround
-    Biz.Look.rowGap (rem 2)
-    Biz.Look.marginY (rem 1)
-    Biz.Look.gridTemplateAreas
-      [ "analysisFor",
-        "metrics"
-      ]
-    ".metrics" ? do
-      Clay.gridTemplateColumns [pct 50, pct 50]
-      Clay.display Clay.grid
-      Biz.Look.columnGap (em 2)
-      Biz.Look.rowGap (em 2)
+    "#analysis > *" ? do
+      Biz.Look.marginAll (rem 2)
     ".score" ? do
+      Clay.display Clay.grid
+      Biz.Look.gridTemplateAreas
+        [ "title quantity details-collapsed",
+          "preview-chart preview-chart preview-chart",
+          "details details details"
+        ]
+      Clay.alignItems Clay.baseline
+      Clay.gridTemplateColumns [pct 30, 40, 30]
+      Biz.Look.gridTemplateRows ["auto"]
+    ".title" ? do
+      Biz.Look.gridArea "title"
+      Clay.fontSize (rem 1.4)
+      Clay.lineHeight (rem 2.4)
+    ".percentage" ? do
+      Biz.Look.gridArea "quantity"
       Clay.display Clay.flex
-      Clay.flexDirection Clay.column
-      ".title" ? do
-        Clay.fontSize (rem 1.4)
-        Clay.lineHeight (rem 2.4)
-      ".percentage" ? do
-        Clay.display Clay.flex
-        Clay.alignItems Clay.baseline
-        ".centum" ? do
-          Clay.fontSize (rem 1.2)
-          Clay.lineHeight (rem 1.2)
-      ".quantity" ? do
-        Clay.fontSize (rem 3)
-        Clay.lineHeight (rem 3)
-      "details" ? do
-        Biz.Look.gridArea "details-collapsed"
-      "details[open]" ? do
-        Biz.Look.gridArea "details"
+      Clay.alignItems Clay.baseline
+      ".centum" ? do
+        Clay.fontSize (rem 1.2)
+        Clay.lineHeight (rem 1.2)
+    ".quantity" ? do
+      Biz.Look.gridArea "quantity"
+      Clay.fontSize (rem 3)
+      Clay.lineHeight (rem 3)
+    ".preview-chart" ? do
+      Biz.Look.gridArea "preview-chart"
+    "details" ? do
+      Biz.Look.gridArea "details-collapsed"
+      Biz.Look.justifySelf <| Clay.JustifyContentValue "self-end"
+    "details[open]" ? do
+      Biz.Look.gridArea "details"
+      Biz.Look.justifySelf <| Clay.JustifyContentValue "auto"
+    ".preview-chart" ? do
+      Clay.height (px 2)
+      Clay.maxWidth (pct 100)
+    "table" ? do
+      Biz.Look.marginAll (px 0)
+      Clay.maxWidth (pct 100)
+    "#hotspots" ? do
+      ".preview-chart" ? do
+        Clay.height (rem 1)
+        "table" ? do
+          Clay.height (rem 4)
+          Clay.marginTop (rem (-3))
+          Clay.zIndex (-1)
+      ".bar" ? do
+        Clay.height (px 800)
 
 instance Lucid.ToHtml Analysis where
   toHtmlRaw = Lucid.toHtml
   toHtml Analysis {..} =
-    Lucid.div_ <| do
-      Lucid.p_ [Lucid.class_ ".analysisFor"] <| do
+    Lucid.div_ [Lucid.id_ "analysis"] <| do
+      Lucid.p_ [Lucid.class_ "analysisFor"] <| do
         "Analysis for "
         Lucid.a_ [Lucid.href_ <| (\(URL txt) -> txt) <| url] <| do
           Lucid.toHtml url
 
-      Lucid.div_ [Lucid.class_ "metrics"] <| do
-        score_ <| do
-          title_ "Total Score"
-          percentage_ <| do
-            quantity_ <| Lucid.toHtml <| tshow score
-            centum_ "/100"
-
-        score_ <| do
-          title_ "Total Files"
-          quantity_ <| Lucid.toHtml <| tshow totalFiles
-
-        score_ <| do
-          title_ "Active authors"
-          quantity_ <| Lucid.toHtml <| slen activeAuthors
-          Lucid.details_ <| do
-            Lucid.summary_ "Details"
-            Lucid.ul_ <| forM_ activeAuthors <| \author -> do
-              Lucid.li_ <| Lucid.toHtml author
-
-        score_ <| do
-          title_ "Blackholes"
-          quantity_ <| Lucid.toHtml <| slen blackholes
-          Lucid.details_ <| do
-            Lucid.summary_ "Details"
-            Lucid.ul_ <| do
-              traverse_ (Lucid.toHtml .> Lucid.li_) blackholes
-
-        score_ <| do
-          title_ "Liabilities"
-          quantity_ <| Lucid.toHtml <| slen liabilities
-          Lucid.details_ <| do
-            Lucid.summary_ "Details"
-            Lucid.ul_ <| do
-              traverse_ (Lucid.toHtml .> Lucid.li_) liabilities
-
-        score_ <| do
-          title_ "Stale files"
-          quantity_ <| Lucid.toHtml <| slen stale
-          Lucid.details_ <| do
-            Lucid.summary_ "Details"
-            Lucid.ul_ <| do
-              forM_ stale <| \(path, days) ->
-                Lucid.li_ <| Lucid.toHtml <| path <> " (" <> show days <> " days)"
+      score_ <| do
+        title_ "Total Score"
+        percentage_ <| do
+          quantity_ <| Lucid.toHtml <| tshow score
+          centum_ "/100"
+        previewChart <| simpleBar score 100
+
+      score_ <| do
+        title_ "Total Files"
+        quantity_ <| Lucid.toHtml <| tshow totalFiles
+
+      score_ <| do
+        title_ "Active authors"
+        quantity_ <| Lucid.toHtml <| slen activeAuthors
+        Lucid.details_ <| do
+          Lucid.summary_ "Details"
+          Lucid.ul_ <| forM_ activeAuthors <| \author -> do
+            Lucid.li_ <| Lucid.toHtml author
+
+      score_ <| do
+        title_ "Blackholes"
+        quantity_ <| Lucid.toHtml <| slen blackholes
+        previewChart <| simpleBar (len blackholes) totalFiles
+        Lucid.details_ <| do
+          Lucid.summary_ "Details"
+          Lucid.ul_ <| do
+            traverse_ (Lucid.toHtml .> Lucid.li_) blackholes
+
+      score_ <| do
+        title_ "Liabilities"
+        quantity_ <| Lucid.toHtml <| slen liabilities
+        previewChart <| simpleBar (len liabilities) totalFiles
+        Lucid.details_ <| do
+          Lucid.summary_ "Details"
+          Lucid.ul_ <| do
+            traverse_ (Lucid.toHtml .> Lucid.li_) liabilities
+
+      score_ <| do
+        title_ "Stale files"
+        quantity_ <| Lucid.toHtml <| slen stale
+        previewChart <| simpleBar (len stale) totalFiles
+        Lucid.details_ <| do
+          Lucid.summary_ "Details"
+          Lucid.ul_ <| do
+            forM_ stale <| \(path, days) ->
+              Lucid.li_ <| Lucid.toHtml <| path <> " (" <> show days <> " days)"
+
+      Lucid.with score_ [Lucid.id_ "hotspots"] <| do
+        title_ "Hotspots"
+        quantity_ "2" -- TODO
+        previewChart <| do
+          Lucid.table_ [Lucid.class_ "charts-css column"] <| do
+            Lucid.tr_ <| do
+              forM_ (Map.toList hotspotMap) <| \(_, n) -> do
+                Lucid.td_ [Lucid.style_ <| size n totalCommits] ""
+        Lucid.details_ <| do
+          Lucid.summary_ "Details"
+          Lucid.table_ [Lucid.class_ "charts-css bar"] <| do
+            Lucid.tr_ <| do
+              forM_ (Map.toList hotspotMap) <| \(path, n) -> do
+                Lucid.td_ [Lucid.style_ <| size n totalCommits] <| do
+                  Lucid.span_ [Lucid.class_ "tooltip"]
+                    <| Lucid.toHtml
+                    <| path <> ": " <> show n <> " commits"
     where
+      simpleBar :: Monad m => Integer -> Integer -> Lucid.HtmlT m ()
+      simpleBar n total = do
+        Lucid.table_ [Lucid.class_ "charts-css bar stacked multiple"] <| do
+          Lucid.tr_ <| do
+            Lucid.td_ [Lucid.style_ <| size n total] ""
+            <> Lucid.td_ [Lucid.style_ <| size total total] ""
+
+      len = toInteger <. length
       slen = tshow <. length
       div_ c = Lucid.with Lucid.div_ [Lucid.class_ c]
       score_ = div_ "score"
@@ -1427,6 +1485,8 @@ instance Lucid.ToHtml Analysis where
       quantity_ = div_ "quantity"
       centum_ = div_ "centum"
       percentage_ = div_ "percentage"
+      size n total = "--size: calc(" <> show n <> "/" <> show total <> ")"
+      previewChart = div_ "preview-chart"
 
 -- | Run a full analysis on a git repo
 analyze :: Acid.AcidState Keep -> Id.Id User -> [Text] -> URL -> FilePath -> Bool -> IO Analysis
@@ -1469,6 +1529,11 @@ analyze keep askedBy activeAuthors url bareRepo repoPrivate = do
       let numTotal = realToFrac <| length tree
       hotspotMap <-
         Map.fromList </ Async.mapConcurrently getChangeCount tree
+      totalCommits <-
+        git ["rev-list", "--count", "HEAD"]
+          /> filter (/= '\n')
+          /> readMaybe
+          /> fromMaybe 0
       Analysis
         { analysisId = mempty,
           stale =
@@ -1487,7 +1552,7 @@ analyze keep askedBy activeAuthors url bareRepo repoPrivate = do
     third :: (a, b, c) -> c
     third (_, _, a) = a
     git args = Process.readProcess "git" (["--git-dir", bareRepo] ++ args) ""
-    getChangeCount :: FilePath -> IO (FilePath, Int)
+    getChangeCount :: FilePath -> IO (FilePath, Integer)
     getChangeCount path =
       git ["rev-list", "--count", "HEAD", "--", path]
         /> filter (/= '\n')
@@ -1523,7 +1588,7 @@ test_calculateScore =
       Test.prop "never < 0" <| \t b l -> calculateScore t b l >= 0
     ]
 
-lastTouched :: FilePath -> FilePath -> IO (FilePath, Maybe Int)
+lastTouched :: FilePath -> FilePath -> IO (FilePath, Maybe Integer)
 lastTouched bareRepo path = do
   now <- Time.getCurrentTime
   timestamp <-
diff --git a/Biz/Look.hs b/Biz/Look.hs
index ee17525..372dd08 100644
--- a/Biz/Look.hs
+++ b/Biz/Look.hs
@@ -32,8 +32,11 @@ module Biz.Look
     -- | Grid
     gridArea,
     gridTemplateAreas,
+    gridTemplateRows,
     columnGap,
     rowGap,
+    -- | Alignment
+    justifySelf,
   )
 where
 
@@ -163,8 +166,14 @@ gridArea = Stylesheet.key "grid-area"
 gridTemplateAreas :: [Property.Literal] -> Css
 gridTemplateAreas = Stylesheet.key "grid-template-areas" <. noCommas
 
+gridTemplateRows :: [Property.Literal] -> Css
+gridTemplateRows = Stylesheet.key "grid-template-columns" <. noCommas
+
 columnGap :: Size a -> Css
 columnGap = Stylesheet.key "column-gap"
 
 rowGap :: Size a -> Css
 rowGap = Stylesheet.key "row-gap"
+
+justifySelf :: JustifyContentValue -> Css
+justifySelf = Stylesheet.key "justify-self"
-- 
cgit v1.2.3