diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index e8653fe9..6de257d9 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -118,7 +118,7 @@ jobs: tar zcvf artifacts-${{ runner.OS }}-${{ matrix.ghc }}.tar.gz artifacts - - uses: actions/upload-artifact@v2 + - uses: actions/upload-artifact@v4 with: name: artifacts-${{ runner.OS }}-${{ matrix.ghc }}.tar.gz path: artifacts-${{ runner.OS }}-${{ matrix.ghc }}.tar.gz @@ -226,7 +226,7 @@ jobs: os: [ubuntu-latest, macos-latest] steps: - - uses: actions/download-artifact@v2 + - uses: actions/download-artifact@v4 id: download_artifact with: name: artifacts-${{ runner.OS }}-${{ matrix.ghc }}.tar.gz diff --git a/src/Hedgehog/Extras/Test/Base.hs b/src/Hedgehog/Extras/Test/Base.hs index 5e364e0f..8cd3112f 100644 --- a/src/Hedgehog/Extras/Test/Base.hs +++ b/src/Hedgehog/Extras/Test/Base.hs @@ -16,18 +16,30 @@ module Hedgehog.Extras.Test.Base , noteIO_ , noteShow - , noteShow_ - , noteShowM - , noteShowM_ + , noteShowPretty , noteShowIO + , noteShowPrettyIO , noteShowIO_ + , noteShowPrettyIO_ + , noteShowM + , noteShowPrettyM + , noteShowM_ + , noteShowPrettyM_ + , noteShow_ + , noteShowPretty_ , noteEach - , noteEach_ - , noteEachM - , noteEachM_ + , noteEachPretty , noteEachIO + , noteEachPrettyIO , noteEachIO_ + , noteEachPrettyIO_ + , noteEachM + , noteEachPrettyM + , noteEachM_ + , noteEachPrettyM_ + , noteEach_ + , noteEachPretty_ , noteTempFile @@ -119,6 +131,7 @@ import qualified Hedgehog as H import qualified Hedgehog.Extras.Internal.Test.Integration as H import qualified Hedgehog.Extras.Test.MonadAssertion as H import qualified Hedgehog.Internal.Property as H +import qualified Hedgehog.Internal.Show as H import qualified System.Directory as IO import qualified System.Environment as IO import qualified System.Info as IO @@ -224,10 +237,23 @@ noteShow a = GHC.withFrozenCallStack $ do noteWithCallstack GHC.callStack (show b) return b +-- | Annotate the given value, pretty printing it with indentation. Note that large data structures will take +-- a significant amount of vertical screen space. +noteShowPretty :: (MonadTest m, HasCallStack, Show a) => a -> m a +noteShowPretty a = GHC.withFrozenCallStack $ do + !b <- H.eval a + noteWithCallstack GHC.callStack (H.showPretty b) + return b + -- | Annotate the given value returning unit. noteShow_ :: (MonadTest m, HasCallStack, Show a) => a -> m () noteShow_ a = GHC.withFrozenCallStack $ noteWithCallstack GHC.callStack (show a) +-- | Annotate the given value returning unit, pretty printing it with indentation. Note that large data structures will take +-- a significant amount of vertical screen space. +noteShowPretty_ :: (MonadTest m, HasCallStack, Show a) => a -> m () +noteShowPretty_ a = GHC.withFrozenCallStack $ noteWithCallstack GHC.callStack (H.showPretty a) + -- | Annotate the given value in a monadic context. noteShowM :: (MonadTest m, MonadCatch m, HasCallStack, Show a) => m a -> m a noteShowM a = GHC.withFrozenCallStack $ do @@ -235,6 +261,14 @@ noteShowM a = GHC.withFrozenCallStack $ do noteWithCallstack GHC.callStack (show b) return b +-- | Annotate the given value in a monadic context, pretty printing it with indentation. Note that large data structures will take +-- a significant amount of vertical screen space. +noteShowPrettyM :: (MonadTest m, MonadCatch m, HasCallStack, Show a) => m a -> m a +noteShowPrettyM a = GHC.withFrozenCallStack $ do + !b <- H.evalM a + noteWithCallstack GHC.callStack (H.showPretty b) + return b + -- | Annotate the given value in a monadic context returning unit. noteShowM_ :: (MonadTest m, MonadCatch m, HasCallStack, Show a) => m a -> m () noteShowM_ a = GHC.withFrozenCallStack $ do @@ -242,6 +276,14 @@ noteShowM_ a = GHC.withFrozenCallStack $ do noteWithCallstack GHC.callStack (show b) return () +-- | Annotate the given value in a monadic context returning unit, pretty printing it with indentation. Note that large data structures will take +-- a significant amount of vertical screen space. +noteShowPrettyM_ :: (MonadTest m, MonadCatch m, HasCallStack, Show a) => m a -> m () +noteShowPrettyM_ a = GHC.withFrozenCallStack $ do + !b <- H.evalM a + noteWithCallstack GHC.callStack (H.showPretty b) + return () + -- | Annotate the given value in IO. noteShowIO :: (MonadTest m, MonadIO m, HasCallStack, Show a) => IO a -> m a noteShowIO f = GHC.withFrozenCallStack $ do @@ -249,6 +291,14 @@ noteShowIO f = GHC.withFrozenCallStack $ do noteWithCallstack GHC.callStack (show a) return a +-- | Annotate the given value in IO, pretty printing it with indentation. Note that large data structures will take +-- a significant amount of vertical screen space. +noteShowPrettyIO :: (MonadTest m, MonadIO m, HasCallStack, Show a) => IO a -> m a +noteShowPrettyIO f = GHC.withFrozenCallStack $ do + !a <- H.evalIO f + noteWithCallstack GHC.callStack (H.showPretty a) + return a + -- | Annotate the given value in IO returning unit. noteShowIO_ :: (MonadTest m, MonadIO m, HasCallStack, Show a) => IO a -> m () noteShowIO_ f = GHC.withFrozenCallStack $ do @@ -256,16 +306,36 @@ noteShowIO_ f = GHC.withFrozenCallStack $ do noteWithCallstack GHC.callStack (show a) return () +-- | Annotate the given value in IO returning unit, pretty printing it with indentation. Note that large data structures will take +-- a significant amount of vertical screen space. +noteShowPrettyIO_ :: (MonadTest m, MonadIO m, HasCallStack, Show a) => IO a -> m () +noteShowPrettyIO_ f = GHC.withFrozenCallStack $ do + !a <- H.evalIO f + noteWithCallstack GHC.callStack (H.showPretty a) + return () + -- | Annotate the each value in the given traversable. noteEach :: (MonadTest m, HasCallStack, Show a, Traversable f) => f a -> m (f a) noteEach as = GHC.withFrozenCallStack $ do for_ as $ noteWithCallstack GHC.callStack . show return as +-- | Annotate the each value in the given traversable, pretty printing it with indentation. Note that large data structures will take +-- a significant amount of vertical screen space. +noteEachPretty :: (MonadTest m, HasCallStack, Show a, Traversable f) => f a -> m (f a) +noteEachPretty as = GHC.withFrozenCallStack $ do + for_ as $ noteWithCallstack GHC.callStack . H.showPretty + return as + -- | Annotate the each value in the given traversable returning unit. noteEach_ :: (MonadTest m, HasCallStack, Show a, Traversable f) => f a -> m () noteEach_ as = GHC.withFrozenCallStack $ for_ as $ noteWithCallstack GHC.callStack . show +-- | Annotate the each value in the given traversable returning unit, pretty printing it with indentation. Note that large data structures will take +-- a significant amount of vertical screen space. +noteEachPretty_ :: (MonadTest m, HasCallStack, Show a, Traversable f) => f a -> m () +noteEachPretty_ as = GHC.withFrozenCallStack $ for_ as $ noteWithCallstack GHC.callStack . H.showPretty + -- | Annotate the each value in the given traversable in a monadic context. noteEachM :: (MonadTest m, HasCallStack, Show a, Traversable f) => m (f a) -> m (f a) noteEachM f = GHC.withFrozenCallStack $ do @@ -273,12 +343,27 @@ noteEachM f = GHC.withFrozenCallStack $ do for_ as $ noteWithCallstack GHC.callStack . show return as +-- | Annotate the each value in the given traversable in a monadic context, pretty printing it with indentation. Note that large data structures will take +-- a significant amount of vertical screen space. +noteEachPrettyM :: (MonadTest m, HasCallStack, Show a, Traversable f) => m (f a) -> m (f a) +noteEachPrettyM f = GHC.withFrozenCallStack $ do + !as <- f + for_ as $ noteWithCallstack GHC.callStack . H.showPretty + return as + -- | Annotate the each value in the given traversable in a monadic context returning unit. noteEachM_ :: (MonadTest m, HasCallStack, Show a, Traversable f) => m (f a) -> m () noteEachM_ f = GHC.withFrozenCallStack $ do !as <- f for_ as $ noteWithCallstack GHC.callStack . show +-- | Annotate the each value in the given traversable in a monadic context returning unit, pretty printing it with indentation. Note that large data structures will take +-- a significant amount of vertical screen space. +noteEachPrettyM_ :: (MonadTest m, HasCallStack, Show a, Traversable f) => m (f a) -> m () +noteEachPrettyM_ f = GHC.withFrozenCallStack $ do + !as <- f + for_ as $ noteWithCallstack GHC.callStack . H.showPretty + -- | Annotate the each value in the given traversable in IO. noteEachIO :: (MonadTest m, MonadIO m, HasCallStack, Show a, Traversable f) => IO (f a) -> m (f a) noteEachIO f = GHC.withFrozenCallStack $ do @@ -286,12 +371,27 @@ noteEachIO f = GHC.withFrozenCallStack $ do for_ as $ noteWithCallstack GHC.callStack . show return as +-- | Annotate the each value in the given traversable in IO, pretty printing it with indentation. Note that large data structures will take +-- a significant amount of vertical screen space. +noteEachPrettyIO :: (MonadTest m, MonadIO m, HasCallStack, Show a, Traversable f) => IO (f a) -> m (f a) +noteEachPrettyIO f = GHC.withFrozenCallStack $ do + !as <- H.evalIO f + for_ as $ noteWithCallstack GHC.callStack . H.showPretty + return as + -- | Annotate the each value in the given traversable in IO returning unit. noteEachIO_ :: (MonadTest m, MonadIO m, HasCallStack, Show a, Traversable f) => IO (f a) -> m () noteEachIO_ f = GHC.withFrozenCallStack $ do !as <- H.evalIO f for_ as $ noteWithCallstack GHC.callStack . show +-- | Annotate the each value in the given traversable in IO returning unit, pretty printing it with indentation. Note that large data structures will take +-- a significant amount of vertical screen space. +noteEachPrettyIO_ :: (MonadTest m, MonadIO m, HasCallStack, Show a, Traversable f) => IO (f a) -> m () +noteEachPrettyIO_ f = GHC.withFrozenCallStack $ do + !as <- H.evalIO f + for_ as $ noteWithCallstack GHC.callStack . H.showPretty + -- | Return the test file path after annotating it relative to the project root directory noteTempFile :: (MonadTest m, HasCallStack) => FilePath -> FilePath -> m FilePath noteTempFile tempDir filePath = GHC.withFrozenCallStack $ do