From 4c1df68e201d11e82b3870a3020ad79728e6b700 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Wed, 20 Jan 2021 16:44:14 -0500
Subject: Property tests for calculateScore

---
 Biz/Bild/Deps/Haskell.nix |  2 ++
 Biz/Devalloc.hs           | 17 ++++++++++-------
 Biz/Pie.hs                |  1 +
 Biz/Que/Host.hs           |  1 +
 Biz/Que/Site.hs           |  1 +
 Biz/Test.hs               | 10 ++++++++--
 6 files changed, 23 insertions(+), 9 deletions(-)

(limited to 'Biz')

diff --git a/Biz/Bild/Deps/Haskell.nix b/Biz/Bild/Deps/Haskell.nix
index eb34f3a..21fcb66 100644
--- a/Biz/Bild/Deps/Haskell.nix
+++ b/Biz/Bild/Deps/Haskell.nix
@@ -21,6 +21,7 @@ with hpkgs;
   filepath
   ghcjs-base
   github
+  hashids
   haskeline
   http-types
   ixset
@@ -53,6 +54,7 @@ with hpkgs;
   stripe-haskell
   tasty
   tasty-hunit
+  tasty-quickcheck
   text
   time
   transformers
diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs
index 4645a2a..3836ef7 100644
--- a/Biz/Devalloc.hs
+++ b/Biz/Devalloc.hs
@@ -40,6 +40,7 @@
 -- : dep servant-server
 -- : dep tasty
 -- : dep tasty-hunit
+-- : dep tasty-quickcheck
 -- : dep uuid
 -- : dep vector
 -- : dep warp
@@ -353,8 +354,7 @@ test :: Test.Tree
 test =
   Test.group
     "Biz.Devalloc"
-    [ -- test_analyzeGitHub,
-      test_calculateScore
+    [ test_calculateScore
     ]
 
 -- * app configurations
@@ -934,7 +934,12 @@ analyze keep askedBy activeAuthors url bareRepo = do
     third (_, _, a) = a
     git 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
+calculateScore 0 _ _ = 0
+calculateScore a 0 0 | a > 0 = 100
+calculateScore a b c | a < 0 || b < 0 || c < 0 = 0
 calculateScore numTotal numBlackholes numLiabilities =
   max 0 <. round
     <| maxScore
@@ -952,7 +957,9 @@ test_calculateScore =
     "calculateScore"
     [ Test.unit "perfect score" <| 100 @=? calculateScore 100 0 0,
       Test.unit "all blackholes" <| 50 @=? calculateScore 100 100 0,
-      Test.unit "all liabilities" <| 70 @=? calculateScore 100 0 100
+      Test.unit "all liabilities" <| 70 @=? calculateScore 100 0 100,
+      Test.prop "never > 100" <| \t b l -> calculateScore t b l <= 100,
+      Test.prop "never < 0" <| \t b l -> calculateScore t b l >= 0
     ]
 
 lastTouched :: FilePath -> FilePath -> IO (FilePath, Int)
@@ -1054,10 +1061,6 @@ analyzeGitHub keep user cfg o r = do
     ghOwner = GitHub.mkName (Proxy :: Proxy GitHub.Owner) o
     ghRepo = GitHub.mkName (Proxy :: Proxy GitHub.Repo) r
 
--- TODO: write this test
--- test_analyzeGitHub :: IO Analysis
--- test_analyzeGitHub = analyzeGitHub () Envy.defConfig "bsima" "bin"
-
 -- | Clone the repo to @<Config.depo>/<url>@. If repo already exists, just do a
 -- @git fetch@. Returns the full path to the local repo.
 fetchBareRepo :: Config -> Text -> IO FilePath
diff --git a/Biz/Pie.hs b/Biz/Pie.hs
index ddaa6ee..5c5ef56 100644
--- a/Biz/Pie.hs
+++ b/Biz/Pie.hs
@@ -41,6 +41,7 @@
 -- : dep parsec
 -- : dep tasty
 -- : dep tasty-hunit
+-- : dep tasty-quickcheck
 module Biz.Pie
   ( main,
   )
diff --git a/Biz/Que/Host.hs b/Biz/Que/Host.hs
index ce3f5da..d50993c 100644
--- a/Biz/Que/Host.hs
+++ b/Biz/Que/Host.hs
@@ -22,6 +22,7 @@
 -- : dep stm
 -- : dep tasty
 -- : dep tasty-hunit
+-- : dep tasty-quickcheck
 -- : dep unagi-chan
 -- : dep unordered-containers
 module Biz.Que.Host
diff --git a/Biz/Que/Site.hs b/Biz/Que/Site.hs
index c4a6e0d..c2245d6 100644
--- a/Biz/Que/Site.hs
+++ b/Biz/Que/Site.hs
@@ -16,6 +16,7 @@
 -- : dep req
 -- : dep tasty
 -- : dep tasty-hunit
+-- : dep tasty-quickcheck
 module Biz.Que.Site
   ( main,
   )
diff --git a/Biz/Test.hs b/Biz/Test.hs
index 6bd5acf..7f6da61 100644
--- a/Biz/Test.hs
+++ b/Biz/Test.hs
@@ -1,18 +1,21 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 
+-- : dep tasty
+-- : dep tasty-hunit
+-- : dep tasty-quickcheck
 module Biz.Test
   ( Tree,
     group,
     unit,
+    prop,
     (@=?),
   )
 where
 
--- : dep tasty
--- : dep tasty-hunit
 import qualified Test.Tasty as Tasty
 import Test.Tasty.HUnit ((@=?))
 import qualified Test.Tasty.HUnit as HUnit
+import qualified Test.Tasty.QuickCheck as QuickCheck
 
 type Tree = Tasty.TestTree
 
@@ -21,3 +24,6 @@ group = Tasty.testGroup
 
 unit :: Tasty.TestName -> HUnit.Assertion -> Tasty.TestTree
 unit = HUnit.testCase
+
+prop :: QuickCheck.Testable a => Tasty.TestName -> a -> Tasty.TestTree
+prop = QuickCheck.testProperty
-- 
cgit v1.2.3