skeletest 0.4.2 → 0.4.3

raw patch · 17 files changed

+136/−12 lines, 17 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• README.md +14/−0
• skeletest.cabal +1/−1
• src/Skeletest/Assertions.hs +1/−1
• src/Skeletest/Internal/CLI.hs +1/−1
• src/Skeletest/Internal/Fixtures.hs +1/−1
• src/Skeletest/Internal/Hooks.hs +6/−3
• src/Skeletest/Internal/Paths.hs +1/−1
• src/Skeletest/Internal/Predicate.hs +35/−0
• src/Skeletest/Internal/PreprocessorPlugin.hs +38/−0
• src/Skeletest/Internal/Snapshot.hs +1/−1
• src/Skeletest/Internal/Snapshot/Renderer.hs +1/−1
• src/Skeletest/Internal/TestInfo.hs +1/−1
• src/Skeletest/Internal/Utils/Term.hs +1/−1
• src/Skeletest/Predicate.hs +1/−0
• test/Skeletest/PredicateSpec.hs +9/−0
• test/Skeletest/__snapshots__/PredicateSpec.snap.md +16/−0

@@ -1,3 +1,11 @@+## v0.4.3++Bug fixes:+* Fixed potential issue with user hooks not running++API changes:+* Add `P.check`+ ## v0.4.2  Bug fixes:

