summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Biz/Devalloc.hs223
-rw-r--r--Biz/Look.hs9
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"
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-01 07:28:26 +0000