diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,1 +1,1 @@ -# Unreleased +# 0.9.0.0 diff --git a/lib/Zeugma.hs b/lib/Zeugma.hs --- a/lib/Zeugma.hs +++ b/lib/Zeugma.hs @@ -13,9 +13,10 @@ runTestFrozenLevel, testTime, - -- * Resumable to TestError conversion + -- * Resumable and 'Polysemy.Error.Error' to 'Polysemy.Test.TestError' conversion stopTest, resumeTest, + errorTest, -- * Reexports of ubiquitous names unitTest, @@ -47,4 +48,4 @@ runTestTrace, testTime, ) -import Zeugma.TestError (resumeTest, stopTest) +import Zeugma.TestError (errorTest, resumeTest, stopTest) diff --git a/lib/Zeugma/Run.hs b/lib/Zeugma/Run.hs --- a/lib/Zeugma/Run.hs +++ b/lib/Zeugma/Run.hs @@ -1,4 +1,4 @@ -{-# language NoImplicitPrelude #-} +{-# language NoImplicitPrelude, CPP #-} {-# options_haddock prune #-} -- | Test runners for polysemy-conc programs using hedgehog. @@ -6,24 +6,21 @@ import qualified Chronos import Chronos (datetimeToTime) -import Conc ( - Critical, - Gates, - interpretCritical, - interpretGates, - interpretInterrupt, - interpretMaskFinal, - interpretRace, - interpretUninterruptibleMaskFinal, - ) +import Conc (Critical, Gates, interpretCritical, interpretGates, interpretMaskFinal, interpretRace) import Hedgehog (TestT) import Hedgehog.Internal.Property (Failure) import Incipit import Log (Severity (Crit, Debug, Trace), interpretLogStderrLevelConc) import Polysemy.Chronos (ChronosTime, interpretTimeChronos, interpretTimeChronosConstant) -import Polysemy.Test (Hedgehog, Test, TestError (TestError), runTestAuto) +import Polysemy.Test (Hedgehog, SkipTestDefaultValue, Test, TestError (TestError), runTestAuto) import Time (mkDatetime) +#if MIN_VERSION_polysemy_process(0, 14, 0) +import Polysemy.Process (Interrupt, interpretInterrupt) +#else +import Conc (interpretInterrupt) +#endif + type ConcTestStack' = [ Log, @@ -31,7 +28,6 @@ Critical, Gates, Mask, - UninterruptibleMask, Race, Async, Stop Text, @@ -63,7 +59,6 @@ stopToError . asyncToIOFinal . interpretRace . - interpretUninterruptibleMaskFinal . interpretMaskFinal . interpretGates . interpretCritical . @@ -93,6 +88,8 @@ -- | Run the test stack as a 'TestT' with the specified log level. runTestLevel :: + HasCallStack => + SkipTestDefaultValue a => Severity -> Sem TestStack a -> TestT IO a @@ -101,6 +98,8 @@ -- | Run the test stack as a 'TestT' with the specified log level, with 'ChronosTime' frozen at 'testTime'. runTestFrozenLevel :: + HasCallStack => + SkipTestDefaultValue a => Severity -> Sem TestStack a -> TestT IO a @@ -108,31 +107,55 @@ runTestAuto . interpretTestFrozen level -- | Run the test stack as a 'TestT' with a log level of 'Trace'. -runTestTrace :: Sem TestStack a -> TestT IO a +runTestTrace :: + HasCallStack => + SkipTestDefaultValue a => + Sem TestStack a -> + TestT IO a runTestTrace = runTestLevel Trace -- | Run the test stack as a 'TestT' with a log level of 'Debug'. -runTestDebug :: Sem TestStack a -> TestT IO a +runTestDebug :: + HasCallStack => + SkipTestDefaultValue a => + Sem TestStack a -> + TestT IO a runTestDebug = runTestLevel Debug -- | Run the test stack as a 'TestT' with a log level of 'Crit'. -runTest :: Sem TestStack a -> TestT IO a +runTest :: + HasCallStack => + SkipTestDefaultValue a => + Sem TestStack a -> + TestT IO a runTest = runTestLevel Crit -- | Run the test stack as a 'TestT' with a log level of 'Trace' and 'ChronosTime' frozen at 'testTime'. -runTestFrozenTrace :: Sem TestStack a -> TestT IO a +runTestFrozenTrace :: + HasCallStack => + SkipTestDefaultValue a => + Sem TestStack a -> + TestT IO a runTestFrozenTrace = runTestFrozenLevel Trace -- | Run the test stack as a 'TestT' with a log level of 'Debug' and 'ChronosTime' frozen at 'testTime'. -runTestFrozenDebug :: Sem TestStack a -> TestT IO a +runTestFrozenDebug :: + HasCallStack => + SkipTestDefaultValue a => + Sem TestStack a -> + TestT IO a runTestFrozenDebug = runTestFrozenLevel Debug -- | Run the test stack as a 'TestT' with a log level of 'Crit' and 'ChronosTime' frozen at 'testTime'. -runTestFrozen :: Sem TestStack a -> TestT IO a +runTestFrozen :: + HasCallStack => + SkipTestDefaultValue a => + Sem TestStack a -> + TestT IO a runTestFrozen = runTestFrozenLevel Crit diff --git a/lib/Zeugma/TestError.hs b/lib/Zeugma/TestError.hs --- a/lib/Zeugma/TestError.hs +++ b/lib/Zeugma/TestError.hs @@ -26,3 +26,13 @@ InterpreterFor eff r resumeTest ma = withFrozenCallStack (resumeHoistError @err (TestError . show) ma) + +-- | Interpret 'Error' converting the error to 'TestError', with the call site's stack. +errorTest :: + ∀ err r . + Show err => + HasCallStack => + Member (Error TestError) r => + InterpreterFor (Error err) r +errorTest ma = + withFrozenCallStack (mapError (TestError . show) ma) diff --git a/zeugma.cabal b/zeugma.cabal --- a/zeugma.cabal +++ b/zeugma.cabal @@ -1,35 +1,39 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.35.0. +-- This file has been generated from package.yaml by hpack version 0.38.2. -- -- see: https://github.com/sol/hpack name: zeugma -version: 0.7.0.0 +version: 0.11.0.0 synopsis: Polysemy effects for testing description: See https://hackage.haskell.org/package/zeugma/docs/Zeugma.html category: Prelude -homepage: https://git.tryp.io/tek/incipit +homepage: https://github.com/tek/incipit#readme bug-reports: https://github.com/tek/incipit/issues author: Torsten Schmits maintainer: hackage@tryp.io -copyright: 2022 Torsten Schmits +copyright: 2025 Torsten Schmits license: BSD-2-Clause-Patent license-file: LICENSE build-type: Simple extra-source-files: - changelog.md readme.md + changelog.md source-repository head type: git - location: https://git.tryp.io/tek/incipit + location: https://github.com/tek/incipit library exposed-modules: Zeugma Zeugma.Run Zeugma.TestError + other-modules: + Paths_zeugma + autogen-modules: + Paths_zeugma reexported-modules: Hedgehog , Polysemy.Test @@ -41,75 +45,50 @@ default-extensions: AllowAmbiguousTypes ApplicativeDo - BangPatterns - BinaryLiterals BlockArguments - ConstraintKinds DataKinds DefaultSignatures DeriveAnyClass - DeriveDataTypeable - DeriveFoldable - DeriveFunctor - DeriveGeneric - DeriveLift - DeriveTraversable DerivingStrategies DerivingVia DisambiguateRecordFields - DoAndIfThenElse DuplicateRecordFields - EmptyCase - EmptyDataDecls - ExistentialQuantification - FlexibleContexts - FlexibleInstances FunctionalDependencies GADTs - GeneralizedNewtypeDeriving - InstanceSigs - KindSignatures LambdaCase LiberalTypeSynonyms - MultiParamTypeClasses + MonadComprehensions MultiWayIf - NamedFieldPuns + NoFieldSelectors OverloadedLabels OverloadedLists + OverloadedRecordDot OverloadedStrings PackageImports PartialTypeSignatures - PatternGuards PatternSynonyms - PolyKinds QuantifiedConstraints QuasiQuotes - RankNTypes RecordWildCards RecursiveDo RoleAnnotations - ScopedTypeVariables - StandaloneDeriving TemplateHaskell - TupleSections - TypeApplications TypeFamilies TypeFamilyDependencies - TypeOperators - TypeSynonymInstances UndecidableInstances UnicodeSyntax ViewPatterns - ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages + ghc-options: -Wall -Widentities -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Wredundant-constraints -Wunused-type-patterns -Wunused-packages build-depends: - chronos - , hedgehog - , incipit ==0.7.0.0 - , polysemy ==1.9.* - , polysemy-chronos ==0.6.* - , polysemy-test ==0.7.* - , tasty ==1.4.* - , tasty-expected-failure ==0.12.* - , tasty-hedgehog >=1.3 && <1.5 - , unix - default-language: Haskell2010 + base >=4.17.2.1 && <4.22 + , chronos >=1.1.5 && <1.2 + , hedgehog >=1.4 && <1.8 + , incipit <0.12 + , polysemy >=1.9.1.0 && <1.10 + , polysemy-chronos >=0.5.0.0 && <0.8 + , polysemy-process >=0.12.0.0 && <0.16 + , polysemy-test >=0.11.0.1 && <0.12 + , tasty >=1.5.2 && <1.6 + , tasty-expected-failure >=0.11.1.2 && <0.13 + , tasty-hedgehog >=1.4.0.2 && <1.5 + default-language: GHC2021