diff options
| -rw-r--r-- | Biz/Devalloc.hs | 113 |
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 |