diff options
author | Ben Sima <ben@bsima.me> | 2024-11-15 14:55:37 -0500 |
---|---|---|
committer | Ben Sima <ben@bsima.me> | 2024-12-21 10:06:49 -0500 |
commit | 6513755670892983db88a6633b8c1ea6019c03d1 (patch) | |
tree | 44e9eccdb7a3a74ab7e96a8fee7572dd6a78dc73 /Omni/Test.hs | |
parent | ae7b7e0186b5f2e0dcd4d5fac0a71fa264caedc2 (diff) |
Re-namespace some stuff to Omni
I was getting confused about what is a product and what is internal
infrastructure; I think it is good to keep those things separate. So I moved a
bunch of stuff to an Omni namespace, actually most stuff went there. Only things
that are explicitly external products are still in the Biz namespace.
Diffstat (limited to 'Omni/Test.hs')
-rw-r--r-- | Omni/Test.hs | 110 |
1 files changed, 110 insertions, 0 deletions
diff --git a/Omni/Test.hs b/Omni/Test.hs new file mode 100644 index 0000000..0cc00ac --- /dev/null +++ b/Omni/Test.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Omni.Test + ( Tree, + Description, + Assertion, + run, + group, + none, + unit, + prop, + with, + assertFailure, + (@=?), + (@?=), + (@?!=), + ) +where + +import Alpha hiding (group) +import qualified Data.Text as Text +import qualified Test.Tasty as Tasty +import qualified Test.Tasty.HUnit as HUnit +import qualified Test.Tasty.QuickCheck as QuickCheck +import qualified Test.Tasty.Runners as Tasty + +type Tree = Tasty.TestTree + +type Description = Tasty.TestName + +type Assertion = HUnit.Assertion + +run :: Tree -> IO () +run tree = do + Tasty.installSignalHandlers + case Tasty.tryIngredients Tasty.defaultIngredients mempty tree of + Nothing -> do + hPutStrLn stderr <| Text.pack "no ingredients agreed to run" + exitFailure + Just act -> act +> \ok -> if ok then exitSuccess else exitFailure + +group :: Description -> [Tasty.TestTree] -> Tree +group = Tasty.testGroup + +unit :: Description -> Assertion -> Tree +unit = HUnit.testCase + +prop :: (QuickCheck.Testable a) => Description -> a -> Tree +prop = QuickCheck.testProperty + +assertFailure :: String -> Assertion +assertFailure = HUnit.assertFailure + +with :: + -- | Startup + IO a -> + -- | Shutdown + (a -> IO ()) -> + -- | A test group where the first argument is a function that gets the resource + (IO a -> Tree) -> + Tree +with = Tasty.withResource + +-- | How is this not part of HUnit?? +assertNotEqual :: + (Eq a, Show a, HasCallStack) => + -- | The message prefix + String -> + -- | The not-expected value + a -> + -- | The actual value + a -> + HUnit.Assertion +assertNotEqual preface notexpected actual = + unless (actual /= notexpected) (HUnit.assertFailure msg) + where + msg = + (if null preface then "" else preface ++ "\n") + ++ "expected not: " + ++ show notexpected + ++ "\n but got: " + ++ show actual + +-- | unexpectedValue @?!= actual +(@?!=) :: + (Eq a, Show a, HasCallStack) => + -- | The not-expected value + a -> + -- | The actual value + a -> + HUnit.Assertion +expected @?!= actual = assertNotEqual "" expected actual + +infixl 2 @?!= + +-- | expectedVal @=? actualVal +(@=?) :: (Eq a, Show a) => a -> a -> HUnit.Assertion +a @=? b = a HUnit.@=? b + +infixl 2 @=? + +-- | actualVal @?= expectedVal +(@?=) :: (Eq a, Show a) => a -> a -> HUnit.Assertion +a @?= b = a HUnit.@?= b + +infixr 2 @?= + +-- | For usage in 'Omni.Cli.Plan' when you have no tests. +none :: Tree +none = group "none" [] |