test: Use tasty

2 files changed, 37 insertions, 34 deletions

diff --git a/chad-fast.cabal b/chad-fast.cabal
index c052a7d..4ee1c19 100644
--- a/chad-fast.cabal
+++ b/chad-fast.cabal
@@ -81,6 +81,8 @@ test-suite test
     containers,
     dependent-map,
     hedgehog,
+    tasty,
+    tasty-hedgehog,
     transformers,
   hs-source-dirs: test
   default-language: Haskell2010
diff --git a/test/Main.hs b/test/Main.hs
index dde2c3d..de3d39e 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -19,7 +19,8 @@ import qualified Data.Map.Strict as Map
 import Hedgehog
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
-import Hedgehog.Main
+import Test.Tasty
+import Test.Tasty.Hedgehog
 
 import Array
 import AST
@@ -246,71 +247,71 @@ term_sparse = fromNamed $ lambda #inp $ body $
   let_ #c (build1 #n (#i :-> #arr ! pair nil 4)) $
     idx0 (sum1i #a) + idx0 (sum1i #b) + idx0 (sum1i #c)
 
-tests :: IO Bool
-tests = checkParallel $ Group "AD"
-  [("id", adTest $ fromNamed $ lambda #x $ body $ #x)
+tests :: TestTree
+tests = testGroup "AD"
+  [testProperty "id" $ adTest $ fromNamed $ lambda #x $ body $ #x
 
-  ,("idx0", adTest $ fromNamed $ lambda #x $ body $ idx0 #x)
+  ,testProperty "idx0" $ adTest $ fromNamed $ lambda #x $ body $ idx0 #x
 
-  ,("sum-vec", adTest $ fromNamed $ lambda #x $ body $ idx0 (sum1i #x))
+  ,testProperty "sum-vec" $ adTest $ fromNamed $ lambda #x $ body $ idx0 (sum1i #x)
 
-  ,("sum-replicate", adTest $ fromNamed $ lambda #x $ body $
-      idx0 $ sum1i $ replicate1i 10 #x)
+  ,testProperty "sum-replicate" $ adTest $ fromNamed $ lambda #x $ body $
+      idx0 $ sum1i $ replicate1i 10 #x
 
-  ,("pairs", adTest term_pairs)
+  ,testProperty "pairs" $ adTest term_pairs
 
-  ,("build0 const", adTest $ fromNamed $ lambda @(TScal TF64) #x $ body $
-      idx0 $ build SZ nil $ #idx :-> const_ 0.0)
+  ,testProperty "build0 const" $ adTest $ fromNamed $ lambda @(TScal TF64) #x $ body $
+      idx0 $ build SZ nil $ #idx :-> const_ 0.0
 
-  ,("build0", adTest $ fromNamed $ lambda @(TArr N0 _) #x $ body $
+  ,testProperty "build0" $ adTest $ fromNamed $ lambda @(TArr N0 _) #x $ body $
       idx0 $
-        build SZ (shape #x) $ #idx :-> #x ! #idx)
+        build SZ (shape #x) $ #idx :-> #x ! #idx
 
-  ,("build1-sum", adTest term_build1_sum)
+  ,testProperty "build1-sum" $ adTest term_build1_sum
 
-  ,("build2-sum", adTest $ fromNamed $ lambda @(TArr N2 _) #x $ body $
+  ,testProperty "build2-sum" $ adTest $ fromNamed $ lambda @(TArr N2 _) #x $ body $
       idx0 $ sum1i . sum1i $
-        build (SS (SS SZ)) (shape #x) $ #idx :-> #x ! #idx)
+        build (SS (SS SZ)) (shape #x) $ #idx :-> #x ! #idx
 
-  ,("maximum", adTestCon (\(Value a `SCons` _) -> let _ `ShCons` n = arrayShape a in n > 0) $
+  ,testProperty "maximum" $ adTestCon (\(Value a `SCons` _) -> let _ `ShCons` n = arrayShape a in n > 0) $
       fromNamed $ lambda @(TArr N2 (TScal TF64)) #x $ body $
-        idx0 $ sum1i $ maximum1i #x)
+        idx0 $ sum1i $ maximum1i #x
 
-  ,("minimum", adTestCon (\(Value a `SCons` _) -> let _ `ShCons` n = arrayShape a in n > 0) $
+  ,testProperty "minimum" $ adTestCon (\(Value a `SCons` _) -> let _ `ShCons` n = arrayShape a in n > 0) $
       fromNamed $ lambda @(TArr N2 (TScal TF64)) #x $ body $
-        idx0 $ sum1i $ minimum1i #x)
+        idx0 $ sum1i $ minimum1i #x
 
-  ,("unused", adTest $ fromNamed $ lambda @(TArr N1 (TScal TF64)) #x $ body $
+  ,testProperty "unused" $ adTest $ fromNamed $ lambda @(TArr N1 (TScal TF64)) #x $ body $
     let_ #a (build1 (snd_ (shape #x)) (#i :-> #x ! pair nil #i)) $
-      42)
+      42
 
-  ,("sparse", adTestTp (C "" 5) term_sparse)
+  ,testProperty "sparse" $ adTestTp (C "" 5) term_sparse
 
-  ,("neural", adTestGen Example.neural genNeural)
+  ,testProperty "neural" $ adTestGen Example.neural genNeural
 
-  ,("neural-unMonoid", adTestGen (unMonoid (simplifyFix Example.neural)) genNeural)
+  ,testProperty "neural-unMonoid" $ adTestGen (unMonoid (simplifyFix Example.neural)) genNeural
 
-  ,("logsumexp", adTestTp (C "" 1) $
+  ,testProperty "logsumexp" $ adTestTp (C "" 1) $
       fromNamed $ lambda @(TArr N1 _) #vec $ body $
       let_ #m (maximum1i #vec) $
-        log (idx0 (sum1i (map_ (#x :-> exp (#x - idx0 #m)) #vec))) + idx0 #m)
+        log (idx0 (sum1i (map_ (#x :-> exp (#x - idx0 #m)) #vec))) + idx0 #m
 
-  ,("mulmatvec", adTestTp ((C "" 0 :$ C "n" 0) :& C "n" 0) $
+  ,testProperty "mulmatvec" $ adTestTp ((C "" 0 :$ C "n" 0) :& C "n" 0) $
       fromNamed $ lambda @(TArr N2 _) #mat $ lambda @(TArr N1 _) #vec $ body $
       idx0 $ sum1i $
         let_ #hei (snd_ (fst_ (shape #mat))) $
         let_ #wid (snd_ (shape #mat)) $
           build1 #hei $ #i :->
             idx0 (sum1i (build1 #wid $ #j :->
-                           #mat ! pair (pair nil #i) #j * #vec ! pair nil #j)))
+                           #mat ! pair (pair nil #i) #j * #vec ! pair nil #j))
 
-  ,("gmm-wrong", withShrinks 0 $ adTestGen (Example.gmmObjective True) genGMM)
+  ,testProperty "gmm-wrong" $ withShrinks 0 $ adTestGen (Example.gmmObjective True) genGMM
 
-  ,("gmm-wrong-unMonoid", withShrinks 0 $ adTestGen (unMonoid (simplifyFix (Example.gmmObjective True))) genGMM)
+  ,testProperty "gmm-wrong-unMonoid" $ withShrinks 0 $ adTestGen (unMonoid (simplifyFix (Example.gmmObjective True))) genGMM
 
-  ,("gmm", withShrinks 0 $ adTestGen (Example.gmmObjective False) genGMM)
+  ,testProperty "gmm" $ withShrinks 0 $ adTestGen (Example.gmmObjective False) genGMM
 
-  ,("gmm-unMonoid", withShrinks 0 $ adTestGen (unMonoid (simplifyFix (Example.gmmObjective False))) genGMM)
+  ,testProperty "gmm-unMonoid" $ withShrinks 0 $ adTestGen (unMonoid (simplifyFix (Example.gmmObjective False))) genGMM
   ]
   where
     genGMM = do
@@ -351,4 +352,4 @@ tests = checkParallel $ Group "AD"
       return (input `SCons` lay3 `SCons` lay2 `SCons` lay1 `SCons` SNil)
 
 main :: IO ()
-main = defaultMain [tests]
+main = defaultMain tests