skeletest 0.1.0 → 0.1.1
raw patch · 17 files changed
+300/−253 lines, 17 filesdep ~Diffdep ~ghcdep ~unliftio
Dependency ranges changed: Diff, ghc, unliftio
Files
- CHANGELOG.md +5/−0
- README.md +8/−5
- skeletest.cabal +7/−6
- src/Skeletest/Internal/Error.hs +21/−16
- src/Skeletest/Internal/GHC.hs +19/−24
- src/Skeletest/Internal/GHC/Compat.hs +3/−3
- src/Skeletest/Internal/GHC/Compat_9_10.hs +30/−5
- src/Skeletest/Internal/GHC/Compat_9_12.hs +77/−0
- src/Skeletest/Internal/GHC/Compat_9_6.hs +0/−40
- src/Skeletest/Internal/GHC/Compat_9_8.hs +29/−4
- src/Skeletest/Internal/Preprocessor.hs +9/−8
- src/Skeletest/Internal/Utils/Diff.hs +4/−3
- src/bin/skeletest-preprocessor.hs +17/−1
- test/Skeletest/Internal/__snapshots__/SnapshotSpec.snap.md +1/−1
- test/Skeletest/MainSpec.hs +15/−24
- test/Skeletest/PredicateSpec.hs +55/−112
- test/Skeletest/__snapshots__/MainSpec.snap.md +0/−1
CHANGELOG.md view
@@ -1,3 +1,8 @@+## v0.1.1++* Support Diff-1.0+* Support GHC 9.12, drop support for GHC 9.6+ ## v0.1.0 Initial release
README.md view
@@ -1,5 +1,8 @@ # Skeletest +[](https://github.com/brandonchinn178/skeletest/actions?query=branch%3Amain)+[](https://hackage.haskell.org/package/skeletest)+ Skeletest is a batteries-included, opinionated test framework heavily inspired by [pytest](https://pytest.org) and [jest](https://jestjs.io). It's the built-in test framework for [Skelly](https://github.com/brandonchinn178/skelly), but it can be used as a standalone library as well. Features:@@ -30,18 +33,18 @@ myFunc 1 2 `shouldSatisfy` P.list [P.eq "a", P.anything, P.anything] prop "myFunc 0 x == []" $ do- x <- gen $ Gen.int (Range.linear 0 100)+ x <- forAll $ Gen.int (Range.linear 0 100) myFunc 0 x `shouldBe` "" prop "myFunc x y == myFunc y x" $ do- x <- gen $ Gen.int (Range.linear 0 100)- y <- gen $ Gen.int (Range.linear 0 100)+ x <- forAll $ Gen.int (Range.linear 0 100)+ y <- forAll $ Gen.int (Range.linear 0 100) myFunc x y `shouldBe` myFunc y x -- top-level property that's not grouped under -- either myFunc nor otherFunc prop "myFunc x . otherFunc === id" $ do- x <- gen $ Gen.int (Range.linear 0 100)+ x <- forAll $ Gen.int (Range.linear 0 100) let input = Gen.list (Range.linear 0 10) $ Gen.string (Range.linear 0 100) Gen.unicode@@ -190,7 +193,7 @@ `shouldSatisfy` is the most general function, but the others are provided for convenience. `shouldSatisfy` takes in the value being tested on the left, and a predicate on the right. Predicates should be imported from `Skeletest.Predicate`, qualified as `P`. -Some notable predicates are listed here. See the [Haddocks](https://hackage.haskell.org/package/aeson-schemas/docs/Skeletest-Predicate.html) for a full list of available predicates.+Some notable predicates are listed here. See the [Haddocks](https://hackage.haskell.org/package/skeletest/docs/Skeletest-Predicate.html) for a full list of available predicates. * `P.eq 10` * Satisfied when the actual value is equal to `10`.
skeletest.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 name: skeletest-version: 0.1.0+version: 0.1.1 synopsis: Batteries-included, opinionated test framework description: Batteries-included, opinionated test framework. See README.md for more details. homepage: https://github.com/brandonchinn178/skeletest#readme@@ -60,25 +60,25 @@ Skeletest.Prop.Gen Skeletest.Prop.Internal Skeletest.Prop.Range- if impl(ghc >= 9.6) && impl(ghc < 9.8)- other-modules:- Skeletest.Internal.GHC.Compat_9_6 if impl(ghc >= 9.8) && impl(ghc < 9.10) other-modules: Skeletest.Internal.GHC.Compat_9_8 if impl(ghc >= 9.10) && impl(ghc < 9.12) other-modules: Skeletest.Internal.GHC.Compat_9_10+ if impl(ghc >= 9.12) && impl(ghc < 9.14)+ other-modules:+ Skeletest.Internal.GHC.Compat_9_12 build-depends: base < 5 , aeson , aeson-pretty , ansi-terminal >= 0.4.0 , containers- , Diff >= 0.5+ , Diff >= 1.0 , directory , filepath- , ghc ^>= 9.6 || ^>= 9.8 || ^>= 9.10+ , ghc ^>= 9.8 || ^>= 9.10 || ^>= 9.12 , hedgehog , megaparsec , ordered-containers >= 0.2.4@@ -98,6 +98,7 @@ base , skeletest , text+ , unliftio default-language: GHC2021 ghc-options: -Wall -Wcompat
src/Skeletest/Internal/Error.hs view
@@ -7,14 +7,17 @@ invariantViolation, ) where -import Data.List (dropWhileEnd) import Data.Text (Text) import Data.Text qualified as Text import GHC.Utils.Panic (pgmError)-import UnliftIO.Exception (Exception (..))+import UnliftIO.Exception (Exception (..), impureThrow) data SkeletestError- = TestInfoNotFound+ = -- | A user error during compilation, e.g. during the preprocessor or plugin phases.+ CompilationError Text+ | -- | An error in a situation that should never happen, and indicates a bug.+ InvariantViolation Text+ | TestInfoNotFound | CliFlagNotFound Text | FixtureCircularDependency [Text] | SnapshotFileCorrupted FilePath@@ -23,6 +26,17 @@ instance Exception SkeletestError where displayException = Text.unpack . \case+ CompilationError msg ->+ Text.unlines+ [ ""+ , "******************** skeletest failure ********************"+ , msg+ ]+ InvariantViolation msg ->+ Text.unlines+ [ "Invariant violation: " <> msg+ , "**** This is a skeletest bug. Please report it at https://github.com/brandonchinn178/skeletest/issues"+ ] TestInfoNotFound -> "Could not find test info" CliFlagNotFound name ->@@ -32,19 +46,10 @@ SnapshotFileCorrupted fp -> "Snapshot file was corrupted: " <> Text.pack fp --- | Throw a user error during compilation, e.g. during the preprocessor or plugin phases. skeletestPluginError :: String -> a-skeletestPluginError msg =- pgmError . dropWhileEnd (== '\n') . unlines $- [ ""- , "******************** skeletest failure ********************"- , msg- ]+skeletestPluginError = pgmError . stripEnd . displayException . CompilationError . Text.pack+ where+ stripEnd = Text.unpack . Text.stripEnd . Text.pack --- | Throw an error in a situation that should never happen, and indicates a bug. invariantViolation :: String -> a-invariantViolation msg =- error . unlines $- [ "Invariant violation: " <> msg- , "**** This is a skeletest bug. Please report it at https://github.com/brandonchinn178/skeletest/issues"- ]+invariantViolation = impureThrow . InvariantViolation . Text.pack
src/Skeletest/Internal/GHC.hs view
@@ -280,7 +280,7 @@ _ -> HsExprOther getRecField GHC.HsFieldBind{hfbLHS = field, hfbRHS = expr} =- (hsGhcName . GHC.foExt . unLoc $ field, goExpr expr)+ (hsGhcName . unLoc . GHC.Compat.foLabel . unLoc $ field, goExpr expr) -- Collect an application of the form `((f a) b) c` and return `f [a, b, c]` collectApps = \case@@ -402,16 +402,18 @@ [ mkSigD name ty , genLoc . GHC.ValD GHC.noExtField $ GHC.FunBind GHC.noExtField (genLoc name) . GHC.MG GHC.FromSource . genLoc $- [ genLoc $+ [ genLoc GHC.Match- GHC.noAnn- (GHC.FunRhs (genLoc name) GHC.Prefix GHC.NoSrcStrict)- pats- ( GHC.GRHSs- GHC.emptyComments- [genLoc $ GHC.GRHS GHC.noAnn [] body]- (GHC.EmptyLocalBinds GHC.noExtField)- )+ { m_ext = GHC.Compat.xMatch+ , m_ctxt = GHC.Compat.mkPrefixFunRhs (genLoc name) GHC.noAnn+ , m_pats = GHC.Compat.toMatchArgs pats+ , m_grhss =+ GHC.GRHSs+ { grhssExt = GHC.emptyComments+ , grhssGRHSs = [genLoc $ GHC.GRHS GHC.noAnn [] body]+ , grhssLocalBinds = GHC.EmptyLocalBinds GHC.noExtField+ }+ } ] ] where@@ -517,9 +519,9 @@ GHC.MG origin . genLoc $ [ genLoc $ GHC.Match- { m_ext = GHC.noAnn+ { m_ext = GHC.Compat.xMatch , m_ctxt = GHC.Compat.lamAltSingle- , m_pats = pats'+ , m_pats = GHC.Compat.toMatchArgs pats' , m_grhss = GHC.GRHSs { grhssExt = GHC.emptyComments@@ -537,9 +539,9 @@ body' <- goExpr body pure . genLoc $ GHC.Match- { m_ext = GHC.noAnn+ { m_ext = GHC.Compat.xMatch , m_ctxt = GHC.CaseAlt- , m_pats = [pat']+ , m_pats = GHC.Compat.toMatchArgs [pat'] , m_grhss = GHC.GRHSs { grhssExt = GHC.emptyComments@@ -551,7 +553,7 @@ ] pure . genLoc- . GHC.HsCase (onPsOrRn @p GHC.noAnn GHC.Compat.xCaseRn) expr'+ . GHC.HsCase (onPsOrRn @p GHC.noAnn GHC.CaseAlt) expr' $ GHC.MG origin (genLoc matches') HsExprOther -> invariantViolation "Compiling HsExprOther not supported"@@ -641,11 +643,7 @@ } | (field, x) <- fields ]- pure- GHC.HsRecFields- { rec_flds = fields'- , rec_dotdot = Nothing- }+ pure $ GHC.Compat.mkHsRecFields fields' where compileFieldOcc field = do name <- compileHsName field@@ -655,10 +653,7 @@ { foExt = GHC.noExtField , foLabel = genLoc name }- GHC.FieldOcc- { foExt = name- , foLabel = genLoc $ GHC.getRdrName name- }+ (GHC.Compat.fieldOccRn name) genLocConLikeP :: forall p.
src/Skeletest/Internal/GHC/Compat.hs view
@@ -2,10 +2,10 @@ module Skeletest.Internal.GHC.Compat (module X) where -#if __GLASGOW_HASKELL__ == 906-import Skeletest.Internal.GHC.Compat_9_6 as X-#elif __GLASGOW_HASKELL__ == 908+#if __GLASGOW_HASKELL__ == 908 import Skeletest.Internal.GHC.Compat_9_8 as X #elif __GLASGOW_HASKELL__ == 910 import Skeletest.Internal.GHC.Compat_9_10 as X+#elif __GLASGOW_HASKELL__ == 912+import Skeletest.Internal.GHC.Compat_9_12 as X #endif
src/Skeletest/Internal/GHC/Compat_9_10.hs view
@@ -6,7 +6,9 @@ ) where import Data.Data (toConstr)-import GHC+import GHC hiding (FieldOcc (..), mkPrefixFunRhs)+import GHC qualified+import GHC.Types.Name.Reader (getRdrName) import Skeletest.Internal.Error (invariantViolation) @@ -16,9 +18,6 @@ lamAltSingle :: HsMatchContext fn lamAltSingle = LamAlt LamSingle -xCaseRn :: XCase GhcRn-xCaseRn = CaseAlt- hsLit :: HsLit (GhcPass p) -> HsExpr (GhcPass p) hsLit = HsLit noExtField @@ -38,8 +37,34 @@ hsTupPresent :: LHsExpr (GhcPass p) -> HsTupArg (GhcPass p) hsTupPresent = Present noExtField +xMatch :: XCMatch (GhcPass p) b+xMatch = noAnn++mkHsRecFields :: [LHsRecField (GhcPass p) arg] -> HsRecFields (GhcPass p) arg+mkHsRecFields fields =+ GHC.HsRecFields+ { rec_flds = fields+ , rec_dotdot = Nothing+ }++foLabel :: GHC.FieldOcc GhcRn -> LIdP GhcRn+foLabel = genLoc . GHC.foExt++fieldOccRn :: Name -> GHC.FieldOcc GhcRn+fieldOccRn name =+ GHC.FieldOcc+ { GHC.foExt = name+ , GHC.foLabel = genLoc $ getRdrName name+ }+ hsApp :: LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> HsExpr (GhcPass p) hsApp = HsApp noExtField -genLoc :: (NoAnn ann) => e -> GenLocated (EpAnn ann) e+genLoc :: (NoAnn ann) => e -> GenLocated ann e genLoc = L noAnn++mkPrefixFunRhs :: fn -> [ann] -> HsMatchContext fn+mkPrefixFunRhs fn _ = GHC.mkPrefixFunRhs fn++toMatchArgs :: [LPat p] -> [LPat p]+toMatchArgs = id
+ src/Skeletest/Internal/GHC/Compat_9_12.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}++module Skeletest.Internal.GHC.Compat_9_12 (+ module Skeletest.Internal.GHC.Compat_9_12,+ mkPrefixFunRhs,+) where++import Data.Data (toConstr)+import GHC hiding (FieldOcc (..))+import GHC qualified+import GHC.Types.Name.Reader (getRdrName)++import Skeletest.Internal.Error (invariantViolation)++hsLamSingle :: MatchGroup (GhcPass p) (LHsExpr (GhcPass p)) -> HsExpr (GhcPass p)+hsLamSingle = HsLam noAnn LamSingle++lamAltSingle :: HsMatchContext fn+lamAltSingle = LamAlt LamSingle++hsLit :: HsLit (GhcPass p) -> HsExpr (GhcPass p)+hsLit = HsLit noExtField++hsPar :: forall p. (IsPass p) => LHsExpr (GhcPass p) -> HsExpr (GhcPass p)+hsPar =+ HsPar $+ case ghcPass @p of+ GhcPs -> noAnn+ GhcRn -> noExtField+ GhcTc -> invariantViolation "hsPar called in GhcTc"++unHsPar :: HsExpr GhcRn -> LHsExpr GhcRn+unHsPar = \case+ HsPar _ e -> e+ e -> invariantViolation $ "unHsPar called on " <> (show . toConstr) e++hsTupPresent :: LHsExpr (GhcPass p) -> HsTupArg (GhcPass p)+hsTupPresent = Present noExtField++xMatch :: XCMatch (GhcPass p) b+xMatch = noExtField++mkHsRecFields ::+ forall p arg.+ (IsPass p) =>+ [LHsRecField (GhcPass p) arg]+ -> HsRecFields (GhcPass p) arg+mkHsRecFields fields =+ GHC.HsRecFields+ { rec_ext =+ case ghcPass @p of+ GhcPs -> noExtField+ GhcRn -> noExtField+ GhcTc -> invariantViolation "mkHsRecFields called in GhcTc"+ , rec_flds = fields+ , rec_dotdot = Nothing+ }++foLabel :: GHC.FieldOcc GhcRn -> LIdP GhcRn+foLabel = GHC.foLabel++fieldOccRn :: Name -> GHC.FieldOcc GhcRn+fieldOccRn name =+ GHC.FieldOcc+ { GHC.foExt = getRdrName name+ , GHC.foLabel = genLoc name+ }++hsApp :: LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> HsExpr (GhcPass p)+hsApp = HsApp noExtField++genLoc :: (NoAnn ann) => e -> GenLocated ann e+genLoc = L noAnn++toMatchArgs :: [LPat p] -> LocatedE [LPat p]+toMatchArgs = genLoc
− src/Skeletest/Internal/GHC/Compat_9_6.hs
@@ -1,40 +0,0 @@-{-# LANGUAGE LambdaCase #-}--module Skeletest.Internal.GHC.Compat_9_6 (- module Skeletest.Internal.GHC.Compat_9_6,-) where--import Data.Data (toConstr)-import GHC-import GHC.Types.SrcLoc--import Skeletest.Internal.Error (invariantViolation)--hsLamSingle :: MatchGroup (GhcPass p) (LHsExpr (GhcPass p)) -> HsExpr (GhcPass p)-hsLamSingle = HsLam noExtField--lamAltSingle :: HsMatchContext fn-lamAltSingle = LambdaExpr--xCaseRn :: XCase GhcRn-xCaseRn = noExtField--hsLit :: HsLit (GhcPass p) -> HsExpr (GhcPass p)-hsLit = HsLit noAnn--hsPar :: LHsExpr (GhcPass p) -> HsExpr (GhcPass p)-hsPar e = HsPar noAnn (L NoTokenLoc HsTok) e (L NoTokenLoc HsTok)--unHsPar :: HsExpr GhcRn -> LHsExpr GhcRn-unHsPar = \case- HsPar _ _ e _ -> e- e -> invariantViolation $ "unHsPar called on " <> (show . toConstr) e--hsTupPresent :: LHsExpr (GhcPass p) -> HsTupArg (GhcPass p)-hsTupPresent = Present noAnn--hsApp :: LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> HsExpr (GhcPass p)-hsApp = HsApp noAnn--genLoc :: e -> GenLocated (SrcAnn ann) e-genLoc = L (SrcSpanAnn noAnn generatedSrcSpan)
src/Skeletest/Internal/GHC/Compat_9_8.hs view
@@ -5,7 +5,9 @@ ) where import Data.Data (toConstr)-import GHC+import GHC hiding (FieldOcc (..), mkPrefixFunRhs)+import GHC qualified+import GHC.Types.Name.Reader (getRdrName) import GHC.Types.SrcLoc import Skeletest.Internal.Error (invariantViolation)@@ -16,9 +18,6 @@ lamAltSingle :: HsMatchContext fn lamAltSingle = LambdaExpr -xCaseRn :: XCase GhcRn-xCaseRn = CaseAlt- hsLit :: HsLit (GhcPass p) -> HsExpr (GhcPass p) hsLit = HsLit noAnn @@ -33,8 +32,34 @@ hsTupPresent :: LHsExpr (GhcPass p) -> HsTupArg (GhcPass p) hsTupPresent = Present noAnn +xMatch :: XCMatch (GhcPass p) b+xMatch = noAnn++mkHsRecFields :: [LHsRecField (GhcPass p) arg] -> HsRecFields (GhcPass p) arg+mkHsRecFields fields =+ GHC.HsRecFields+ { rec_flds = fields+ , rec_dotdot = Nothing+ }++foLabel :: GHC.FieldOcc GhcRn -> LIdP GhcRn+foLabel = genLoc . GHC.foExt++fieldOccRn :: Name -> GHC.FieldOcc GhcRn+fieldOccRn name =+ GHC.FieldOcc+ { GHC.foExt = name+ , GHC.foLabel = genLoc $ getRdrName name+ }+ hsApp :: LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> HsExpr (GhcPass p) hsApp = HsApp noAnn genLoc :: e -> GenLocated (SrcAnn ann) e genLoc = L (SrcSpanAnn noAnn generatedSrcSpan)++mkPrefixFunRhs :: LIdP GhcPs -> EpAnn () -> HsMatchContext GhcPs+mkPrefixFunRhs fn _ = GHC.mkPrefixFunRhs fn++toMatchArgs :: [LPat p] -> [LPat p]+toMatchArgs = id
src/Skeletest/Internal/Preprocessor.hs view
@@ -12,9 +12,10 @@ import Data.Text qualified as Text import System.Directory (doesDirectoryExist, listDirectory) import System.FilePath (makeRelative, splitExtensions, takeDirectory, (</>))+import UnliftIO.Exception (throwIO) import Skeletest.Internal.Constants (mainFileSpecsListIdentifier)-import Skeletest.Internal.Error (skeletestPluginError)+import Skeletest.Internal.Error (SkeletestError (..)) -- | Preprocess the given Haskell file. See Main.hs processFile :: FilePath -> Text -> IO Text@@ -51,10 +52,10 @@ updateMainFile :: FilePath -> Text -> IO Text updateMainFile path file = do modules <- findTestModules path- pure- . addSpecsList modules- . insertImports modules- $ file+ either throwIO pure $+ pure file+ >>= insertImports modules+ >>= pure . addSpecsList modules -- | Find all test modules using the given path to the Main module. --@@ -99,12 +100,12 @@ renderSpecInfo (fp, name, spec) = "(" <> fp <> ", " <> name <> ", " <> spec <> ")" -- | Add imports after the Skeletest.Main import, which should always be present in the Main module.-insertImports :: [(FilePath, Text)] -> Text -> Text+insertImports :: [(FilePath, Text)] -> Text -> Either SkeletestError Text insertImports testModules file = let (pre, post) = break isSkeletestImport $ Text.lines file in if null post- then skeletestPluginError "Could not find Skeletest.Main import in Main module"- else Text.unlines $ pre <> importTests <> post+ then Left $ CompilationError "Could not find Skeletest.Main import in Main module"+ else pure . Text.unlines $ pre <> importTests <> post where isSkeletestImport line = case Text.words line of
src/Skeletest/Internal/Utils/Diff.hs view
@@ -2,7 +2,8 @@ showLineDiff, ) where -import Data.Algorithm.DiffContext (getContextDiffNew, prettyContextDiff)+import Data.Algorithm.DiffContext (getContextDiff, prettyContextDiff)+import Data.Algorithm.DiffContext qualified as Diff import Data.Text (Text) import Data.Text qualified as Text import Text.PrettyPrint qualified as PP@@ -10,7 +11,7 @@ showLineDiff :: (Text, Text) -> (Text, Text) -> Text showLineDiff (fromName, fromContent) (toName, toContent) = Text.pack . PP.render $- prettyContextDiff (ppText fromName) (ppText toName) ppText $- getContextDiffNew (Just 5) (Text.lines fromContent) (Text.lines toContent)+ prettyContextDiff (ppText fromName) (ppText toName) (ppText . Diff.unnumber) $+ getContextDiff (Just 5) (Text.lines fromContent) (Text.lines toContent) where ppText = PP.text . Text.unpack
src/bin/skeletest-preprocessor.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-| A preprocessor that registers skeletest in a test suite.@@ -18,14 +19,19 @@ -} module Main where +import Data.List (dropWhileEnd) import Data.Text.IO qualified as Text import GHC.IO.Encoding (setLocaleEncoding, utf8) import System.Environment (getArgs)+import System.Exit (exitFailure)+import System.IO (hPutStrLn, stderr)+import UnliftIO.Exception (displayException, handle) +import Skeletest.Internal.Error (SkeletestError) import Skeletest.Internal.Preprocessor (processFile) main :: IO ()-main = do+main = handleErrors $ do -- just to be extra sure we don't run into encoding issues setLocaleEncoding utf8 @@ -33,3 +39,13 @@ -- https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/phases.html#options-affecting-a-haskell-pre-processor [fp, input, output] -> Text.readFile input >>= processFile fp >>= Text.writeFile output _ -> error "The skeletest preprocessor does not accept any additional arguments."++-- | Output SkeletestError+handleErrors :: IO a -> IO a+handleErrors = handle $ \(e :: SkeletestError) -> do+ hPutStrLn stderr $ normalizeLines $ displayException e+ exitFailure+ where+ normalizeLines+ | __GLASGOW_HASKELL__ == (908 :: Int) = dropWhileEnd (== '\n')+ | otherwise = id
test/Skeletest/Internal/__snapshots__/SnapshotSpec.snap.md view
@@ -33,7 +33,7 @@ Result differed from snapshot. Update snapshot with --update. --- expected +++ actual-@@+@@ -1,4 +1,4 @@ +new1 same1 -old1
test/Skeletest/MainSpec.hs view
@@ -57,27 +57,18 @@ , "spec = it \"should run\" $ pure ()" ] -normalizePluginError, normalizeGhc29916 :: String -> String-#if __GLASGOW_HASKELL__ == 906-normalizePluginError =- Text.unpack- . Text.replace (Text.pack "*** Exception: ExitFailure 1") (Text.pack "\n*** Exception: ExitFailure 1")- . Text.pack-normalizeGhc29916 =- Text.unpack- . Text.replace (Text.pack "error:\n") (Text.pack "error: [GHC-29916]\n")- . Text.replace (Text.pack "<generated>") (Text.pack "<no location info>")- . Text.pack-#elif __GLASGOW_HASKELL__ == 908-normalizePluginError =- Text.unpack- . Text.replace (Text.pack "*** Exception: ExitFailure 1") (Text.pack "\n*** Exception: ExitFailure 1")- . Text.pack-normalizeGhc29916 =- Text.unpack- . Text.replace (Text.pack "<generated>") (Text.pack "<no location info>")- . Text.pack-#else-normalizePluginError = Text.unpack . Text.pack-normalizeGhc29916 = Text.unpack . Text.pack-#endif+normalizePluginError :: String -> String+normalizePluginError = Text.unpack . go . Text.pack+ where+ replace old new = Text.replace (Text.pack old) (Text.pack new)+ go+ | __GLASGOW_HASKELL__ == (908 :: Int) = replace "*** Exception: ExitFailure 1" "\n*** Exception: ExitFailure 1"+ | otherwise = id++normalizeGhc29916 :: String -> String+normalizeGhc29916 = Text.unpack . go . Text.pack+ where+ replace old new = Text.replace (Text.pack old) (Text.pack new)+ go+ | __GLASGOW_HASKELL__ == (908 :: Int) = replace "<generated>" "<no location info>"+ | otherwise = id
test/Skeletest/PredicateSpec.hs view
@@ -395,116 +395,59 @@ c : cs -> c : go cs normalizeConFailure :: String -> String-#if __GLASGOW_HASKELL__ == 906-normalizeConFailure = Text.unpack . Text.replace old new . Text.pack- where- old =- Text.pack . unlines $- [ "ExampleSpec.hs:9:3: error:"- , " • The constructor ‘User’ should have 2 arguments, but has been given 1"- , " • In a stmt of a 'do' block:"- , " User \"alice\" (Just 1)"- , " `shouldSatisfy`"- , " Skeletest.Internal.Predicate.conMatches"- , " \"User\" Nothing"- , " \\ actual"- , " -> case pure actual of"- , " Just (User x0)"- , " -> Just"- , " (Skeletest.Internal.Utils.HList.HCons"- , " (pure x0) Skeletest.Internal.Utils.HList.HNil)"- , " _ -> Nothing"- , " (Skeletest.Internal.Utils.HList.HCons"- , " (P.eq \"\") Skeletest.Internal.Utils.HList.HNil)"- , " In the second argument of ‘($)’, namely"- , " ‘do User \"alice\" (Just 1)"- , " `shouldSatisfy`"- , " Skeletest.Internal.Predicate.conMatches"- , " \"User\" Nothing"- , " \\ actual"- , " -> case pure actual of"- , " Just (User x0) -> ..."- , " _ -> ..."- , " (Skeletest.Internal.Utils.HList.HCons"- , " (P.eq \"\") Skeletest.Internal.Utils.HList.HNil)’"- , " In the expression:"- , " it \"should error\""- , " $ do User \"alice\" (Just 1)"- , " `shouldSatisfy`"- , " Skeletest.Internal.Predicate.conMatches"- , " \"User\" Nothing"- , " \\ actual"- , " -> case pure actual of"- , " Just (User x0) -> ..."- , " _ -> ..."- , " (Skeletest.Internal.Utils.HList.HCons"- , " (P.eq \"\") Skeletest.Internal.Utils.HList.HNil)"- ]- new =- Text.pack . unlines $- [ "ExampleSpec.hs:9:3: error: [GHC-27346]"- , " • The data constructor ‘User’ should have 2 arguments, but has been given 1"- , " • In the pattern: User x0"- , " In the pattern: Just (User x0)"- , " In a case alternative:"- , " Just (User x0)"- , " -> Just"- , " (Skeletest.Internal.Utils.HList.HCons"- , " (pure x0) Skeletest.Internal.Utils.HList.HNil)"- ]-#elif __GLASGOW_HASKELL__ == 908-normalizeConFailure = Text.unpack . Text.replace old new . Text.pack+normalizeConFailure = Text.unpack . go . Text.pack where- old =- Text.pack . unlines $- [ " • In a stmt of a 'do' block:"- , " User \"alice\" (Just 1)"- , " `shouldSatisfy`"- , " Skeletest.Internal.Predicate.conMatches"- , " \"User\" Nothing"- , " \\ actual"- , " -> case pure actual of"- , " Just (User x0)"- , " -> Just"- , " (Skeletest.Internal.Utils.HList.HCons"- , " (pure x0) Skeletest.Internal.Utils.HList.HNil)"- , " _ -> Nothing"- , " (Skeletest.Internal.Utils.HList.HCons"- , " (P.eq \"\") Skeletest.Internal.Utils.HList.HNil)"- , " In the second argument of ‘($)’, namely"- , " ‘do User \"alice\" (Just 1)"- , " `shouldSatisfy`"- , " Skeletest.Internal.Predicate.conMatches"- , " \"User\" Nothing"- , " \\ actual"- , " -> case pure actual of"- , " Just (User x0) -> ..."- , " _ -> ..."- , " (Skeletest.Internal.Utils.HList.HCons"- , " (P.eq \"\") Skeletest.Internal.Utils.HList.HNil)’"- , " In the expression:"- , " it \"should error\""- , " $ do User \"alice\" (Just 1)"- , " `shouldSatisfy`"- , " Skeletest.Internal.Predicate.conMatches"- , " \"User\" Nothing"- , " \\ actual"- , " -> case pure actual of"- , " Just (User x0) -> ..."- , " _ -> ..."- , " (Skeletest.Internal.Utils.HList.HCons"- , " (P.eq \"\") Skeletest.Internal.Utils.HList.HNil)"- ]- new =- Text.pack . unlines $- [ " • In the pattern: User x0"- , " In the pattern: Just (User x0)"- , " In a case alternative:"- , " Just (User x0)"- , " -> Just"- , " (Skeletest.Internal.Utils.HList.HCons"- , " (pure x0) Skeletest.Internal.Utils.HList.HNil)"- ]-#else-normalizeConFailure = Text.unpack . Text.pack-#endif+ go+ | __GLASGOW_HASKELL__ == (908 :: Int) =+ let old =+ Text.pack . unlines $+ [ " • In a stmt of a 'do' block:"+ , " User \"alice\" (Just 1)"+ , " `shouldSatisfy`"+ , " Skeletest.Internal.Predicate.conMatches"+ , " \"User\" Nothing"+ , " \\ actual"+ , " -> case pure actual of"+ , " Just (User x0)"+ , " -> Just"+ , " (Skeletest.Internal.Utils.HList.HCons"+ , " (pure x0) Skeletest.Internal.Utils.HList.HNil)"+ , " _ -> Nothing"+ , " (Skeletest.Internal.Utils.HList.HCons"+ , " (P.eq \"\") Skeletest.Internal.Utils.HList.HNil)"+ , " In the second argument of ‘($)’, namely"+ , " ‘do User \"alice\" (Just 1)"+ , " `shouldSatisfy`"+ , " Skeletest.Internal.Predicate.conMatches"+ , " \"User\" Nothing"+ , " \\ actual"+ , " -> case pure actual of"+ , " Just (User x0) -> ..."+ , " _ -> ..."+ , " (Skeletest.Internal.Utils.HList.HCons"+ , " (P.eq \"\") Skeletest.Internal.Utils.HList.HNil)’"+ , " In the expression:"+ , " it \"should error\""+ , " $ do User \"alice\" (Just 1)"+ , " `shouldSatisfy`"+ , " Skeletest.Internal.Predicate.conMatches"+ , " \"User\" Nothing"+ , " \\ actual"+ , " -> case pure actual of"+ , " Just (User x0) -> ..."+ , " _ -> ..."+ , " (Skeletest.Internal.Utils.HList.HCons"+ , " (P.eq \"\") Skeletest.Internal.Utils.HList.HNil)"+ ]+ new =+ Text.pack . unlines $+ [ " • In the pattern: User x0"+ , " In the pattern: Just (User x0)"+ , " In a case alternative:"+ , " Just (User x0)"+ , " -> Just"+ , " (Skeletest.Internal.Utils.HList.HCons"+ , " (pure x0) Skeletest.Internal.Utils.HList.HNil)"+ ]+ in Text.replace old new+ | otherwise = id
test/Skeletest/__snapshots__/MainSpec.snap.md view
@@ -3,7 +3,6 @@ ## errors if Skeletest.Main not imported ```-skeletest-preprocessor: ******************** skeletest failure ******************** Could not find Skeletest.Main import in Main module