polysemy-test 0.1.0.0 → 0.2.0.0

raw patch · 6 files changed

+111/−145 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• lib/Polysemy/Test.hs +20/−11
• lib/Polysemy/Test/Assert.hs +0/−42
• lib/Polysemy/Test/Data/Hedgehog.hs +9/−79
• lib/Polysemy/Test/Hedgehog.hs +80/−10
• polysemy-test.cabal +1/−2
• test/Polysemy/Test/Test/FilesTest.hs +1/−1

@@ -1,4 +1,9 @@-{-| polysemy-test -}+{-|+This package provides utilities for testing Polysemy programs:++  (1) An effect, 'Test', that gives access to temporary files and fixtures+  (2) An effect, 'Hedgehog', for lifted Hedgehog assertions+-} module Polysemy.Test (   -- $intro   -- * Test effect@@ -12,6 +17,10 @@   runTestInSubdir,   -- * Hedgehog effect   module Polysemy.Test.Data.Hedgehog,+  assert,+  (===),+  assertRight,+  evalEither,   interpretHedgehog,   -- * Utilities   UnitTest,@@ -24,16 +33,20 @@ import Test.Tasty (TestName, TestTree) import Test.Tasty.Hedgehog (testProperty) -import Polysemy.Test.Data.Hedgehog (Hedgehog, assert, assertEqual, assertRight, evalEither, liftH, (===))+import Polysemy.Test.Data.Hedgehog (Hedgehog, liftH) import Polysemy.Test.Data.Test (Test, fixture, fixturePath, tempDir, tempFile, tempFileContent, testDir)-import Polysemy.Test.Hedgehog (interpretHedgehog)+import Polysemy.Test.Hedgehog (assert, assertRight, evalEither, interpretHedgehog, (===)) import Polysemy.Test.Run (interpretTest, interpretTestInSubdir, runTest, runTestAuto, runTestInSubdir)  -- |Convenience type alias for tests. type UnitTest = TestT IO ()  -- |Convert a @'TestT' IO ()@ to a 'TestTree' ready for use with Tasty's machinery.-unitTest :: TestName -> UnitTest -> TestTree+-- This is for non-property tests.+unitTest ::+  TestName ->+  UnitTest ->+  TestTree unitTest desc =   testProperty desc . withTests 1 . property . test @@ -56,12 +69,8 @@   fmap Text.lines . tempFileContent  {- $intro-This package provides utilities for testing Polysemy programs:--  (1) An effect, 'Test', that gives access to temporary files and fixtures-  (2) An effect, 'Hedgehog', for lifted Hedgehog assertions- @+import Path (relfile) import Polysemy.Test import Test.Tasty (defaultMain) @@ -70,15 +79,15 @@   runTestAuto do     fixContent1 <- fixtureLines fixRel     fixPath <- Test.fixturePath fixRel-    fixContent2 <- Text.lines <$> embed (Text.readFile (toFilePath fixPath))+    fixContent2 \<- Text.lines \<$> embed (Text.readFile (toFilePath fixPath))     fixContent1 === fixContent2     fixContent1 === ["file", "content"]   where     fixRel =       [relfile|files/file1|]-@  main :: IO () main =   defaultMain (unitTest test_fixture)+@ -}

@@ -1,42 +0,0 @@-{-# OPTIONS_HADDOCK hide #-}--module Polysemy.Test.Assert (-  module Polysemy.Test.Assert,-  assert,-  evalEither,-  (===),-) where--import Hedgehog (TestT, assert, evalEither, (===))--assertRight ::-  Eq a =>-  Show a =>-  Show e =>-  Monad m =>-  a ->-  Either e a ->-  TestT m ()-assertRight target =-  (target ===) <=< evalEither--data ValueIsNothing =-  ValueIsNothing-  deriving Show--assertJust ::-  Eq a =>-  Show a =>-  Monad m =>-  a ->-  Maybe a ->-  TestT m ()-assertJust target =-  assertRight target . maybeToRight ValueIsNothing--evalMaybe ::-  Monad m =>-  Maybe a ->-  TestT m a-evalMaybe =-  evalEither . maybeToRight ValueIsNothing

@@ -2,94 +2,24 @@  module Polysemy.Test.Data.Hedgehog where -import Hedgehog (TestT)+import Polysemy.Internal (send) -import Polysemy (makeSem_)+import Hedgehog (TestT)  -- |Convenience effect for embedding Hedgehog assertions. data Hedgehog :: Effect where   LiftH :: TestT IO a -> Hedgehog m a-  Assert :: Bool -> Hedgehog m ()-  AssertEqual :: (Eq a, Show a) => a -> a -> Hedgehog m ()-  EvalEither :: Show e => Either e a -> Hedgehog m a-  AssertRight :: (Show e, Eq a, Show a) => a -> Either e a -> Hedgehog m () -makeSem_ ''Hedgehog- -- |Lift a @'TestT' IO@ into Sem.--- >>> liftH (Hedgehog.evalEither (Right 0))+--+-- >>> liftH (Hedgehog.evalEither (Left 0))+-- liftH (Hedgehog.evalEither (Left 0))+-- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^+-- │ 0 liftH ::   ∀ a r .   Member Hedgehog r =>   TestT IO a ->   Sem r a---- |Embeds 'Hedgehog.assert'.-assert ::-  ∀ r .-  Member Hedgehog r =>-  Bool ->-  Sem r ()---- |Embeds 'Hedgehog.(===)'.-assertEqual ::-  ∀ a r .-  Eq a =>-  Show a =>-  Member Hedgehog r =>-  a ->-  a ->-  Sem r ()---- |Alias for 'assertEqual'.--- >>> 5 === 6-(===) ::-  Eq a =>-  Show a =>-  Member Hedgehog r =>-  a ->-  a ->-  Sem r ()-(===) =-  assertEqual---- |Embeds 'Hedgehog.evalEither'.-evalEither ::-  ∀ a e r .-  Show e =>-  Member Hedgehog r =>-  Either e a ->-  Sem r a---- |Given a reference value, unpacks an 'Either' with 'evalEither' and applies 'assertEqual' to the result in the--- 'Right' case, and produces a test failure in the 'Left' case.-assertRight ::-  ∀ a e r .-  Show e =>-  Eq a =>-  Show a =>-  Member Hedgehog r =>-  a ->-  Either e a ->-  Sem r ()--data ValueIsNothing =-  ValueIsNothing-  deriving Show--assertJust ::-  Eq a =>-  Show a =>-  Member Hedgehog r =>-  a ->-  Maybe a ->-  Sem r ()-assertJust target =-  assertRight target . maybeToRight ValueIsNothing--evalMaybe ::-  Member Hedgehog r =>-  Maybe a ->-  Sem r a-evalMaybe =-  evalEither . maybeToRight ValueIsNothing+liftH =+  send . LiftH

@@ -3,10 +3,10 @@ module Polysemy.Test.Hedgehog where  import qualified Hedgehog as Native-import Hedgehog (TestT, (===))+import Hedgehog (TestT)  import qualified Polysemy.Test.Data.Hedgehog as Hedgehog-import Polysemy.Test.Data.Hedgehog (Hedgehog)+import Polysemy.Test.Data.Hedgehog (Hedgehog, liftH)  -- |Interpret 'Hedgehog' into @'TestT' IO@ by simple embedding of the native combinators. interpretHedgehog ::@@ -16,11 +16,81 @@   interpret \case     Hedgehog.LiftH t ->       embed t-    Hedgehog.Assert v ->-      embed (Native.assert v)-    Hedgehog.AssertEqual a1 a2 ->-      embed (a1 === a2)-    Hedgehog.EvalEither e ->-      embed (Native.evalEither e)-    Hedgehog.AssertRight a e ->-      embed ((a ===) =<< Native.evalEither e)++-- |Embeds 'Hedgehog.assert'.+assert ::+  ∀ r .+  HasCallStack =>+  Member Hedgehog r =>+  Bool ->+  Sem r ()+assert a =+  withFrozenCallStack $ liftH (Native.assert a)++-- |Embeds 'Hedgehog.==='.+--+-- >>> 5 === 6+-- 5 === 6+-- ^^^^^^^+-- │ ━━━ Failed (- lhs) (+ rhs) ━━━+-- │ - 5+-- │ + 6+(===) ::+  Eq a =>+  Show a =>+  HasCallStack =>+  Member Hedgehog r =>+  a ->+  a ->+  Sem r ()+a === b =+  withFrozenCallStack $ liftH (a Native.=== b)++-- |Embeds 'Hedgehog.evalEither'.+evalEither ::+  ∀ a e r .+  Show e =>+  HasCallStack =>+  Member Hedgehog r =>+  Either e a ->+  Sem r a+evalEither e =+  withFrozenCallStack $ liftH (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.+assertRight ::+  ∀ a e r .+  Show e =>+  Eq a =>+  Show a =>+  HasCallStack =>+  Member Hedgehog r =>+  a ->+  Either e a ->+  Sem r ()+assertRight a e =+  withFrozenCallStack $ (a ===) =<< evalEither e++data ValueIsNothing =+  ValueIsNothing+  deriving Show++assertJust ::+  Eq a =>+  Show a =>+  HasCallStack =>+  Member Hedgehog r =>+  a ->+  Maybe a ->+  Sem r ()+assertJust target ma =+  withFrozenCallStack $ assertRight target (maybeToRight ValueIsNothing ma)++evalMaybe ::+  HasCallStack =>+  Member Hedgehog r =>+  Maybe a ->+  Sem r a+evalMaybe ma =+  withFrozenCallStack $ evalEither (maybeToRight ValueIsNothing ma)

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           polysemy-test-version:        0.1.0.0+version:        0.2.0.0 synopsis:       Polysemy effects for testing description:    Please see the README on Github at <https://github.com/tek/polysemy-test> category:       Test@@ -22,7 +22,6 @@ library   exposed-modules:       Polysemy.Test-      Polysemy.Test.Assert       Polysemy.Test.Data.Hedgehog       Polysemy.Test.Data.Test       Polysemy.Test.Data.TestError

@@ -4,7 +4,7 @@ import qualified Data.Text.IO as Text import Path (relfile, toFilePath) -import Polysemy.Test (UnitTest, fixtureLines, runTestInSubdir, runTestAuto, tempFileLines, (===))+import Polysemy.Test (UnitTest, fixtureLines, runTestAuto, runTestInSubdir, tempFileLines, (===)) import qualified Polysemy.Test.Data.Test as Test  test_fixture :: UnitTest