packages feed

sydtest 0.7.0.1 → 0.8.0.0

raw patch · 14 files changed

+174/−106 lines, 14 files

Files

CHANGELOG.md view
@@ -1,5 +1,21 @@ # Changelog +## [0.8.0.0] - 2022-02-11++### Changed++* The `TestDefM` now contains a `TestDefEnv` which also contains the test description path, along with `TestRunSettings`.+* Removed the `MonadState ()` instance of `TestDefM`. It was just silly.+* Changed the internals of `TestDefM` to use `ReaderT` and a strict `WriterT` instead of `RWST`.+* Renamed `wrapRWST` to `wrapForest`.+* Fixed the property label output to use the right total.+* Moved `filterTestForest` and `randomiseTestForest` from `Test.Syd.TestDefM` to `Test.Syd.SpecDef`, where `SpecDefForest` is defined.++### Added++* `getTestDescriptionPath` to get the test description path upwards from inside a test definition.++ ## [0.7.0.1] - 2021-12-23  ### Changed
LICENSE.md view
@@ -1,6 +1,6 @@ Sydtest License -Copyright (c) 2020-2021 Tom Sydney Kerckhove+Copyright (c) 2020-2022 Tom Sydney Kerckhove  **Anyone** can use this software to test your software under the following license:
src/Test/Syd.hs view
@@ -50,6 +50,7 @@     specifyWithBoth,     specifyWithAll,     prop,+    getTestDescriptionPath,      -- ** Commented-out tests     xdescribe,
src/Test/Syd/Def/Around.hs view
@@ -11,7 +11,8 @@ module Test.Syd.Def.Around where  import Control.Exception-import Control.Monad.RWS.Strict+import Control.Monad.Reader+import Control.Monad.Writer.Strict import Data.Kind import Test.QuickCheck.IO () import Test.Syd.Def.TestDefM@@ -175,10 +176,10 @@   TestDefM outers newInner result ->   TestDefM outers oldInner result aroundWith' func (TestDefM rwst) =-  local (\trs -> trs {testRunSettingMaxShrinks = 0}) $+  local (\tde -> tde {testDefEnvTestRunSettings = (testDefEnvTestRunSettings tde) {testRunSettingMaxShrinks = 0}}) $     TestDefM $-      flip mapRWST rwst $ \inner -> do-        (res, s, forest) <- inner+      flip mapWriterT rwst $ \inner -> do+        (res, forest) <- inner         -- a: outers         -- c: newInner         -- d: oldInner@@ -221,4 +222,4 @@             modifyForest = map modifyTree         let forest' :: SpecDefForest outers oldInner ()             forest' = modifyForest forest-        pure (res, s, forest')+        pure (res, forest')
src/Test/Syd/Def/AroundAll.hs view
@@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE IncoherentInstances #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}@@ -11,7 +10,7 @@ -- | This module defines all the functions you will use to define your test suite. module Test.Syd.Def.AroundAll where -import Control.Monad.RWS.Strict+import Control.Monad.Writer.Strict import Test.QuickCheck.IO () import Test.Syd.Def.TestDefM import Test.Syd.HList@@ -23,7 +22,7 @@   IO outer ->   TestDefM (outer ': otherOuters) inner result ->   TestDefM otherOuters inner result-beforeAll action = wrapRWST $ \forest -> DefBeforeAllNode action forest+beforeAll action = wrapForest $ \forest -> DefBeforeAllNode action forest  -- | Run a custom action before all spec items in a group without setting up any outer resources. beforeAll_ ::@@ -57,7 +56,7 @@   (HList outers -> IO ()) ->   TestDefM outers inner result ->   TestDefM outers inner result-afterAll' func = wrapRWST $ \forest -> DefAfterAllNode func forest+afterAll' func = wrapForest $ \forest -> DefAfterAllNode func forest  -- | Run a custom action after all spec items without using any outer resources. afterAll_ ::@@ -75,7 +74,7 @@   ((outer -> IO ()) -> IO ()) ->   TestDefM (outer ': otherOuters) inner result ->   TestDefM otherOuters inner result-aroundAll func = wrapRWST $ \forest -> DefAroundAllNode func forest+aroundAll func = wrapForest $ \forest -> DefAroundAllNode func forest  -- | Run a custom action before and/or after all spec items in a group without accessing any resources. --@@ -115,7 +114,7 @@   (IO () -> IO ()) ->   TestDefM outers inner result ->   TestDefM outers inner result-aroundAll_ func = wrapRWST $ \forest -> DefWrapNode func forest+aroundAll_ func = wrapForest $ \forest -> DefWrapNode func forest  -- | Run a custom action before and/or after all spec items in a group to provide access to a resource 'a' while using a resource 'b' --@@ -126,16 +125,16 @@   ((newOuter -> IO ()) -> (oldOuter -> IO ())) ->   TestDefM (newOuter ': oldOuter ': otherOuters) inner result ->   TestDefM (oldOuter ': otherOuters) inner result-aroundAllWith func = wrapRWST $ \forest -> DefAroundAllWithNode func forest+aroundAllWith func = wrapForest $ \forest -> DefAroundAllWithNode func forest  -- | Declare a node in the spec def forest-wrapRWST ::+wrapForest ::   -- | The wrapper node   (TestForest outers1 inner1 -> TestTree outers2 inner2) ->   TestDefM outers1 inner1 result ->   TestDefM outers2 inner2 result-wrapRWST func (TestDefM rwst) = TestDefM $-  flip mapRWST rwst $ \inner -> do-    (res, s, forest) <- inner+wrapForest func (TestDefM rwst) = TestDefM $+  flip mapWriterT rwst $ \inner -> do+    (res, forest) <- inner     let forest' = [func forest]-    pure (res, s, forest')+    pure (res, forest')
src/Test/Syd/Def/Specify.hs view
@@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE IncoherentInstances #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}@@ -66,7 +65,10 @@   String ->   TestDefM outers inner () ->   TestDefM outers inner ()-describe s func = censor ((: []) . DefDescribeNode (T.pack s)) func+describe s =+  let t = T.pack s+   in local (\tde -> tde {testDefEnvDescriptionPath = t : testDefEnvDescriptionPath tde})+        . censor ((: []) . DefDescribeNode t)  -- TODO maybe we want to keep all tests below but replace them with a "Pending" instead. xdescribe :: String -> TestDefM outers inner () -> TestDefM outers inner ()@@ -170,7 +172,7 @@   test ->   TestDefM outers inner () it s t = do-  sets <- ask+  sets <- asks testDefEnvTestRunSettings   let testDef =         TDef           { testDefVal = \supplyArgs ->@@ -271,7 +273,7 @@   test ->   TestDefM (outer ': otherOuters) inner () itWithOuter s t = do-  sets <- ask+  sets <- asks testDefEnvTestRunSettings   let testDef =         TDef           { testDefVal = \supplyArgs ->@@ -369,7 +371,7 @@   test ->   TestDefM (outer ': otherOuters) inner () itWithBoth s t = do-  sets <- ask+  sets <- asks testDefEnvTestRunSettings   let testDef =         TDef           { testDefVal = \supplyArgs ->@@ -437,7 +439,7 @@   test ->   TestDefM outers inner () itWithAll s t = do-  sets <- ask+  sets <- asks testDefEnvTestRunSettings   let testDef =         TDef           { testDefVal = \supplyArgs ->
src/Test/Syd/Def/TestDefM.hs view
@@ -1,28 +1,23 @@ {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE IncoherentInstances #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}  module Test.Syd.Def.TestDefM where -import Control.Monad-import Control.Monad.RWS.Strict import Control.Monad.Random-import Data.DList (DList)-import qualified Data.DList as DList+import Control.Monad.Reader+import Control.Monad.Writer.Strict import Data.Kind-import Data.Maybe import Data.Text (Text)-import qualified Data.Text as T-import System.Random.Shuffle+import GHC.Generics (Generic) import Test.QuickCheck.IO () import Test.Syd.OptParse import Test.Syd.Run@@ -50,17 +45,35 @@ -- -- In practice, all of these three parameters should be '()' at the top level. newtype TestDefM (outers :: [Type]) inner result = TestDefM-  { unTestDefM :: RWST TestRunSettings (TestForest outers inner) () IO result+  { unTestDefM :: WriterT (TestForest outers inner) (ReaderT TestDefEnv IO) result   }-  deriving (Functor, Applicative, Monad, MonadIO, MonadReader TestRunSettings, MonadWriter (TestForest outers inner), MonadState ())+  deriving+    ( Functor,+      Applicative,+      Monad,+      MonadIO,+      MonadReader TestDefEnv,+      MonadWriter (TestForest outers inner)+    ) +data TestDefEnv = TestDefEnv+  { testDefEnvDescriptionPath :: ![Text],+    testDefEnvTestRunSettings :: !TestRunSettings+  }+  deriving (Show, Eq, Generic)+ execTestDefM :: Settings -> TestDefM outers inner result -> IO (TestForest outers inner) execTestDefM sets = fmap snd . runTestDefM sets  runTestDefM :: Settings -> TestDefM outers inner result -> IO (result, TestForest outers inner) runTestDefM sets defFunc = do   let func = unTestDefM defFunc-  (a, _, testForest) <- runRWST func (toTestRunSettings sets) ()+  let testDefEnv =+        TestDefEnv+          { testDefEnvDescriptionPath = [],+            testDefEnvTestRunSettings = toTestRunSettings sets+          }+  (a, testForest) <- runReaderT (runWriterT func) testDefEnv   let testForest' = filterTestForest (settingFilter sets) testForest   stdgen <- case settingSeed sets of     FixedSeed seed -> pure $ mkStdGen seed@@ -71,6 +84,21 @@           else testForest'   pure (a, testForest'') +-- | Get the path of 'describe' strings upwards.+--+-- Note that using this function makes tests less movable, depending on what+-- you do with these strings.+-- For example, if you use these strings to define the path to a golden test+-- file, then that path will change if you move the tests somewhere else.+-- This combines unfortunately with the way @sydtest-discover@ makes the module+-- name part of this path.+-- Indeed: moving your tests to another module will change their path as well,+-- if you use @sydtest-discover@.+-- Also note that while test forests can be randomised, their description path+-- upwards will not, because of how trees are structured.+getTestDescriptionPath :: TestDefM outers inner [Text]+getTestDescriptionPath = asks testDefEnvDescriptionPath+ toTestRunSettings :: Settings -> TestRunSettings toTestRunSettings Settings {..} =   TestRunSettings@@ -82,59 +110,3 @@       testRunSettingGoldenStart = settingGoldenStart,       testRunSettingGoldenReset = settingGoldenReset     }--filterTestForest :: Maybe Text -> SpecDefForest outers inner result -> SpecDefForest outers inner result-filterTestForest mf = fromMaybe [] . goForest DList.empty-  where-    goForest :: DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)-    goForest ts sdf = do-      let sdf' = mapMaybe (goTree ts) sdf-      guard $ not $ null sdf'-      pure sdf'--    filterGuard :: DList Text -> Bool-    filterGuard dl = case mf of-      Just f -> f `T.isInfixOf` T.intercalate "." (DList.toList dl)-      Nothing -> True--    goTree :: DList Text -> SpecDefTree a b c -> Maybe (SpecDefTree a b c)-    goTree dl = \case-      DefSpecifyNode t td e -> do-        let tl = DList.snoc dl t-        guard $ filterGuard tl-        pure $ DefSpecifyNode t td e-      DefPendingNode t mr -> do-        let tl = DList.snoc dl t-        guard $ filterGuard tl-        pure $ DefPendingNode t mr-      DefDescribeNode t sdf -> DefDescribeNode t <$> goForest (DList.snoc dl t) sdf-      DefWrapNode func sdf -> DefWrapNode func <$> goForest dl sdf-      DefBeforeAllNode func sdf -> DefBeforeAllNode func <$> goForest dl sdf-      DefAroundAllNode func sdf -> DefAroundAllNode func <$> goForest dl sdf-      DefAroundAllWithNode func sdf -> DefAroundAllWithNode func <$> goForest dl sdf-      DefAfterAllNode func sdf -> DefAfterAllNode func <$> goForest dl sdf-      DefParallelismNode func sdf -> DefParallelismNode func <$> goForest dl sdf-      DefRandomisationNode func sdf -> DefRandomisationNode func <$> goForest dl sdf-      DefFlakinessNode func sdf -> DefFlakinessNode func <$> goForest dl sdf--randomiseTestForest :: MonadRandom m => SpecDefForest outers inner result -> m (SpecDefForest outers inner result)-randomiseTestForest = goForest-  where-    goForest :: MonadRandom m => SpecDefForest a b c -> m (SpecDefForest a b c)-    goForest = traverse goTree >=> shuffleM-    goTree :: MonadRandom m => SpecDefTree a b c -> m (SpecDefTree a b c)-    goTree = \case-      DefSpecifyNode t td e -> pure $ DefSpecifyNode t td e-      DefPendingNode t mr -> pure $ DefPendingNode t mr-      DefDescribeNode t sdf -> DefDescribeNode t <$> goForest sdf-      DefWrapNode func sdf -> DefWrapNode func <$> goForest sdf-      DefBeforeAllNode func sdf -> DefBeforeAllNode func <$> goForest sdf-      DefAroundAllNode func sdf -> DefAroundAllNode func <$> goForest sdf-      DefAroundAllWithNode func sdf -> DefAroundAllWithNode func <$> goForest sdf-      DefAfterAllNode func sdf -> DefAfterAllNode func <$> goForest sdf-      DefParallelismNode func sdf -> DefParallelismNode func <$> goForest sdf-      DefFlakinessNode i sdf -> DefFlakinessNode i <$> goForest sdf-      DefRandomisationNode eor sdf ->-        DefRandomisationNode eor <$> case eor of-          RandomiseExecutionOrder -> goForest sdf-          DoNotRandomiseExecutionOrder -> pure sdf
src/Test/Syd/Modify.hs view
@@ -39,7 +39,7 @@ import Test.Syd.SpecDef  modifyRunSettings :: (TestRunSettings -> TestRunSettings) -> TestDefM a b c -> TestDefM a b c-modifyRunSettings = local+modifyRunSettings func = local (\tde -> tde {testDefEnvTestRunSettings = func $ testDefEnvTestRunSettings tde})  modifyMaxSuccess :: (Int -> Int) -> TestDefM a b c -> TestDefM a b c modifyMaxSuccess func = modifyRunSettings $ \trs -> trs {testRunSettingMaxSuccess = func (testRunSettingMaxSuccess trs)}
src/Test/Syd/Output.hs view
@@ -194,7 +194,7 @@               | testRunResultStatus == TestPassed,                 w <- maybeToList testRunResultNumTests             ],-            map pad $ labelsChunks testRunResultLabels,+            map pad $ labelsChunks (fromMaybe 1 testRunResultNumTests) testRunResultLabels,             map pad $ classesChunks testRunResultClasses,             map pad $ tablesChunks testRunResultTables,             [pad $ outputGoldenCase gc | gc <- maybeToList testRunResultGoldenCase]@@ -211,18 +211,21 @@         ]     TestFailed -> [["Retries: ", chunk (T.pack (show retries)), " (likely not flaky)"]] -labelsChunks :: Maybe (Map [String] Int) -> [[Chunk]]-labelsChunks Nothing = []-labelsChunks (Just labels)-  | M.size labels <= 1 = []+labelsChunks :: Word -> Maybe (Map [String] Int) -> [[Chunk]]+labelsChunks _ Nothing = []+labelsChunks totalCount (Just labels)+  | M.size labels < 1 = []   | otherwise =-    [chunk "labels"] :+    [chunk "Labels"] :     map       ( pad           . ( \(ss, i) ->                 [ chunk                     ( T.pack-                        ( printf "%5.2f%% %s" (100 * fromIntegral i / fromIntegral total :: Double) (commaList (map show ss))+                        ( printf+                            "%5.2f%% %s"+                            (100 * fromIntegral i / fromIntegral totalCount :: Double)+                            (commaList (map show ss))                         )                     )                 ]@@ -231,14 +234,13 @@       (M.toList labels)   where     pad = (chunk (T.pack (replicate paddingSize ' ')) :)-    total = sum $ map snd $ M.toList labels  classesChunks :: Maybe (Map String Int) -> [[Chunk]] classesChunks Nothing = [] classesChunks (Just classes)   | M.null classes = []   | otherwise =-    [chunk "classes"] :+    [chunk "Classes"] :     map       ( pad           . ( \(s, i) ->
src/Test/Syd/Run.hs view
@@ -367,7 +367,7 @@     testRunSettingGoldenStart :: !Bool,     testRunSettingGoldenReset :: !Bool   }-  deriving (Show, Generic)+  deriving (Show, Eq, Generic)  defaultTestRunSettings :: TestRunSettings defaultTestRunSettings =
src/Test/Syd/Runner/Wrappers.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}
src/Test/Syd/SpecDef.hs view
@@ -16,12 +16,17 @@ -- | This module defines all the functions you will use to define your test suite. module Test.Syd.SpecDef where +import Control.Monad+import Control.Monad.Random+import Data.DList (DList)+import qualified Data.DList as DList import Data.Kind import Data.Maybe import Data.Text (Text) import qualified Data.Text as T import Data.Word import GHC.Stack+import System.Random.Shuffle import Test.QuickCheck.IO () import Test.Syd.HList import Test.Syd.OptParse@@ -166,6 +171,62 @@           DefParallelismNode p sdf -> DefParallelismNode p <$> goF sdf           DefRandomisationNode p sdf -> DefRandomisationNode p <$> goF sdf           DefFlakinessNode p sdf -> DefFlakinessNode p <$> goF sdf++filterTestForest :: Maybe Text -> SpecDefForest outers inner result -> SpecDefForest outers inner result+filterTestForest mf = fromMaybe [] . goForest DList.empty+  where+    goForest :: DList Text -> SpecDefForest a b c -> Maybe (SpecDefForest a b c)+    goForest ts sdf = do+      let sdf' = mapMaybe (goTree ts) sdf+      guard $ not $ null sdf'+      pure sdf'++    filterGuard :: DList Text -> Bool+    filterGuard dl = case mf of+      Just f -> f `T.isInfixOf` T.intercalate "." (DList.toList dl)+      Nothing -> True++    goTree :: DList Text -> SpecDefTree a b c -> Maybe (SpecDefTree a b c)+    goTree dl = \case+      DefSpecifyNode t td e -> do+        let tl = DList.snoc dl t+        guard $ filterGuard tl+        pure $ DefSpecifyNode t td e+      DefPendingNode t mr -> do+        let tl = DList.snoc dl t+        guard $ filterGuard tl+        pure $ DefPendingNode t mr+      DefDescribeNode t sdf -> DefDescribeNode t <$> goForest (DList.snoc dl t) sdf+      DefWrapNode func sdf -> DefWrapNode func <$> goForest dl sdf+      DefBeforeAllNode func sdf -> DefBeforeAllNode func <$> goForest dl sdf+      DefAroundAllNode func sdf -> DefAroundAllNode func <$> goForest dl sdf+      DefAroundAllWithNode func sdf -> DefAroundAllWithNode func <$> goForest dl sdf+      DefAfterAllNode func sdf -> DefAfterAllNode func <$> goForest dl sdf+      DefParallelismNode func sdf -> DefParallelismNode func <$> goForest dl sdf+      DefRandomisationNode func sdf -> DefRandomisationNode func <$> goForest dl sdf+      DefFlakinessNode func sdf -> DefFlakinessNode func <$> goForest dl sdf++randomiseTestForest :: MonadRandom m => SpecDefForest outers inner result -> m (SpecDefForest outers inner result)+randomiseTestForest = goForest+  where+    goForest :: MonadRandom m => SpecDefForest a b c -> m (SpecDefForest a b c)+    goForest = traverse goTree >=> shuffleM+    goTree :: MonadRandom m => SpecDefTree a b c -> m (SpecDefTree a b c)+    goTree = \case+      DefSpecifyNode t td e -> pure $ DefSpecifyNode t td e+      DefPendingNode t mr -> pure $ DefPendingNode t mr+      DefDescribeNode t sdf -> DefDescribeNode t <$> goForest sdf+      DefWrapNode func sdf -> DefWrapNode func <$> goForest sdf+      DefBeforeAllNode func sdf -> DefBeforeAllNode func <$> goForest sdf+      DefAroundAllNode func sdf -> DefAroundAllNode func <$> goForest sdf+      DefAroundAllWithNode func sdf -> DefAroundAllWithNode func <$> goForest sdf+      DefAfterAllNode func sdf -> DefAfterAllNode func <$> goForest sdf+      DefParallelismNode func sdf -> DefParallelismNode func <$> goForest sdf+      DefFlakinessNode i sdf -> DefFlakinessNode i <$> goForest sdf+      DefRandomisationNode eor sdf ->+        DefRandomisationNode eor <$> case eor of+          RandomiseExecutionOrder -> goForest sdf+          DoNotRandomiseExecutionOrder -> pure sdf  data Parallelism = Parallel | Sequential
sydtest.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.5.+-- This file has been generated from package.yaml by hpack version 0.34.6. -- -- see: https://github.com/sol/hpack  name:           sydtest-version:        0.7.0.1+version:        0.8.0.0 synopsis:       A modern testing framework for Haskell with good defaults and advanced testing features. description:    A modern testing framework for Haskell with good defaults and advanced testing features. Sydtest aims to make the common easy and the hard possible. See https://github.com/NorfairKing/sydtest#readme for more information. category:       Testing@@ -124,6 +124,7 @@       Test.Syd.AroundAllSpec       Test.Syd.AroundCombinationSpec       Test.Syd.AroundSpec+      Test.Syd.DescriptionsSpec       Test.Syd.FootgunSpec       Test.Syd.GoldenSpec       Test.Syd.OptParseSpec
+ test/Test/Syd/DescriptionsSpec.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Syd.DescriptionsSpec (spec) where++import Test.Syd++spec :: Spec+spec =+  describe "foo" $+    describe "bar" $+      describe "quux" $ do+        descs <- getTestDescriptionPath+        it "gets the right descriptions" $+          descs `shouldBe` ["quux", "bar", "foo", "Test.Syd.DescriptionsSpec"]