From 74c7d671e2351b644e64ae69ef6d9f42c8c8b968 Mon Sep 17 00:00:00 2001
From: John Ky <john.ky@iohk.io>
Date: Mon, 4 Nov 2024 23:16:10 +1100
Subject: [PATCH 1/5] New property function

---
 hedgehog/HaskellWorks/Polysemy/Hedgehog.hs    |  3 ++-
 .../Polysemy/Hedgehog/Property.hs             | 22 +++++++++++++++++--
 2 files changed, 22 insertions(+), 3 deletions(-)

diff --git a/hedgehog/HaskellWorks/Polysemy/Hedgehog.hs b/hedgehog/HaskellWorks/Polysemy/Hedgehog.hs
index f494aea..3b6988f 100644
--- a/hedgehog/HaskellWorks/Polysemy/Hedgehog.hs
+++ b/hedgehog/HaskellWorks/Polysemy/Hedgehog.hs
@@ -1,6 +1,7 @@
 
 module HaskellWorks.Polysemy.Hedgehog
-  ( propertyOnce,
+  ( property,
+    propertyOnce,
 
     Hedgehog,
 
diff --git a/hedgehog/HaskellWorks/Polysemy/Hedgehog/Property.hs b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Property.hs
index 384e74e..6a4ea40 100644
--- a/hedgehog/HaskellWorks/Polysemy/Hedgehog/Property.hs
+++ b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Property.hs
@@ -1,5 +1,6 @@
 module HaskellWorks.Polysemy.Hedgehog.Property
   ( Property,
+    property,
     propertyOnce,
   ) where
 
@@ -19,7 +20,7 @@ import           Polysemy.Log
 import           Polysemy.Resource
 import           Polysemy.Time.Interpreter.Ghc
 
-propertyOnce :: ()
+property :: ()
   => Sem
         [ Log
         , DataLog (LogEntry LogMessage)
@@ -32,7 +33,7 @@ propertyOnce :: ()
         , Final (H.PropertyT IO)
         ] ()
   -> H.Property
-propertyOnce f =
+property f =
     f & interpretLogDataLog
       & setLogLevelFromEnv "LOG_LEVEL" Info
       & interpretDataLogHedgehog formatLogEntry getLogEntryCallStack
@@ -45,3 +46,20 @@ propertyOnce f =
       & runFinal
       & H.property
       & H.withTests 1
+
+propertyOnce :: ()
+  => Sem
+        [ Log
+        , DataLog (LogEntry LogMessage)
+        , DataLog Text
+        , GhcTime
+        , Hedgehog
+        , Embed IO
+        , Embed (H.PropertyT IO)
+        , Resource
+        , Final (H.PropertyT IO)
+        ] ()
+  -> H.Property
+propertyOnce f =
+    f & property
+      & H.withTests 1

From b27a81e54f8b5188adcce37c75283872464bdc2f Mon Sep 17 00:00:00 2001
From: John Ky <john.ky@iohk.io>
Date: Tue, 5 Nov 2024 00:02:30 +1100
Subject: [PATCH 2/5] Re-export Gen and Range modules

---
 hedgehog/HaskellWorks/Polysemy/Hedgehog/Gen.hs   | 5 +++++
 hedgehog/HaskellWorks/Polysemy/Hedgehog/Range.hs | 5 +++++
 hw-polysemy.cabal                                | 4 ++++
 3 files changed, 14 insertions(+)
 create mode 100644 hedgehog/HaskellWorks/Polysemy/Hedgehog/Gen.hs
 create mode 100644 hedgehog/HaskellWorks/Polysemy/Hedgehog/Range.hs

diff --git a/hedgehog/HaskellWorks/Polysemy/Hedgehog/Gen.hs b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Gen.hs
new file mode 100644
index 0000000..9ccc844
--- /dev/null
+++ b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Gen.hs
@@ -0,0 +1,5 @@
+module HaskellWorks.Polysemy.Hedgehog.Gen
+  ( module G
+  ) where
+
+import           Hedgehog.Gen as G
diff --git a/hedgehog/HaskellWorks/Polysemy/Hedgehog/Range.hs b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Range.hs
new file mode 100644
index 0000000..1cdf73c
--- /dev/null
+++ b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Range.hs
@@ -0,0 +1,5 @@
+module HaskellWorks.Polysemy.Hedgehog.Range
+  ( module R
+  ) where
+
+import           Hedgehog.Range as R
diff --git a/hw-polysemy.cabal b/hw-polysemy.cabal
index e05390f..2f53eaa 100644
--- a/hw-polysemy.cabal
+++ b/hw-polysemy.cabal
@@ -201,11 +201,13 @@ library hedgehog
                         HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog.Internal
                         HaskellWorks.Polysemy.Hedgehog.Effect.Log
                         HaskellWorks.Polysemy.Hedgehog.Eval
+                        HaskellWorks.Polysemy.Hedgehog.Gen
                         HaskellWorks.Polysemy.Hedgehog.Golden
                         HaskellWorks.Polysemy.Hedgehog.Jot
                         HaskellWorks.Polysemy.Hedgehog.Process
                         HaskellWorks.Polysemy.Hedgehog.Process.Internal
                         HaskellWorks.Polysemy.Hedgehog.Property
+                        HaskellWorks.Polysemy.Hedgehog.Range
                         HaskellWorks.Polysemy.Hedgehog.Test
                         HaskellWorks.Polysemy.Hedgehog.Time
                         HaskellWorks.Polysemy.Hedgehog.Ulid
@@ -289,11 +291,13 @@ library
                         HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog.Internal,
                         HaskellWorks.Polysemy.Hedgehog.Effect.Log,
                         HaskellWorks.Polysemy.Hedgehog.Eval,
+                        HaskellWorks.Polysemy.Hedgehog.Gen,
                         HaskellWorks.Polysemy.Hedgehog.Golden,
                         HaskellWorks.Polysemy.Hedgehog.Jot,
                         HaskellWorks.Polysemy.Hedgehog.Process,
                         HaskellWorks.Polysemy.Hedgehog.Process.Internal,
                         HaskellWorks.Polysemy.Hedgehog.Property,
+                        HaskellWorks.Polysemy.Hedgehog.Range,
                         HaskellWorks.Polysemy.Hedgehog.Test,
                         HaskellWorks.Polysemy.Hedgehog.Workspace,
                         HaskellWorks.Polysemy.Prelude,

From e3b04e24823ef76c4fd57e7055eb5433f4a7ab61 Mon Sep 17 00:00:00 2001
From: John Ky <john.ky@iohk.io>
Date: Tue, 5 Nov 2024 00:36:54 +1100
Subject: [PATCH 3/5] New forAll function

---
 hedgehog/HaskellWorks/Polysemy/Hedgehog.hs            |  2 ++
 .../HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs | 11 +++++++++++
 2 files changed, 13 insertions(+)

diff --git a/hedgehog/HaskellWorks/Polysemy/Hedgehog.hs b/hedgehog/HaskellWorks/Polysemy/Hedgehog.hs
index 3b6988f..104135d 100644
--- a/hedgehog/HaskellWorks/Polysemy/Hedgehog.hs
+++ b/hedgehog/HaskellWorks/Polysemy/Hedgehog.hs
@@ -45,6 +45,8 @@ module HaskellWorks.Polysemy.Hedgehog
     evalIO_,
     evalM_,
 
+    forAll,
+
     catchAssertion,
     throwAssertion,
     trapAssertion,
diff --git a/hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs
index 756d2ae..99deabb 100644
--- a/hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs
+++ b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs
@@ -15,6 +15,8 @@ module HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog
     throwAssertion,
     trapAssertion,
 
+    forAll,
+
     hedgehogToMonadTestFinal,
     hedgehogToPropertyFinal,
     hedgehogToTestFinal,
@@ -138,3 +140,12 @@ catchExToPropertyFinal :: forall a r. ()
   -> Sem r a
 catchExToPropertyFinal = catchExToFinal
 {-# INLINE catchExToPropertyFinal #-}
+
+forAll :: forall a r. ()
+  => Member (Embed (H.PropertyT IO)) r
+  => Member Hedgehog r
+  => Show a
+  => H.Gen a
+  -> Sem r a
+forAll =
+  embed . H.forAll

From 85575395edc136424c65b7d12b72f3efe201e0ff Mon Sep 17 00:00:00 2001
From: John Ky <john.ky@iohk.io>
Date: Tue, 5 Nov 2024 00:57:45 +1100
Subject: [PATCH 4/5] New assert function

---
 hedgehog/HaskellWorks/Polysemy/Hedgehog.hs                 | 1 +
 hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs | 7 +++++++
 2 files changed, 8 insertions(+)

diff --git a/hedgehog/HaskellWorks/Polysemy/Hedgehog.hs b/hedgehog/HaskellWorks/Polysemy/Hedgehog.hs
index 104135d..6fd5269 100644
--- a/hedgehog/HaskellWorks/Polysemy/Hedgehog.hs
+++ b/hedgehog/HaskellWorks/Polysemy/Hedgehog.hs
@@ -29,6 +29,7 @@ module HaskellWorks.Polysemy.Hedgehog
 
     failure,
     failMessage,
+    assert,
     (===),
 
     byDeadlineIO,
diff --git a/hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs
index 99deabb..8b953a6 100644
--- a/hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs
+++ b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs
@@ -4,6 +4,7 @@
 module HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog
   ( Hedgehog,
 
+    assert,
     assertEquals,
     catchAssertion,
     eval,
@@ -38,6 +39,10 @@ import           Polysemy
 import           Polysemy.Final
 
 data Hedgehog m rv where
+  Assert :: HasCallStack
+    => Bool
+    -> Hedgehog m ()
+
   AssertEquals :: (HasCallStack, Eq a, Show a)
     => a
     -> a
@@ -97,6 +102,8 @@ hedgehogToMonadTestFinal :: forall a r m. ()
   => Sem (Hedgehog ': r) a
   -> Sem r a
 hedgehogToMonadTestFinal = interpretFinal \case
+  Assert t ->
+    liftS $ H.assert t
   AssertEquals a b ->
     liftS $ a H.=== b
   CatchAssertion f h -> do

From 9e9774fa9ed617c087d7cc391e0ccd88821ab2ab Mon Sep 17 00:00:00 2001
From: John Ky <john.ky@iohk.io>
Date: Tue, 5 Nov 2024 00:54:20 +1100
Subject: [PATCH 5/5] New success and classify function

---
 hedgehog/HaskellWorks/Polysemy/Hedgehog.hs        |  2 ++
 .../Polysemy/Hedgehog/Effect/Hedgehog.hs          | 15 +++++++++++++++
 2 files changed, 17 insertions(+)

diff --git a/hedgehog/HaskellWorks/Polysemy/Hedgehog.hs b/hedgehog/HaskellWorks/Polysemy/Hedgehog.hs
index 6fd5269..c15c805 100644
--- a/hedgehog/HaskellWorks/Polysemy/Hedgehog.hs
+++ b/hedgehog/HaskellWorks/Polysemy/Hedgehog.hs
@@ -27,6 +27,7 @@ module HaskellWorks.Polysemy.Hedgehog
     trapFailJsonPretty,
     trapFailYaml,
 
+    success,
     failure,
     failMessage,
     assert,
@@ -46,6 +47,7 @@ module HaskellWorks.Polysemy.Hedgehog
     evalIO_,
     evalM_,
 
+    classify,
     forAll,
 
     catchAssertion,
diff --git a/hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs
index 8b953a6..e6582e6 100644
--- a/hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs
+++ b/hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs
@@ -17,6 +17,8 @@ module HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog
     trapAssertion,
 
     forAll,
+    classify,
+    success,
 
     hedgehogToMonadTestFinal,
     hedgehogToPropertyFinal,
@@ -53,6 +55,11 @@ data Hedgehog m rv where
     -> (H.Failure -> m a)
     -> Hedgehog m a
 
+  Classify ::  HasCallStack
+    => H.LabelName
+    -> Bool
+    -> Hedgehog m ()
+
   Eval :: HasCallStack
     => a
     -> Hedgehog m a
@@ -112,6 +119,8 @@ hedgehogToMonadTestFinal = interpretFinal \case
     h' <- bindS h
     pure $ I.catchAssertion f' $ \e -> do
       h' (e <$ s)
+  Classify labelName b ->
+    liftS $ H.classify labelName b
   Eval a ->
     liftS $ H.eval a
   EvalIO f ->
@@ -156,3 +165,9 @@ forAll :: forall a r. ()
   -> Sem r a
 forAll =
   embed . H.forAll
+
+success :: forall r. ()
+  => Member Hedgehog r
+  => Sem r ()
+success =
+  pure ()