summaryrefslogtreecommitdiff
path: root/Biz/Devalloc.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Biz/Devalloc.hs')
-rw-r--r--Biz/Devalloc.hs113
1 files changed, 63 insertions, 50 deletions
diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs
index 1813f3a..d9cf840 100644
--- a/Biz/Devalloc.hs
+++ b/Biz/Devalloc.hs
@@ -1572,68 +1572,81 @@ instance Lucid.ToHtml AnalysisDisplay where
-- | Run a full analysis on a git repo
analyze :: Acid.AcidState Keep -> Id.Id User -> [Text] -> URL -> FilePath -> Bool -> IO Analysis
analyze keep askedBy activeAuthors url bareRepo repoPrivate = do
- commit <- Sha </ Text.strip </ Text.pack </ git ["log", "-n1", "--format=%H"]
+ commit <- Sha </ Text.strip </ Text.pack </ git bareRepo ["log", "-n1", "--format=%H"]
Acid.query keep (GetAnalysisByUrlAndCommit url commit) +> \case
Just analysis -> pure analysis
- Nothing -> do
- tree <-
- git
- [ "ls-tree",
- "--full-tree",
- "--name-only",
- "-r", -- recurse into subtrees
- "HEAD"
- ]
- /> String.lines
- authors <- traverse (authorsFor bareRepo) tree :: IO [[(Text, Text, Text)]]
- let authorMap = zip tree authors :: [(FilePath, [(Text, Text, Text)])]
- stalenessMap <- traverse (lastTouched bareRepo) tree
- let blackholes =
- [ Text.pack path
- | (path, authors_) <- authorMap,
- null (map third authors_ `List.intersect` activeAuthors)
- ]
- let liabilities =
- [ Text.pack path
- | (path, authors_) <- authorMap,
- length (map third authors_ `List.intersect` activeAuthors) < 3
- ]
- let numBlackholes = realToFrac <| length blackholes
- let numLiabilities = realToFrac <| length liabilities
- 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 =
- [ (path, days)
- | (path, Just days) <- stalenessMap,
- days > 180
- ],
- score = calculateScore numTotal numBlackholes numLiabilities,
- totalFiles = toInteger <| length tree,
- repoVisibility = repoPrivate ?: (Private, Public),
- ..
- }
- |> CreateAnalysis
- |> Acid.update keep
+ Nothing ->
+ runAnalysis bareRepo activeAuthors url askedBy repoPrivate commit
+ /> CreateAnalysis
+ +> Acid.update keep
+
+runAnalysis :: String -> [Text] -> URL -> Id.Id User -> Bool -> Commit -> IO Analysis
+runAnalysis bareRepo activeAuthors url askedBy repoPrivate commit = do
+ tree <-
+ git
+ bareRepo
+ [ "ls-tree",
+ "--full-tree",
+ "--name-only",
+ "-r", -- recurse into subtrees
+ "HEAD"
+ ]
+ /> String.lines
+ authors <- traverse (authorsFor bareRepo) tree :: IO [[(Text, Text, Text)]]
+ let authorMap = zip tree authors :: [(FilePath, [(Text, Text, Text)])]
+ stalenessMap <- traverse (lastTouched bareRepo) tree
+ let blackholes =
+ [ Text.pack path
+ | (path, authors_) <- authorMap,
+ null (map third authors_ `List.intersect` activeAuthors)
+ ]
+ let liabilities =
+ [ Text.pack path
+ | (path, authors_) <- authorMap,
+ length (map third authors_ `List.intersect` activeAuthors) < 3
+ ]
+ let numBlackholes = realToFrac <| length blackholes
+ let numLiabilities = realToFrac <| length liabilities
+ let numTotal = realToFrac <| length tree
+ hotspotMap <-
+ Map.fromList </ Async.mapConcurrently getChangeCount tree
+ totalCommits <-
+ git bareRepo ["rev-list", "--count", "HEAD"]
+ /> filter (/= '\n')
+ /> readMaybe
+ /> fromMaybe 0
+ pure
+ <| Analysis
+ { analysisId = mempty,
+ stale =
+ [ (path, days)
+ | (path, Just days) <- stalenessMap,
+ days > 180
+ ],
+ score = calculateScore numTotal numBlackholes numLiabilities,
+ totalFiles = toInteger <| length tree,
+ repoVisibility = repoPrivate ?: (Private, Public),
+ ..
+ }
where
third :: (a, b, c) -> c
third (_, _, a) = a
- git args = Process.readProcess "git" (["--git-dir", bareRepo] ++ args) ""
getChangeCount :: FilePath -> IO (FilePath, Integer)
getChangeCount path =
- git ["rev-list", "--count", "HEAD", "--", path]
+ git bareRepo ["rev-list", "--count", "HEAD", "--", path]
/> filter (/= '\n')
/> readMaybe
/> fromMaybe 0
/> (path,)
+-- | Run a git command on a repo
+git ::
+ -- | path to the git dir (bare repo)
+ String ->
+ -- | args to `git`
+ [String] -> IO String
+git bareRepo args = Process.readProcess "git" (["--git-dir", bareRepo] ++ args) ""
+
-- | Does the aggregate score calculation given number of files found to be
-- blackholes, liabilities, etc.
calculateScore :: Double -> Double -> Double -> Integer