@@ -90,6 +90,8 @@      Options may be specified as `-optF=<name>:<value>`. See [Options](#options). +    * `-threaded` may be needed here. See [Animations aren't running on long tests](#animations-arent-running-on-long-tests)+ 1. Add `Main.hs`:      ```haskell@@ -499,3 +501,15 @@   [ myPlugin   ] ```++## Troubleshooting++### Animations aren't running on long tests++Normally if a test is taking a long time, Skeletest displays an animated spinner in the output. But in certain scenarios, the spinner might require `-threaded`:++* Test spawns and waits on a subprocess (e.g. `callProcess`, `readProcess`)+* Test calls C FFI code+* Test runs CPU-bound Haskell loops that don't allocate++If your test suite does any of these, add `-threaded` to `ghc-options`. In some cases (e.g. when the C FFI code is `unsafe`), you'll additionally need `-with-rtsopts=-N`.

@@ -1,7 +1,7 @@ cabal-version: 3.0  name: skeletest-version: 0.4.2+version: 0.4.3 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

@@ -97,4 +97,4 @@  failContextRef :: IORef FailContext failContextRef = unsafePerformIO $ newIORef []-{-# NOINLINE failContextRef #-}+{-# OPAQUE failContextRef #-}

@@ -472,7 +472,7 @@  cliFlagStoreRef :: IORef CLIFlagStore cliFlagStoreRef = unsafePerformIO $ newIORef Map.empty-{-# NOINLINE cliFlagStoreRef #-}+{-# OPAQUE cliFlagStoreRef #-}  setCliFlagStore :: CLIFlagStore -> IO () setCliFlagStore = writeIORef cliFlagStoreRef

@@ -192,7 +192,7 @@       , fileFixtures = Map.empty       , testFixtures = Map.empty       }-{-# NOINLINE fixtureRegistryRef #-}+{-# OPAQUE fixtureRegistryRef #-}  modifyFixtureRegistry :: (FixtureRegistry -> (FixtureRegistry, a)) -> IO a modifyFixtureRegistry = atomicModifyIORef fixtureRegistryRef

@@ -100,20 +100,23 @@  userHooksRef :: IORef Hooks userHooksRef = unsafePerformIO $ newIORef defaultHooks+{-# OPAQUE userHooksRef #-}  setUserHooks :: Hooks -> IO () setUserHooks = writeIORef userHooksRef  userHooks :: UserHooks-userHooks = unsafePerformIO $ UserHooks <$> readIORef userHooksRef+userHooks = UserHooks $ readIORef userHooksRef -newtype UserHooks = UserHooks Hooks+newtype UserHooks = UserHooks (IO Hooks)  instance   (HasField field Hooks (Hook ctx inp out)) =>   HasField field UserHooks (ctx -> inp -> (inp -> IO out) -> IO out)   where-  getField (UserHooks hooks) = runHook (getField @field hooks)+  getField (UserHooks getHooks) ctx inp f = do+    hooks <- getHooks+    runHook (getField @field hooks) ctx inp f  {----- modifySpecRegistry -----} 

@@ -18,7 +18,7 @@  originalDirectoryRef :: IORef FilePath originalDirectoryRef = unsafePerformIO $ newIORef (invariantViolation "Original directory not set")-{-# NOINLINE originalDirectoryRef #-}+{-# OPAQUE originalDirectoryRef #-}  data TestRoot = TestRootBuildDir | TestRootCWD | TestRoot FilePath 

@@ -20,6 +20,8 @@   anything,   anythingDeep,   anyThunk,+  check,+  checkImpl,    -- * Ord   eq,@@ -249,6 +251,39 @@     , predicateDisp = "any thunk"     , predicateDispNeg = "not any thunk"     }++-- | A predicate that matches any value matching the given function.+--+-- Equivalent to @f P.>>> P.eq True@, but with nicer error messages.+--+-- @since 0.4.3+check :: forall a m. (Monad m) => (a -> Bool) -> Predicate m a+check =+  -- Will be replaced with checkImpl by plugin+  invariantViolation "P.check was not replaced"++-- | Implementation of 'check'.+-- Should not be used directly, generated by the plugin.+checkImpl :: forall a m. (Monad m) => String -> (a -> Bool) -> Predicate m a+checkImpl funcDisplay func =+  Predicate+    { predicateFunc = \actual -> do+        let success = func actual+        pure+          PredicateFuncResult+            { predicateSuccess = success+            , predicateExplain =+                if success+                  then render actual <> " " <> disp+                  else render actual <> " " <> dispNeg+            , predicateShowFailCtx = noCtx+            }+    , predicateDisp = disp+    , predicateDispNeg = dispNeg+    }+ where+  disp = "matches " <> Text.pack funcDisplay+  dispNeg = "does not match " <> Text.pack funcDisplay  {----- Ord -----} 

@@ -103,6 +103,7 @@ transformTestModule ctx =   foldl' (.) id $     [ replaceConMatch ctx+    , replaceCheck ctx     , replaceIsoChecker ctx     ] @@ -221,6 +222,43 @@   mkNamesList = mkHList $ \name -> hsExprApps (hsExprCon $ hsName 'Const) [hsExprLitString $ getHsName name]   mkValsList = mkHList $ \val -> hsExprApps (hsExprVar $ hsName 'pure) [hsExprVar val]   mkPredList = mkHList id++-- | Replace all uses of P.check with P.checkImpl. See P.check.+--+-- P.check (isValid . normalize)+-- ====>+-- P.checkImpl "(isValid . normalize)" (isValid . normalize)+replaceCheck :: Ctx -> HsExpr GhcRn -> HsExpr GhcRn+replaceCheck ctx e =+  case getExpr e of+    -- Matches:+    --   P.check isValid+    --   P.check (isValid . normalize)+    HsExprApps (getExpr -> HsExprVar name) [arg]+      | isCheck name ->+          convertCheck arg+    -- Matches:+    --   P.check $ isValid . normalize+    HsExprOp (getExpr -> HsExprVar name) (getExpr -> HsExprVar dollar) arg+      | ctx.matchesName (hsName '($)) dollar+      , isCheck name ->+          convertCheck arg+    -- Check if P.check is by itself+    HsExprVar name+      | isCheck name ->+          skeletestPluginError (getLoc e) "P.check must be applied to a constructor"+    -- Check if P.check is being applied to more than one argument+    HsExprApps (getExpr -> HsExprVar name) (_ : _ : _)+      | isCheck name ->+          skeletestPluginError (getLoc e) "P.check must be applied to exactly one argument"+    _ -> e+ where+  isCheck = ctx.matchesName (hsName 'P.check)+  convertCheck arg =+    hsExprApps (hsExprVar $ hsName 'P.checkImpl) $+      [ hsExprLitString $ renderHsExpr arg+      , arg+      ]  -- | Replace all uses of P.=== with inlined IsoChecker value, with -- function name filled in.

@@ -237,7 +237,7 @@       , numSnapshotsUpdated = 0       , numSnapshotFilesCleanedUp = 0       }-{-# NOINLINE snapshotInfoStoreRef #-}+{-# OPAQUE snapshotInfoStoreRef #-}  getTestIds :: Spec -> [SnapshotTestId] getTestIds = concatMap (go Seq.empty) . getSpecTrees

@@ -57,7 +57,7 @@  snapshotRenderersRef :: IORef [SnapshotRenderer] snapshotRenderersRef = unsafePerformIO $ newIORef []-{-# NOINLINE snapshotRenderersRef #-}+{-# OPAQUE snapshotRenderersRef #-}  setSnapshotRenderers :: [SnapshotRenderer] -> IO () setSnapshotRenderers = writeIORef snapshotRenderersRef

@@ -40,7 +40,7 @@  testInfoMapRef :: IORef TestInfoMap testInfoMapRef = unsafePerformIO $ newIORef Map.empty-{-# NOINLINE testInfoMapRef #-}+{-# OPAQUE testInfoMapRef #-}  withTestInfo :: (MonadUnliftIO m) => TestInfo -> m a -> m a withTestInfo info m = do

@@ -68,7 +68,7 @@     supportsANSI <- ANSI.hSupportsANSI handle     let lastInPlaceOutput = Nothing     Handle <$> newMVar Handle'{..}-{-# NOINLINE globalTermData #-}+{-# OPAQUE globalTermData #-}  init :: IO () init = do

@@ -5,6 +5,7 @@   anything,   anythingDeep,   anyThunk,+  check,    -- * Ord   eq,

@@ -58,6 +58,15 @@       it "ignores nested bottom" $ do         Just bottom `shouldSatisfy` P.anyThunk +    describe "check" $ do+      it "checks using callback" $ do+        1 `shouldSatisfy` P.check odd+        1 `shouldNotSatisfy` P.check even++      it "shows helpful failure messages" $ do+        snapshotFailure (P.check (odd . (+ 1))) 1+        snapshotFailure (P.not $ P.check (odd . (+ 1))) 2+   describe "Ord" $ do     describe "eq" $ do       it "checks equality" $ do

@@ -1,5 +1,21 @@ # test/Skeletest/PredicateSpec.hs +## General ≫ check ≫ shows helpful failure messages++```+1 does not match (odd . (+ 1))+```++```+2 matches (odd . (+ 1))++Expected:+  does not match (odd . (+ 1))++Got:+  2+```+ ## Ord ≫ eq ≫ shows helpful failure messages  ```