packages feed

polysemy-test 0.3.1.6 → 0.3.1.7

raw patch · 5 files changed

+40/−40 lines, 5 filesdep −polysemy-pluginPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: polysemy-plugin

API changes (from Hackage documentation)

- Polysemy.Test: unwrapLiftedTestT :: Monad m => Member (Embed m) r => Sem (Fail : (Error TestError : (Hedgehog m : r))) a -> Sem r (Journal, Either Failure a)
+ Polysemy.Test: unwrapLiftedTestT :: forall m r a. Monad m => Member (Embed m) r => Sem (Fail : (Error TestError : (Hedgehog m : r))) a -> Sem r (Journal, Either Failure a)

Files

lib/Polysemy/Test/Hedgehog.hs view
@@ -4,7 +4,7 @@  import qualified Control.Monad.Trans.Writer.Lazy as MTL import qualified Hedgehog as Native-import Hedgehog.Internal.Property (Failure, Journal, TestT(TestT), failWith)+import Hedgehog.Internal.Property (Failure, Journal, TestT (TestT), failWith) import Polysemy.Writer (Writer, tell)  import qualified Polysemy.Test.Data.Hedgehog as Hedgehog@@ -40,7 +40,7 @@   Bool ->   Sem r () assert a =-  withFrozenCallStack $ liftH (Native.assert a)+  withFrozenCallStack $ liftH @m (Native.assert a)  infix 4 === @@ -63,7 +63,7 @@   a ->   Sem r () a === b =-  withFrozenCallStack $ liftH (a Native.=== b)+  withFrozenCallStack $ liftH @m (a Native.=== b)  infix 4 /== @@ -79,7 +79,7 @@   a ->   Sem r () assertEq a b =-  withFrozenCallStack $ liftH (a Native.=== b)+  withFrozenCallStack $ liftH @m (a Native.=== b)  -- |Embeds 'Hedgehog./=='. --@@ -99,9 +99,9 @@   a ->   Sem r () a /== b =-  withFrozenCallStack $ liftH (a Native./== b)+  withFrozenCallStack $ liftH @m (a Native./== b) --- |Prefix variant of '(===)'.+-- |Prefix variant of '(/==)'. assertNeq ::   ∀ a m r .   Monad m =>@@ -113,7 +113,7 @@   a ->   Sem r () assertNeq a b =-  withFrozenCallStack $ liftH (a Native./== b)+  withFrozenCallStack $ liftH @m (a Native./== b)  -- |Embeds 'Hedgehog.evalEither'. evalEither ::@@ -125,7 +125,7 @@   Either e a ->   Sem r a evalEither e =-  withFrozenCallStack $ liftH (Native.evalEither e)+  withFrozenCallStack $ liftH @m (Native.evalEither e)  -- |Given a reference value, unpacks an 'Either' with 'evalEither' and applies '===' to the result in the -- 'Right' case, and produces a test failure in the 'Left' case.@@ -141,7 +141,7 @@   Either e a ->   Sem r () assertRight a =-  withFrozenCallStack $ (a ===) <=< evalEither+  withFrozenCallStack $ (assertEq @_ @m a) <=< evalEither @_ @m  -- |Like 'assertRight', but for two nested Eithers. assertRight2 ::@@ -157,7 +157,7 @@   Either e1 (Either e2 a) ->   Sem r () assertRight2 a =-  withFrozenCallStack $ assertRight a <=< evalEither+  withFrozenCallStack $ assertRight @_ @m a <=< evalEither @_ @m  -- |Like 'assertRight', but for three nested Eithers. assertRight3 ::@@ -174,7 +174,7 @@   Either e1 (Either e2 (Either e3 a)) ->   Sem r () assertRight3 a =-  withFrozenCallStack $ assertRight2 a <=< evalEither+  withFrozenCallStack $ assertRight2 @_ @m a <=< evalEither @_ @m  -- |Like 'evalEither', but for 'Left'. evalLeft ::@@ -187,7 +187,7 @@   Sem r e evalLeft = \case   Right a ->-    withFrozenCallStack $ liftH $ failWith Nothing $ show a+    withFrozenCallStack $ liftH @m $ failWith Nothing $ show a   Left e ->     pure e @@ -204,7 +204,7 @@   Either e a ->   Sem r () assertLeft e =-  withFrozenCallStack $ (e ===) <=< evalLeft+  withFrozenCallStack $ (assertEq @_ @m e) <=< evalLeft @_ @m  data ValueIsNothing =   ValueIsNothing@@ -219,7 +219,7 @@   Maybe a ->   Sem r a evalMaybe ma =-  withFrozenCallStack $ evalEither (maybeToRight ValueIsNothing ma)+  withFrozenCallStack $ evalEither @_ @m (maybeToRight ValueIsNothing ma)  -- |Given a reference value, asserts that the scrutinee is 'Just' and its contained value matches the target. assertJust ::@@ -233,7 +233,7 @@   Maybe a ->   Sem r () assertJust target ma =-  withFrozenCallStack $ assertRight target (maybeToRight ValueIsNothing ma)+  withFrozenCallStack $ assertRight @_ @m target (maybeToRight ValueIsNothing ma)  -- |Run a Polysemy 'Error' effect and assert its result. evalError ::@@ -245,7 +245,7 @@   Sem (Error e : r) a ->   Sem r a evalError sem =-  withFrozenCallStack $ evalEither =<< runError sem+  withFrozenCallStack $ evalEither @_ @m =<< runError sem  -- |Assert that two numeric values are closer to each other than the specified @delta@. assertCloseBy ::@@ -260,7 +260,7 @@   a ->   Sem r () assertCloseBy delta target scrutinee =-  withFrozenCallStack $ assert (abs (scrutinee - target) < delta)+  withFrozenCallStack $ assert @m (abs (scrutinee - target) < delta)  -- |Assert that two fractional values are closer to each other than @0.001@. assertClose ::@@ -274,4 +274,4 @@   a ->   Sem r () assertClose =-  withFrozenCallStack $ assertCloseBy 0.001+  withFrozenCallStack $ assertCloseBy @_ @m 0.001
lib/Polysemy/Test/Run.hs view
@@ -5,8 +5,8 @@ import Control.Exception (catch) import qualified Control.Monad.Trans.Writer.Lazy as MTL import qualified Data.Text as Text-import GHC.Stack.Types (SrcLoc(SrcLoc, srcLocFile), srcLocModule)-import Hedgehog.Internal.Property (Failure, Journal, TestT(TestT), failWith)+import GHC.Stack.Types (SrcLoc (SrcLoc, srcLocFile), srcLocModule)+import Hedgehog.Internal.Property (Failure, Journal, TestT (TestT), failWith) import Path (Abs, Dir, Path, parseAbsDir, parseRelDir, (</>)) import Path.IO (canonicalizePath, createTempDir, getCurrentDir, getTempDir, removeDirRecur) import Polysemy.Fail (Fail, failToError)@@ -17,7 +17,7 @@ import Polysemy.Test.Data.Hedgehog (Hedgehog, liftH) import qualified Polysemy.Test.Data.Test as Test import Polysemy.Test.Data.Test (Test)-import Polysemy.Test.Data.TestError (TestError(TestError))+import Polysemy.Test.Data.TestError (TestError (TestError)) import qualified Polysemy.Test.Files as Files import Polysemy.Test.Hedgehog (rewriteHedgehog) @@ -55,7 +55,7 @@   Members [Error TestError, Embed IO] r =>   Sem r (Path Abs Dir) createTemp =-  fromEither =<< (embed . runExceptT) do+  fromEither @TestError =<< (embed @IO . runExceptT) do     systemTmp <- getTempDir     createTempDir systemTmp "polysemy-test-" @@ -98,13 +98,14 @@   (interpretTest base) sem  errorToFailure ::+  ∀ m r a .   Monad m =>   Member (Hedgehog m) r =>   Either TestError a ->   Sem r a errorToFailure = \case   Right a -> pure a-  Left (TestError e) -> liftH (failWith Nothing (toString e))+  Left (TestError e) -> liftH @m (failWith Nothing (toString e))  failToFailure ::   Member (Error TestError) r =>@@ -114,6 +115,7 @@  -- |Run 'Hedgehog' and its dependent effects that correspond to the monad stack of 'TestT', exposing the monadic state. unwrapLiftedTestT ::+  ∀ m r a .   Monad m =>   Member (Embed m) r =>   Sem (Fail : Error TestError : Hedgehog m : r) a ->@@ -123,7 +125,7 @@   runError .   rewriteHedgehog .   raiseUnder2 .-  (>>= errorToFailure) .+  (>>= errorToFailure @m) .   runError .   failToFailure @@ -185,7 +187,7 @@ callingTestDir = do   SrcLoc { srcLocFile = toText -> file, srcLocModule = toText -> modl } <- note emptyCallStack deepestSrcLoc   dirPrefix <- note badSrcLoc (Text.stripSuffix (Text.replace "." "/" modl <> ".hs") file)-  cwd <- embed getCurrentDir+  cwd <- embed @IO getCurrentDir   note badSrcLoc (parseDir cwd (toString dirPrefix))   where     emptyCallStack =
polysemy-test.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           polysemy-test-version:        0.3.1.6+version:        0.3.1.7 synopsis:       Polysemy effects for testing description:    Please see the README on Github at <https://github.com/tek/polysemy-test> category:       Test@@ -95,7 +95,7 @@       UndecidableInstances       UnicodeSyntax       ViewPatterns-  ghc-options: -Wall -fplugin=Polysemy.Plugin+  ghc-options: -Wall   build-depends:       base >=4.12 && <5     , containers@@ -104,7 +104,6 @@     , path >=0.7     , path-io >=0.2     , polysemy >=1.3-    , polysemy-plugin >=0.2.5     , relude >=0.7     , string-interpolate >=0.1     , tasty >=1.1@@ -182,7 +181,7 @@       UndecidableInstances       UnicodeSyntax       ViewPatterns-  ghc-options: -Wall -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N -fplugin=Polysemy.Plugin+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N   build-depends:       base >=4.12 && <5     , containers@@ -191,7 +190,6 @@     , path >=0.7     , path-io >=0.2     , polysemy >=1.3-    , polysemy-plugin >=0.2.5     , polysemy-test     , relude >=0.7     , string-interpolate >=0.1
test/Polysemy/Test/Test/FilesTest.hs view
@@ -15,9 +15,9 @@     fixContent1 <- fixtureLines fixRel     fixPath <- Test.fixturePath fixRel     fixContent2 <- Text.lines <$> embed (Text.readFile (toFilePath fixPath))-    fixContent1 === fixContent2-    fixContent1 === ["file", "content"]-    fixContent1 /== ["file", "content", "and more"]+    (===) @_ @IO fixContent1 fixContent2+    (===) @_ @IO fixContent1 ["file", "content"]+    (/==) @_ @IO fixContent1 ["file", "content", "and more"]   where     fixRel =       [relfile|files/file1|]@@ -28,8 +28,8 @@     tempFile <- Test.tempFile content path     tempFileContent1 <- tempFileLines path     tempFIleContent2 <- Text.lines <$> embed (Text.readFile (toFilePath tempFile))-    tempFileContent1 === tempFIleContent2-    tempFileContent1 === content+    (===) @_ @IO tempFileContent1 tempFIleContent2+    (===) @_ @IO tempFileContent1 content   where     path =       [relfile|tempfile/file1|]
test/Polysemy/Test/Test/HedgehogTest.hs view
@@ -1,10 +1,10 @@ module Polysemy.Test.Test.HedgehogTest where  import Hedgehog (TestT, assert)-import Hedgehog.Internal.Property (Failure(Failure), runTestT)-+import Hedgehog.Internal.Property (Failure (Failure), runTestT) import Polysemy.Fail (Fail) import Polysemy.Resource (Resource)+ import Polysemy.Test (UnitTest, runTestAuto, (/==)) import Polysemy.Test.Data.Hedgehog (Hedgehog) import Polysemy.Test.Data.Test (Test)@@ -14,7 +14,7 @@  test_hedgehogRewrite :: UnitTest test_hedgehogRewrite =-  semToTestTFinal ((1 :: Int) /== 2)+  semToTestTFinal ((/==) @_ @IO (1 :: Int) 2)  hedgehogTest ::   Sem [Test, Fail, Error TestError, Hedgehog IO, Embed IO, Resource, Final IO] () ->@@ -50,5 +50,5 @@  test_close :: UnitTest test_close = do-  hedgehogSuccess (assertClose (1.11111 :: Double) 1.111111111111)-  hedgehogFail (assertClose (1.11 :: Double) 1.111111111111)+  hedgehogSuccess (assertClose @_ @IO (1.11111 :: Double) 1.111111111111)+  hedgehogFail (assertClose @_ @IO (1.11 :: Double) 1.111111111111)