Fix score calculation

It was always showing 0 because of annoying numeric type conversion stuff. This
is my least favorite part of Haskell.

1 files changed, 39 insertions, 17 deletions

diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs
index 91668c3..6da2ff6 100644
--- a/Biz/Devalloc.hs
+++ b/Biz/Devalloc.hs
@@ -607,7 +607,7 @@ nav = \case
       Lucid.ul_ <| do
         li "Login" <| fieldLink login
         li "Pricing" <| fieldLink home
-  Just u ->
+  Just _ ->
     Lucid.nav_ <| do
       a "Devalloc" <| fieldLink home
       Lucid.ul_
@@ -643,7 +643,9 @@ data Analysis = Analysis
     -- | Files that have not been touched in 6 months
     stale :: [(FilePath, Int)],
     -- | Total score for the repo
-    score :: Int,
+    score :: Integer,
+    -- | Total number of files
+    totalFiles :: Integer,
     -- | List of all the active users we care about
     activeAuthors :: [Text]
   }
@@ -657,15 +659,21 @@ instance Lucid.ToHtml Analysis where
       render Analysis {..} =
         Lucid.div_ <| do
           Lucid.h1_ "Analysis Results"
-          Lucid.h3_ "score:"
+          Lucid.h3_ "Total score:"
           Lucid.p_ <| Lucid.toHtml <| Text.pack <| show score
-          Lucid.h3_ "blackholes:"
+          Lucid.h3_ <| Lucid.toHtml <| "Total files: " <> tshow totalFiles
+          Lucid.h3_ <| Lucid.toHtml <| "Found " <> slen blackholes <> " blackholes:"
           Lucid.ul_ <| do
             mapM_ (Lucid.toHtml .> Lucid.li_) blackholes
-          Lucid.h3_ "stale files:"
+          Lucid.h3_ <| Lucid.toHtml <| "Found " <> slen liabilities <> " liabilities:"
+          Lucid.ul_ <| do
+            mapM_ (Lucid.toHtml .> Lucid.li_) liabilities
+          Lucid.h3_ <| Lucid.toHtml <| "Found " <> slen stale <> " stale files:"
           Lucid.ul_ <| do
             forM_ stale <| \(path, days) ->
               Lucid.li_ <| Lucid.toHtml <| path <> " (" <> show days <> " days)"
+      slen = Text.pack <. show <. length
+      tshow = Text.pack <. show
 
 -- | Takes a list of active authors and a path to a bare git repo and runs a
 -- regular analysis
@@ -704,9 +712,9 @@ analyze activeAuthors bareRepo = do
           | (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
+  let numBlackholes = realToFrac <| length blackholes
+  let numLiabilities = realToFrac <| length liabilities
+  let numTotal = realToFrac <| length tree
   return
     Analysis
       { stale =
@@ -714,21 +722,35 @@ analyze activeAuthors bareRepo = do
             | (path, days) <- stalenessMap,
               days > 180
           ],
-        score =
-          maxScore
-            * ( (numBlackholes * frac (5 // 10)) * (numLiabilities * frac (7 // 10))
-                  * (numTotal - numBlackholes - numLiabilities)
-              )
-            `div` numTotal,
+        score = calculateScore numTotal numBlackholes numLiabilities,
+        totalFiles = toInteger <| length tree,
         ..
       }
   where
-    (//) = div
-    frac = fromIntegral :: Num a => Int -> a
-    maxScore = 10
     third :: (a, b, c) -> c
     third (_, _, a) = a
 
+calculateScore :: Double -> Double -> Double -> Integer
+calculateScore numTotal numBlackholes numLiabilities =
+  max 0 <. round
+    <| maxScore
+    * (weightedBlackholes + weightedLiabilities + numGood)
+    / numTotal
+  where
+    weightedBlackholes = numBlackholes * (5 / 10)
+    weightedLiabilities = numLiabilities * (7 / 10)
+    numGood = numTotal - numBlackholes - numLiabilities
+    maxScore = 100.0
+
+test_calculateScore =
+  [ -- perfect
+    100 == calculateScore 100 0 0,
+    -- all blackholes
+    50 == calculateScore 100 100 0,
+    -- all liabilities
+    70 == calculateScore 100 0 100
+  ]
+
 lastTouched :: FilePath -> FilePath -> IO (FilePath, Int)
 lastTouched bareRepo path = do
   now <- Clock.getCurrentTime