packages feed

polysemy-test 0.3.1.9 → 0.4.0.0

raw patch · 12 files changed

+39/−289 lines, 12 filesdep +incipit-coredep −containersdep −eitherdep −reludesetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: incipit-core

Dependencies removed: containers, either, relude, text

API changes (from Hackage documentation)

+ Polysemy.Test.Data.Hedgehog: [LiftH] :: TestT m a -> Hedgehog m n a
+ Polysemy.Test.Data.Hedgehog: data Hedgehog m :: Effect
+ Polysemy.Test.Data.Hedgehog: liftH :: forall m a r. Member (Hedgehog m) r => TestT m a -> Sem r a
+ Polysemy.Test.Data.Test: [FixturePath] :: Path Rel p -> Test m (Path Abs p)
+ Polysemy.Test.Data.Test: [Fixture] :: Path Rel File -> Test m Text
+ Polysemy.Test.Data.Test: [TempDir] :: Path Rel Dir -> Test m (Path Abs Dir)
+ Polysemy.Test.Data.Test: [TempFileContent] :: Path Rel File -> Test m Text
+ Polysemy.Test.Data.Test: [TempFile] :: [Text] -> Path Rel File -> Test m (Path Abs File)
+ Polysemy.Test.Data.Test: [TestDir] :: Test m (Path Abs Dir)
+ Polysemy.Test.Data.Test: data Test :: Effect
+ Polysemy.Test.Data.Test: fixture :: forall r. Member Test r => Path Rel File -> Sem r Text
+ Polysemy.Test.Data.Test: fixturePath :: forall p r. Member Test r => Path Rel p -> Sem r (Path Abs p)
+ Polysemy.Test.Data.Test: tempDir :: forall r. Member Test r => Path Rel Dir -> Sem r (Path Abs Dir)
+ Polysemy.Test.Data.Test: tempFile :: forall r. Member Test r => [Text] -> Path Rel File -> Sem r (Path Abs File)
+ Polysemy.Test.Data.Test: tempFileContent :: forall r. Member Test r => Path Rel File -> Sem r Text
+ Polysemy.Test.Data.Test: testDir :: forall r. Member Test r => Sem r (Path Abs Dir)
+ Polysemy.Test.Data.TestError: TestError :: Text -> TestError
+ Polysemy.Test.Data.TestError: [$sel:unTestError:TestError] :: TestError -> Text
+ Polysemy.Test.Data.TestError: instance Data.String.IsString Polysemy.Test.Data.TestError.TestError
+ Polysemy.Test.Data.TestError: instance GHC.Classes.Eq Polysemy.Test.Data.TestError.TestError
+ Polysemy.Test.Data.TestError: instance GHC.Show.Show Polysemy.Test.Data.TestError.TestError
+ Polysemy.Test.Data.TestError: newtype TestError
+ Polysemy.Test.Hedgehog: (/==) :: forall a m r. Monad m => Eq a => Show a => HasCallStack => Member (Hedgehog m) r => a -> a -> Sem r ()
+ Polysemy.Test.Hedgehog: (===) :: forall a m r. Monad m => Eq a => Show a => HasCallStack => Member (Hedgehog m) r => a -> a -> Sem r ()
+ Polysemy.Test.Hedgehog: assert :: forall m r. Monad m => HasCallStack => Member (Hedgehog m) r => Bool -> Sem r ()
+ Polysemy.Test.Hedgehog: assertClose :: forall a m r. Ord a => Fractional a => Monad m => HasCallStack => Member (Hedgehog m) r => a -> a -> Sem r ()
+ Polysemy.Test.Hedgehog: assertCloseBy :: forall a m r. Num a => Ord a => Monad m => HasCallStack => Member (Hedgehog m) r => a -> a -> a -> Sem r ()
+ Polysemy.Test.Hedgehog: assertEq :: forall a m r. Monad m => Eq a => Show a => HasCallStack => Member (Hedgehog m) r => a -> a -> Sem r ()
+ Polysemy.Test.Hedgehog: assertJust :: forall a m r. Eq a => Show a => Monad m => HasCallStack => Member (Hedgehog m) r => a -> Maybe a -> Sem r ()
+ Polysemy.Test.Hedgehog: assertLeft :: forall a m e r. Eq e => Show e => Show a => Monad m => HasCallStack => Member (Hedgehog m) r => e -> Either e a -> Sem r ()
+ Polysemy.Test.Hedgehog: assertNeq :: forall a m r. Monad m => Eq a => Show a => HasCallStack => Member (Hedgehog m) r => a -> a -> Sem r ()
+ Polysemy.Test.Hedgehog: assertRight :: forall a m e r. Eq a => Show e => Show a => Monad m => HasCallStack => Member (Hedgehog m) r => a -> Either e a -> Sem r ()
+ Polysemy.Test.Hedgehog: assertRight2 :: forall a m e1 e2 r. Eq a => Show e1 => Show e2 => Show a => Monad m => HasCallStack => Member (Hedgehog m) r => a -> Either e1 (Either e2 a) -> Sem r ()
+ Polysemy.Test.Hedgehog: assertRight3 :: forall a m e1 e2 e3 r. Eq a => Show e1 => Show e2 => Show e3 => Show a => Monad m => HasCallStack => Member (Hedgehog m) r => a -> Either e1 (Either e2 (Either e3 a)) -> Sem r ()
+ Polysemy.Test.Hedgehog: evalEither :: forall a m e r. Show e => Monad m => HasCallStack => Member (Hedgehog m) r => Either e a -> Sem r a
+ Polysemy.Test.Hedgehog: evalError :: forall e a m r. Show e => Monad m => HasCallStack => Member (Hedgehog m) r => Sem (Error e : r) a -> Sem r a
+ Polysemy.Test.Hedgehog: evalLeft :: forall a m e r. Show a => Monad m => HasCallStack => Member (Hedgehog m) r => Either e a -> Sem r e
+ Polysemy.Test.Hedgehog: evalMaybe :: forall a m r. Monad m => HasCallStack => Member (Hedgehog m) r => Maybe a -> Sem r a
+ Polysemy.Test.Hedgehog: infix 4 /==
+ Polysemy.Test.Hedgehog: instance GHC.Show.Show Polysemy.Test.Hedgehog.ValueIsNothing
+ Polysemy.Test.Hedgehog: interpretHedgehog :: Member (Embed (TestT m)) r => InterpreterFor (Hedgehog m) r
+ Polysemy.Test.Hedgehog: rewriteHedgehog :: Members [Error Failure, Writer Journal, Embed m] r => InterpreterFor (Hedgehog m) r
+ Polysemy.Test.Run: interpretTest :: Members [Error TestError, Resource, Embed IO] r => Path Abs Dir -> InterpreterFor Test r
+ Polysemy.Test.Run: interpretTestInSubdir :: Members [Error TestError, Resource, Embed IO] r => Text -> InterpreterFor Test r
+ Polysemy.Test.Run: interpretTestKeepTemp :: Members [Error TestError, Embed IO] r => Path Abs Dir -> InterpreterFor Test r
+ Polysemy.Test.Run: runTest :: Path Abs Dir -> Sem TestEffects a -> TestT IO a
+ Polysemy.Test.Run: runTestAuto :: HasCallStack => Sem [Test, Fail, Error TestError, Hedgehog IO, Embed IO, Resource, Final IO] a -> TestT IO a
+ Polysemy.Test.Run: runTestAutoWith :: HasCallStack => Members [Resource, Embed IO] r => (forall x. Sem r x -> IO x) -> Sem (Test : (Fail : (Error TestError : (Hedgehog IO : r)))) a -> TestT IO a
+ Polysemy.Test.Run: runTestInSubdir :: Text -> Sem TestEffects a -> TestT IO a
+ Polysemy.Test.Run: semToTestT :: Monad m => Member (Embed m) r => (forall x. Sem r x -> m x) -> Sem (Fail : (Error TestError : (Hedgehog m : r))) a -> TestT m a
+ Polysemy.Test.Run: semToTestTFinal :: Monad m => Sem [Fail, Error TestError, Hedgehog m, Embed m, Final m] a -> TestT m a
+ Polysemy.Test.Run: 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

LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2020 Torsten Schmits+Copyright (c) 2022 Torsten Schmits  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
lib/Polysemy/Test/Data/Hedgehog.hs view
@@ -1,8 +1,7 @@-{-# options_haddock hide #-}+{-# options_haddock prune #-} +-- |Hedgehog Effect, Internal module Polysemy.Test.Data.Hedgehog where--import Polysemy.Internal (send)  import Hedgehog (TestT)
lib/Polysemy/Test/Data/Test.hs view
@@ -1,9 +1,7 @@-{-# options_haddock hide #-}-+-- |Test Effect, Internal module Polysemy.Test.Data.Test where  import Path (Abs, Dir, File, Path, Rel)-import Polysemy (makeSem_)  -- |Operations for interacting with fixtures and temp files in a test. data Test :: Effect where@@ -29,7 +27,7 @@   Path Rel Dir ->   Sem r (Path Abs Dir) --- |Write the specified lines of 'Text' to a file under the temp dir and return its absolute path.+-- |Write the specified lines of 'Data.Text.Text' to a file under the temp dir and return its absolute path. tempFile ::   ∀ r .   Member Test r =>
lib/Polysemy/Test/Data/TestError.hs view
@@ -1,5 +1,6 @@-{-# options_haddock hide #-}+{-# options_haddock prune #-} +-- |TestError Newtype, Internal module Polysemy.Test.Data.TestError where  -- |An error that occured in the test machinery.
lib/Polysemy/Test/Files.hs view
@@ -1,5 +1,6 @@-{-# options_haddock hide #-}+{-# options_haddock prune #-} +-- |File Utilities, Internal module Polysemy.Test.Files where  import qualified Data.Text as Text@@ -59,12 +60,12 @@   Path Rel p ->   Sem r (Path Abs p) fixturePath base path = do-  return $ base </> [reldir|fixtures|] </> path+  pure (base </> [reldir|fixtures|] </> path)  fixture ::   Member (Embed IO) r =>   Path Abs Dir ->   Path Rel File ->   Sem r Text-fixture base subPath = do+fixture base subPath =   readFile =<< fixturePath base subPath
lib/Polysemy/Test/Hedgehog.hs view
@@ -1,11 +1,13 @@-{-# options_haddock hide #-}+{-# options_haddock prune #-} +-- |Hedgehog interpreters, internal module Polysemy.Test.Hedgehog where +import Control.Monad.Trans.Except (runExceptT) import qualified Control.Monad.Trans.Writer.Lazy as MTL+import GHC.Stack (withFrozenCallStack) import qualified Hedgehog as Native import Hedgehog.Internal.Property (Failure, Journal, TestT (TestT), failWith)-import Polysemy.Writer (Writer, tell)  import qualified Polysemy.Test.Data.Hedgehog as Hedgehog import Polysemy.Test.Data.Hedgehog (Hedgehog, liftH)
− lib/Polysemy/Test/Prelude.hs 
@@ -1,231 +0,0 @@-{-# options_haddock hide #-}-{-# options_ghc -Wno-missing-import-lists #-}-{-# LANGUAGE NoImplicitPrelude #-}--module Polysemy.Test.Prelude (-  module Polysemy.Test.Prelude,-  module Data.Either.Combinators,-  module Data.Foldable,-  module Data.Map.Strict,-  module Debug.Trace,-  module GHC.Err,-  module Polysemy,-  module Polysemy.AtomicState,-  module Polysemy.Error,-  module Polysemy.Reader,-  module Polysemy.State,-  module Relude,-) where--import Control.Exception (throwIO, try)-import Data.Either.Combinators (mapLeft)-import Data.Foldable (foldl, traverse_)-import Data.Map.Strict (Map, lookup)-import qualified Data.Text as Text-import Debug.Trace (trace, traceShow)-import GHC.Err (undefined)-import GHC.IO.Unsafe (unsafePerformIO)-import Polysemy (-  Effect,-  EffectRow,-  Embed,-  Final,-  InterpreterFor,-  Member,-  Members,-  Sem,-  WithTactics,-  embed,-  embedToFinal,-  interpret,-  makeSem,-  pureT,-  raise,-  raiseUnder,-  raiseUnder2,-  raiseUnder3,-  reinterpret,-  runFinal,-  )-import Polysemy.AtomicState (AtomicState, atomicGet, atomicGets, atomicModify', atomicPut, runAtomicStateTVar)-import Polysemy.Error (Error, fromEither, mapError, note, runError, throw)-import Polysemy.Reader (Reader)-import Polysemy.State (State, evalState, get, gets, modify, modify', put, runState)-import Relude hiding (-  Reader,-  State,-  Type,-  ask,-  asks,-  evalState,-  filterM,-  get,-  gets,-  hoistEither,-  modify,-  modify',-  put,-  readFile,-  runReader,-  runState,-  state,-  trace,-  traceShow,-  undefined,-  )-import System.IO.Error (userError)--dbg :: Monad m => Text -> m ()-dbg msg = do-  () <- return $ unsafePerformIO (putStrLn (toString msg))-  return ()-{-# INLINE dbg #-}--dbgs :: Monad m => Show a => a -> m ()-dbgs a =-  dbg (show a)-{-# INLINE dbgs_ #-}--dbgs_ :: Monad m => Show a => a -> m a-dbgs_ a =-  a <$ dbg (show a)-{-# INLINE dbgs #-}--unit ::-  Applicative f =>-  f ()-unit =-  pure ()-{-# INLINE unit #-}--tuple ::-  Applicative f =>-  f a ->-  f b ->-  f (a, b)-tuple fa fb =-  (,) <$> fa <*> fb-{-# INLINE tuple #-}--unsafeLogSAnd :: Show a => a -> b -> b-unsafeLogSAnd a b =-  unsafePerformIO $ print a >> return b-{-# INLINE unsafeLogSAnd #-}--unsafeLogAnd :: Text -> b -> b-unsafeLogAnd a b =-  unsafePerformIO $ putStrLn (toString a) >> return b-{-# INLINE unsafeLogAnd #-}--unsafeLogS :: Show a => a -> a-unsafeLogS a =-  unsafePerformIO $ print a >> return a-{-# INLINE unsafeLogS #-}--liftT ::-  forall m f r e a .-  Functor f =>-  Sem r a ->-  Sem (WithTactics e f m r) (f a)-liftT =-  pureT <=< raise-{-# INLINE liftT #-}--hoistEither ::-  Member (Error e2) r =>-  (e1 -> e2) ->-  Either e1 a ->-  Sem r a-hoistEither f =-  fromEither . mapLeft f-{-# INLINE hoistEither #-}--hoistEitherWith ::-  (e -> Sem r a) ->-  Either e a ->-  Sem r a-hoistEitherWith f =-  either f pure-{-# INLINE hoistEitherWith #-}--hoistEitherShow ::-  Show e1 =>-  Member (Error e2) r =>-  (Text -> e2) ->-  Either e1 a ->-  Sem r a-hoistEitherShow f =-  fromEither . mapLeft (f . Text.replace "\\" "" . show)-{-# INLINE hoistEitherShow #-}--hoistErrorWith ::-  (e -> Sem r a) ->-  Sem (Error e : r) a ->-  Sem r a-hoistErrorWith f =-  hoistEitherWith f <=< runError-{-# INLINE hoistErrorWith #-}--tryAny ::-  Member (Embed IO) r =>-  IO a ->-  Sem r (Either Text a)-tryAny =-  embed . fmap (mapLeft show) . try @SomeException-{-# INLINE tryAny #-}--tryHoist ::-  Member (Embed IO) r =>-  (Text -> e) ->-  IO a ->-  Sem r (Either e a)-tryHoist f =-  fmap (mapLeft f) . tryAny-{-# INLINE tryHoist #-}--tryThrow ::-  Members [Embed IO, Error e] r =>-  (Text -> e) ->-  IO a ->-  Sem r a-tryThrow f =-  fromEither <=< tryHoist f-{-# INLINE tryThrow #-}--throwTextIO :: Text -> IO a-throwTextIO =-  throwIO . userError . toString-{-# INLINE throwTextIO #-}--throwEitherIO :: Either Text a -> IO a-throwEitherIO =-  traverseLeft throwTextIO-{-# INLINE throwEitherIO #-}--rightOr :: (a -> b) -> Either a b -> b-rightOr f =-  either f id-{-# INLINE rightOr #-}--traverseLeft ::-  Applicative m =>-  (a -> m b) ->-  Either a b ->-  m b-traverseLeft f =-  either f pure-{-# INLINE traverseLeft #-}--as ::-  Functor m =>-  a ->-  m b ->-  m a-as =-  (<$)-{-# INLINE as #-}--mneToList :: Maybe (NonEmpty a) -> [a]-mneToList =-  maybe [] toList-{-# INLINE mneToList #-}
lib/Polysemy/Test/Run.hs view
@@ -1,17 +1,18 @@-{-# options_haddock hide #-}+{-# options_haddock prune #-} +-- |Test Interpreters, Internal module Polysemy.Test.Run where -import Control.Exception (catch)+import qualified Control.Exception as Base+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Except (ExceptT (ExceptT)) import qualified Control.Monad.Trans.Writer.Lazy as MTL import qualified Data.Text as Text-import GHC.Stack.Types (SrcLoc (SrcLoc, srcLocFile), srcLocModule)+import GHC.Stack (callStack)+import GHC.Stack.Types (SrcLoc (SrcLoc, srcLocFile), getCallStack, 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)-import Polysemy.Resource (Resource, bracket, resourceToIOFinal)-import Polysemy.Writer (runWriter) import System.IO.Error (IOError)  import Polysemy.Test.Data.Hedgehog (Hedgehog, liftH)@@ -25,7 +26,7 @@   IO () ->   IO () ignoringIOErrors ioe =-  catch ioe handler+  Base.catch ioe handler   where     handler :: Monad m => IOError -> m ()     handler =@@ -55,7 +56,7 @@   Members [Error TestError, Embed IO] r =>   Sem r (Path Abs Dir) createTemp =-  fromEither . mapLeft TestError =<< tryAny do+  fromEither . first TestError =<< tryAny do     systemTmp <- getTempDir     createTempDir systemTmp "polysemy-test-" @@ -70,7 +71,7 @@   InterpreterFor Test r interpretTestKeepTemp base sem = do   tempBase <- createTemp-  (interpretTestIn' base tempBase) sem+  interpretTestIn' base tempBase sem  -- |like 'interpretTestKeepTemp', but deletes the temp dir after the test. interpretTest ::@@ -83,7 +84,7 @@     release tempBase =       embed (ignoringIOErrors (removeDirRecur tempBase))     use tempBase =-      (interpretTestIn' base tempBase) sem+      interpretTestIn' base tempBase sem  -- |Call 'interpretTest' with the subdirectory @prefix@ of the current working directory as the base dir, which is -- most likely something like @test@.@@ -95,7 +96,7 @@ interpretTestInSubdir prefix sem = do   prefixPath <- embed (parseRelDir @IO (toString prefix))   base <- embed (canonicalizePath @_ @IO prefixPath)-  (interpretTest base) sem+  interpretTest base sem  errorToFailure ::   ∀ m r a .@@ -136,8 +137,8 @@   (∀ x . Sem r x -> m x) ->   Sem (Fail : Error TestError : Hedgehog m : r) a ->   TestT m a-semToTestT run sem = do-  (journal, result) <- lift (run (unwrapLiftedTestT sem))+semToTestT runSem sem = do+  (journal, result) <- lift (runSem (unwrapLiftedTestT sem))   TestT (ExceptT (result <$ MTL.tell journal))  -- |'Final' version of 'semToTestT'.@@ -208,8 +209,8 @@   (∀ x . Sem r x -> IO x) ->   Sem (Test : Fail : Error TestError : Hedgehog IO : r) a ->   TestT IO a-runTestAutoWith run sem =-  semToTestT run do+runTestAutoWith runSem sem =+  semToTestT runSem do     base <- callingTestDir     interpretTest base sem
− lib/Prelude.hs 
@@ -1,8 +0,0 @@-{-# options_haddock hide #-}-{-# options_ghc -Wno-missing-import-lists #-}--module Prelude (-  module Polysemy.Test.Prelude,-) where--import Polysemy.Test.Prelude
polysemy-test.cabal view
@@ -5,13 +5,13 @@ -- see: https://github.com/sol/hpack  name:           polysemy-test-version:        0.3.1.9+version:        0.4.0.0 synopsis:       Polysemy Effects for Testing description:    See https://hackage.haskell.org/package/polysemy-test/docs/Polysemy-Test.html category:       Test author:         Torsten Schmits maintainer:     haskell@tryp.io-copyright:      2021 Torsten Schmits+copyright:      2022 Torsten Schmits license:        BSD-2-Clause-Patent license-file:   LICENSE build-type:     Simple@@ -29,13 +29,7 @@       Polysemy.Test.Data.TestError       Polysemy.Test.Files       Polysemy.Test.Hedgehog-      Polysemy.Test.Prelude       Polysemy.Test.Run-  other-modules:-      Prelude-      Paths_polysemy_test-  autogen-modules:-      Paths_polysemy_test   hs-source-dirs:       lib   default-extensions:@@ -98,16 +92,13 @@   ghc-options: -Wall -Wredundant-constraints -Wunused-packages   build-depends:       base >=4.12 && <5-    , containers-    , either     , hedgehog >=1.0.2+    , incipit-core     , path >=0.7     , path-io >=0.2     , polysemy >=1.3-    , relude >=0.7     , tasty >=1.1     , tasty-hedgehog >=1.0.0.2-    , text     , transformers   mixins:       base hiding (Prelude)@@ -119,9 +110,6 @@   other-modules:       Polysemy.Test.Test.FilesTest       Polysemy.Test.Test.HedgehogTest-      Paths_polysemy_test-  autogen-modules:-      Paths_polysemy_test   hs-source-dirs:       test   default-extensions:@@ -185,13 +173,11 @@   build-depends:       base >=4.12 && <5     , hedgehog+    , incipit-core     , path     , polysemy     , polysemy-test     , tasty-    , text   mixins:       base hiding (Prelude)-    , polysemy-test hiding (Polysemy.Test.Prelude)-    , polysemy-test (Polysemy.Test.Prelude as Prelude)   default-language: Haskell2010
test/Polysemy/Test/Test/HedgehogTest.hs view
@@ -1,9 +1,8 @@ module Polysemy.Test.Test.HedgehogTest where +import Control.Monad.IO.Class (liftIO) import Hedgehog (TestT, assert) 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)@@ -20,7 +19,7 @@   Sem [Test, Fail, Error TestError, Hedgehog IO, Embed IO, Resource, Final IO] () ->   TestT IO Bool hedgehogTest prog =-  extract . fst <$> liftIO (runTestT $ runTestAuto $ prog)+  extract . fst <$> liftIO (runTestT (runTestAuto prog))   where     extract = \case       Left (Failure (Just _) _ _) ->