From 6513755670892983db88a6633b8c1ea6019c03d1 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Fri, 15 Nov 2024 14:55:37 -0500
Subject: 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.
---
 Omni/Test.hs | 110 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 110 insertions(+)
 create mode 100644 Omni/Test.hs

(limited to 'Omni/Test.hs')

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" []
-- 
cgit v1.2.3