Convert hedgehog api to use new hedgehog effect (#13)

* Hide -Werror in dev flag

* Convert hedgehog api to use new hedgehog effect that supports property tests

* Remove unused type class MonadTestProxy

* Convert hedgehog api to use new effects

* Move PropertyTest and UnitTest types to their own modules

* Disable deprecations in Effectful.Zoo.Core.Prim

* Bump tasty version

* Re-exports from Effectful.Zoo.Hedgehog.Data

* Refactor Core submodules to not be submodules

Author: newhoggy

components/blockfrost/Effectful/Zoo/Blockfrost/Api.hs

@@ -339,10 +339,10 @@ import Data.Maybe
 import Data.Text
 import Effectful
 import Effectful.Dispatch.Dynamic
-import Effectful.Zoo.Core.Error.Static
 import Effectful.Zoo.Blockfrost.Dynamic (Blockfrost, runBlockfrost)
 import Effectful.Zoo.Blockfrost.Dynamic qualified as BF
 import Effectful.Zoo.Core
+import Effectful.Zoo.Error.Static
 import HaskellWorks.Prelude
 
 -- Client

components/core/Effectful/Zoo/Aeson.hs

@@ -7,7 +7,7 @@ import Data.Aeson qualified as Aeson
 import Data.ByteString.Lazy qualified as LBS
 import Effectful
 import Effectful.Zoo.Core
-import Effectful.Zoo.Core.Error.Static
+import Effectful.Zoo.Error.Static
 import HaskellWorks.Error.Types.JsonDecodeError
 import HaskellWorks.Prelude
 

components/core/Effectful/Zoo/Core.hs

@@ -3,4 +3,4 @@ module Effectful.Zoo.Core
     type (<<:),
   ) where
 
-import           Effectful.Zoo.Core.Prim
+import Effectful.Zoo.Prim

components/core/Effectful/Zoo/Core/Error/Dynamic.hs renamed to components/core/Effectful/Zoo/Error/Dynamic.hs

