summaryrefslogtreecommitdiff
path: root/Omni/Test.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Test.hs')
-rw-r--r--Omni/Test.hs110
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" []