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 +18/−18
- lib/Polysemy/Test/Run.hs +9/−7
- polysemy-test.cabal +3/−5
- test/Polysemy/Test/Test/FilesTest.hs +5/−5
- test/Polysemy/Test/Test/HedgehogTest.hs +5/−5
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)