@@ -1,4 +1,4 @@
-module Effectful.Zoo.Core.Error.Dynamic
+module Effectful.Zoo.Error.Dynamic
   ( Error,
 
     throw,

components/core/Effectful/Zoo/Core/Error/Static.hs renamed to components/core/Effectful/Zoo/Error/Static.hs

@@ -1,4 +1,4 @@
-module Effectful.Zoo.Core.Error.Static
+module Effectful.Zoo.Error.Static
   ( Error,
 
     throw,
@@ -33,7 +33,7 @@ module Effectful.Zoo.Core.Error.Static
 import Effectful
 import Effectful.Error.Static (Error, runError)
 import Effectful.Error.Static qualified as E
-import Effectful.Zoo.Core
+import Effectful.Zoo.Prim
 import HaskellWorks.Prelude
 
 throw :: forall e r a. ()

components/core/Effectful/Zoo/Core/Exception.hs renamed to components/core/Effectful/Zoo/Exception.hs

@@ -1,4 +1,4 @@
-module Effectful.Zoo.Core.Exception
+module Effectful.Zoo.Exception
   ( Exception,
     catchIO,
     throwIO,

components/core/Effectful/Zoo/FileSystem.hs

@@ -25,8 +25,8 @@ import Effectful
 import Effectful.Dispatch.Static
 import Effectful.FileSystem (FileSystem)
 import Effectful.Zoo.Core
-import Effectful.Zoo.Core.Error.Static
-import Effectful.Zoo.Core.Exception
+import Effectful.Zoo.Error.Static
+import Effectful.Zoo.Exception
 import Effectful.Zoo.Log.Api.Text
 import Effectful.Zoo.Log.Dynamic
 import Effectful.Zoo.Unsafe

components/core/Effectful/Zoo/Core/Function.hs renamed to components/core/Effectful/Zoo/Function.hs

@@ -1,11 +1,11 @@
-module Effectful.Zoo.Core.Function
+module Effectful.Zoo.Function
   ( once,
   ) where
 
 import Effectful
 import Effectful.Concurrent
 import Effectful.Concurrent.MVar
-import Effectful.Zoo.Core.Prim
+import Effectful.Zoo.Prim
 import HaskellWorks.Prelude
 
 once :: ()

components/core/Effectful/Zoo/Core/Prim.hs renamed to components/core/Effectful/Zoo/Prim.hs

@@ -1,4 +1,6 @@
-module Effectful.Zoo.Core.Prim
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
+
+module Effectful.Zoo.Prim
   ( type (<:),
     type (<<:)
   ) where

components/hedgehog-test/Effectful/Zoo/Hedgehog/Test/HedgehogTest.hs

@@ -1,16 +1,14 @@
 module Main where
 
 import Effectful.Zoo.Hedgehog.Api.Tasty
-import Effectful.Zoo.Hedgehog.Test.HedgehogTest (test_simple)
 import Effectful.Zoo.Hedgehog.Test.PropertySpec
 import Test.Tasty (TestTree, defaultMain, testGroup)
 import HaskellWorks.Prelude
 
 tests :: TestTree
 tests =
   testGroup "all"
-    [ toTestTree "Simple test" test_simple
-    , toTestTree "Simple property spec" property_spec
+    [ toTestTree "Simple property spec" property_spec
     , toTestTree "Simple test spec" test_spec
     ]
 

components/hedgehog-test/Main.hs

@@ -1,15 +1,11 @@
 module Effectful.Zoo.Hedgehog.Api
   ( module Effectful.Zoo.Hedgehog.Api.Assert,
-    module Effectful.Zoo.Hedgehog.Api.Classify,
-    module Effectful.Zoo.Hedgehog.Api.Eval,
+    module Effectful.Zoo.Hedgehog.Api.Hedgehog,
     module Effectful.Zoo.Hedgehog.Api.Failure,
     module Effectful.Zoo.Hedgehog.Api.Journal,
-    module Effectful.Zoo.Hedgehog.Api.Run,
   ) where
 
 import Effectful.Zoo.Hedgehog.Api.Assert
-import Effectful.Zoo.Hedgehog.Api.Classify
-import Effectful.Zoo.Hedgehog.Api.Eval
 import Effectful.Zoo.Hedgehog.Api.Failure
+import Effectful.Zoo.Hedgehog.Api.Hedgehog
 import Effectful.Zoo.Hedgehog.Api.Journal
-import Effectful.Zoo.Hedgehog.Api.Run

components/hedgehog/Effectful/Zoo/Hedgehog/Api.hs

@@ -1,8 +1,5 @@
 module Effectful.Zoo.Hedgehog.Api.Assert
-  ( assert,
-    (===),
-    (/==),
-    onNothingFail,
+  ( onNothingFail,
     onNothingFailM,
     onLeftFail,
     onLeftFailM,
@@ -22,93 +19,62 @@ import Data.Text.Lazy qualified as LT
 import Data.Text.Lazy.Encoding qualified as LT
 import Data.Yaml qualified as Y
 import Effectful
+import Effectful.Concurrent
 import Effectful.Dispatch.Dynamic
 import Effectful.Zoo.Core
-import Effectful.Zoo.Core.Error.Static
-import Effectful.Zoo.Hedgehog.Api.Failure
-import Effectful.Zoo.Hedgehog.Dynamic
+import Effectful.Zoo.Error.Static
+import Effectful.Zoo.Hedgehog.Api.Hedgehog
+import Effectful.Zoo.Hedgehog.Effect.Hedgehog
 import HaskellWorks.Prelude
-import Hedgehog qualified as H
+import Hedgehog (MonadTest(..))
+import Hedgehog.Internal.Property qualified as H
 
-infix 4 ===, /==
-
-assert :: forall r. ()
-  => HasCallStack
-  => r <: Hedgehog
-  => Bool
-  -> Eff r ()
-assert condition =
-  withFrozenCallStack $
-    H.assert condition
-
-(===) :: forall a r. ()
+onNothingFail :: forall a m. ()
   => HasCallStack
-  => Eq a
-  => Show a
-  => r <: Hedgehog
-  => a
-  -> a
-  -> Eff r ()
-(===) a b =
-  withFrozenCallStack $
-    a H.=== b
-
-(/==) :: forall a r. ()
-  => HasCallStack
-  => Eq a
-  => Show a
-  => r <: Hedgehog
-  => a
-  -> a
-  -> Eff r ()
-(/==) a b =
-  withFrozenCallStack $
-    a H./== b
-
-onNothingFail :: forall a r. ()
-  => HasCallStack
-  => r <: Hedgehog
+  => MonadTest m
   => Maybe a
-  -> Eff r a
+  -> m a
 onNothingFail mv =
   withFrozenCallStack $
     case mv of
       Just a -> pure a
       Nothing -> failWith Nothing "Expected Just, but got Nothing"
 
-onNothingFailM :: forall a r. ()
+onNothingFailM :: forall a m. ()
   => HasCallStack
-  => r <: Hedgehog
-  => Eff r (Maybe a)
-  -> Eff r a
+  => MonadTest m
+  => m (Maybe a)
+  -> m a
 onNothingFailM f =
   withFrozenCallStack $
     f >>= onNothingFail
 
-onLeftFail :: forall e a r. ()
+onLeftFail :: forall e a m. ()
   => HasCallStack
+  => MonadTest m
   => Show e
-  => r <: Hedgehog
   => Either e a
-  -> Eff r a
+  -> m a
 onLeftFail ea =
   withFrozenCallStack $
     case ea of
       Right a -> pure a
       Left e -> failWith Nothing $ "Expected Just, but got Left: " <> show e
 
-onLeftFailM :: forall e a r. ()
+onLeftFailM :: forall e a m. ()
   => HasCallStack
+  => MonadTest m
   => Show e
-  => r <: Hedgehog
-  => Eff r (Either e a)
-  -> Eff r a
+  => m (Either e a)
+  -> m a
 onLeftFailM f =
   withFrozenCallStack $
     f >>= onLeftFail
 
 trapFail :: forall e a r. ()
   => HasCallStack
+  => r <: Concurrent
+  => r <: Error H.Failure
   => r <: Hedgehog
   => Show e
   => Eff (Error e ': r) a
@@ -122,6 +88,8 @@ trapFail f =
 
 trapFailJson :: forall e a r. ()
   => HasCallStack
+  => r <: Concurrent
+  => r <: Error H.Failure
   => r <: Hedgehog
   => ToJSON e
   => Eff (Error e ': r) a
@@ -137,6 +105,8 @@ trapFailJson f =
 
 trapFailJsonPretty :: forall e a r. ()
   => HasCallStack
+  => r <: Concurrent
+  => r <: Error H.Failure
   => r <: Hedgehog
   => ToJSON e
   => Eff (Error e ': r) a
@@ -152,6 +122,8 @@ trapFailJsonPretty f =
 
 trapFailYaml :: forall e a r. ()
   => HasCallStack
+  => r <: Concurrent
+  => r <: Error H.Failure
   => r <: Hedgehog
   => ToJSON e
   => Eff (Error e ': r) a