summaryrefslogtreecommitdiff
path: root/Biz
diff options
context:
space:
mode:
Diffstat (limited to 'Biz')
-rw-r--r--Biz/Devalloc.hs72
1 files changed, 57 insertions, 15 deletions
diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs
index d1172ee..7dbc4a5 100644
--- a/Biz/Devalloc.hs
+++ b/Biz/Devalloc.hs
@@ -45,6 +45,8 @@ import qualified Data.List as List
import qualified Data.String as String
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Encoding
+import qualified Data.Time.Clock as Clock
+import qualified Data.Time.Format as Time
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import qualified GitHub
@@ -151,7 +153,6 @@ instance Lucid.ToHtml a => Lucid.ToHtml (HtmlApp a) where
data Paths path = Paths
{ home :: path :- Get '[HTML] (HtmlApp Home),
githubAuth ::
- -- auth/github/callback?code=...
path :- "auth" :> "github" :> "callback"
:> QueryParam "code" Text
:> Get '[HTML] (HtmlApp SelectRepo),
@@ -311,7 +312,7 @@ data Analysis = Analysis
-- | A path with < 3 active contributors
liabilities :: [Text],
-- | Files that have not been touched in 6 months
- stale :: [Text],
+ stale :: [(FilePath, Int)],
-- | Total score for the repo
score :: Int,
-- | List of all the active users we care about
@@ -327,9 +328,15 @@ instance Lucid.ToHtml Analysis where
render Analysis {..} =
Lucid.div_ <| do
Lucid.h1_ "Analysis Results"
+ Lucid.h3_ "score:"
+ Lucid.p_ <| Lucid.toHtml <| Text.pack <| show score
Lucid.h3_ "blackholes:"
Lucid.ul_ <| do
mapM_ (Lucid.toHtml .> Lucid.li_) blackholes
+ Lucid.h3_ "stale files:"
+ Lucid.ul_ <| do
+ forM_ stale <| \(path, days) ->
+ Lucid.li_ <| Lucid.toHtml <| path <> " (" <> show days <> " days)"
-- | Takes a list of active authors and a path to a bare git repo and runs a
-- regular analysis
@@ -357,27 +364,62 @@ analyze activeAuthors bareRepo = do
tree
authors ::
[(FilePath, [(Text, Text, Text)])]
-
+ stalenessMap <- mapM (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 = frac <| length blackholes
+ let numLiabilities = frac <| length liabilities
+ let numTotal = length tree
return
Analysis
- { blackholes =
- [ Text.pack path
- | (path, authors_) <- authorMap,
- null (map third authors_ `List.intersect` activeAuthors)
- ],
- liabilities =
- [ Text.pack path
- | (path, authors_) <- authorMap,
- length (map third authors_ `List.intersect` activeAuthors) < 3
+ { stale =
+ [ (path, days)
+ | (path, days) <- stalenessMap,
+ days > 180
],
- stale = [], -- actually a map of path->staleness
- score = 10,
+ score =
+ maxScore
+ * ( (numBlackholes * frac (5 // 10)) * (numLiabilities * frac (7 // 10))
+ * (numTotal - numBlackholes - numLiabilities)
+ )
+ `div` numTotal,
..
}
where
+ (//) = div
+ frac = fromIntegral :: Num a => Int -> a
+ maxScore = 10
third :: (a, b, c) -> c
third (_, _, a) = a
+lastTouched :: FilePath -> FilePath -> IO (FilePath, Int)
+lastTouched bareRepo path = do
+ now <- Clock.getCurrentTime
+ timestamp <-
+ Process.readProcess
+ "git"
+ [ "--git-dir",
+ bareRepo,
+ "log",
+ "-n1",
+ "--pretty=%aI",
+ "--",
+ path
+ ]
+ ""
+ /> filter (/= '\n')
+ /> Time.parseTimeOrError True Time.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%z"
+ let days = round <| Clock.diffUTCTime now timestamp / Clock.nominalDay
+ return (path, days)
+
-- | Given a git dir and a path inside the git repo, return a list of tuples
-- with number of commits and author.
authorsFor ::
@@ -385,7 +427,7 @@ authorsFor ::
FilePath ->
-- | Returns (number of commits, author name, author email)
IO [(Text, Text, Text)]
-authorsFor gitDir path = do
+authorsFor gitDir path =
-- git shortlog writes to stderr for some reason, so we can't just use
-- Process.readProcess
Process.readProcess