From e77cdc025b0e80049344f258d9ca170d0953d0d7 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Fri, 15 Jan 2021 21:11:30 -0500
Subject: Implement Biz.Test with tasty

Also changes the --test option to a 'test' command. This is because running the
tests for a namespace/exe should never be combined with anything else: you
either want to run the tests, or not.
---
 Biz/Devalloc.hs | 39 +++++++++++++++++++++++----------------
 1 file changed, 23 insertions(+), 16 deletions(-)

(limited to 'Biz/Devalloc.hs')

diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs
index 1134098..59e2240 100644
--- a/Biz/Devalloc.hs
+++ b/Biz/Devalloc.hs
@@ -32,6 +32,8 @@
 -- : dep servant-auth-server
 -- : dep servant-lucid
 -- : dep servant-server
+-- : dep tasty
+-- : dep tasty-hunit
 -- : dep uuid
 -- : dep vector
 -- : dep warp
@@ -45,6 +47,8 @@ import Alpha hiding ((<.>))
 import Biz.App (CSS (..), HtmlApp (..))
 import qualified Biz.Cli as Cli
 import qualified Biz.Look
+import Biz.Test ((@=?))
+import qualified Biz.Test as Test
 import qualified Clay
 import qualified Control.Exception as Exception
 import Crypto.JOSE.JWK (JWK)
@@ -203,10 +207,8 @@ help =
 devalloc
 
 Usage:
-  devalloc [--test]
-
-Options:
-  --test  Run the tests
+  devalloc
+  devalloc test
 |]
 
 move :: Cli.Arguments -> IO ()
@@ -250,8 +252,13 @@ testCookieSettings =
       Auth.cookieXsrfSetting = Nothing
     }
 
-test :: Cli.Arguments -> IO ()
-test _ = test_analyzeGitHub >> pure test_calculateScore >> pure ()
+test :: Test.Tree
+test =
+  Test.group
+    "Biz.Devalloc"
+    [ -- test_analyzeGitHub,
+      test_calculateScore
+    ]
 
 -- * app configurations
 
@@ -760,15 +767,14 @@ calculateScore numTotal numBlackholes numLiabilities =
     numGood = numTotal - numBlackholes - numLiabilities
     maxScore = 100.0
 
-test_calculateScore :: [Bool]
+test_calculateScore :: Test.Tree
 test_calculateScore =
-  [ -- perfect
-    100 == calculateScore 100 0 0,
-    -- all blackholes
-    50 == calculateScore 100 100 0,
-    -- all liabilities
-    70 == calculateScore 100 0 100
-  ]
+  Test.group
+    "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
+    ]
 
 lastTouched :: FilePath -> FilePath -> IO (FilePath, Int)
 lastTouched bareRepo path = do
@@ -869,8 +875,9 @@ analyzeGitHub githubAuth cfg o r = do
     ghOwner = GitHub.mkName (Proxy :: Proxy GitHub.Owner) o
     ghRepo = GitHub.mkName (Proxy :: Proxy GitHub.Repo) r
 
-test_analyzeGitHub :: IO Analysis
-test_analyzeGitHub = analyzeGitHub () Envy.defConfig "bsima" "bin"
+-- 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.
-- 
cgit v1.2.3