sandwich 0.1.1.1 → 0.1.1.2

raw patch · 7 files changed

+51/−40 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• sandwich.cabal +7/−7
• src/Test/Sandwich.hs +8/−3
• src/Test/Sandwich/Internal/Running.hs +2/−4
• src/Test/Sandwich/Interpreters/FilterTree.hs +28/−24
• src/Test/Sandwich/Types/General.hs +1/−1
• src/Test/Sandwich/Types/RunTree.hs +1/−1

@@ -2,6 +2,10 @@  ## Unreleased changes +## 0.1.1.2++* Improve semantics of multiple `--filter/-f` arguments. Now they get applied to the test tree sequentially.+ ## 0.1.1.1  * Fix error symlink creation on Windows (don't allow invalid characters).

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.35.0. -- -- see: https://github.com/sol/hpack  name:           sandwich-version:        0.1.1.1+version:        0.1.1.2 synopsis:       Yet another test framework for Haskell description:    Please see the <https://codedownio.github.io/sandwich documentation>. category:       Testing@@ -125,6 +125,7 @@     , transformers-base     , unliftio-core     , vector+  default-language: Haskell2010   if !os(windows)     build-depends:         brick@@ -147,7 +148,6 @@         Test.Sandwich.Formatters.TerminalUI.Types     hs-source-dirs:         unix-src-  default-language: Haskell2010  executable sandwich-demo   main-is: Main.hs@@ -200,12 +200,12 @@     , transformers-base     , unliftio-core     , vector+  default-language: Haskell2010   if !os(windows)     build-depends:         brick       , unix       , vty-  default-language: Haskell2010  executable sandwich-discover   main-is: Main.hs@@ -258,12 +258,12 @@     , transformers-base     , unliftio-core     , vector+  default-language: Haskell2010   if !os(windows)     build-depends:         brick       , unix       , vty-  default-language: Haskell2010  executable sandwich-test   main-is: Main.hs@@ -321,12 +321,12 @@     , transformers-base     , unliftio-core     , vector+  default-language: Haskell2010   if !os(windows)     build-depends:         brick       , unix       , vty-  default-language: Haskell2010  test-suite sandwich-test-suite   type: exitcode-stdio-1.0@@ -385,9 +385,9 @@     , transformers-base     , unliftio-core     , vector+  default-language: Haskell2010   if !os(windows)     build-depends:         brick       , unix       , vty-  default-language: Haskell2010

@@ -190,12 +190,17 @@    exitReasonRef <- newIORef NormalExit -  let shutdown info = do-        putStrLn [i|Shutting down due to #{info}...|]-        writeIORef exitReasonRef InterruptExit+  let shutdown sig = do+        let signalName :: T.Text =+              if | sig == sigINT -> "sigINT"+                 | sig == sigTERM -> "sigTERM"+                 | otherwise -> [i|signal #{sig}|]+        putStrLn [i|Shutting down due to #{signalName}...|]+        writeIORef exitReasonRef SignalExit         forM_ rts cancelNode    _ <- installHandler sigINT shutdown+  _ <- installHandler sigTERM shutdown    -- Wait for the tree to finish   mapM_ waitForTree rts

@@ -37,9 +37,7 @@  startSandwichTree' :: BaseContext -> Options -> CoreSpec -> IO [RunNode BaseContext] startSandwichTree' baseContext (Options {..}) spec' = do-  let spec = case optionsFilterTree of-        Nothing -> spec'-        Just (TreeFilter matches) -> filterTree matches spec'+  let spec = maybe spec' (L.foldl' filterTree spec' . unTreeFilter) optionsFilterTree    runTree <- atomically $ specToRunTreeVariable baseContext spec @@ -67,7 +65,7 @@      modify $ \(successes, total) -> (successes + (if numFailures == 0 then 1 else 0), total + 1) -    if | exitReason == InterruptExit -> return ()+    if | exitReason == SignalExit -> return ()        | n > 0 -> loop (n - 1)        | otherwise -> return () 

@@ -7,28 +7,32 @@ import qualified Data.List as L import Test.Sandwich.Types.Spec -filterTree :: [String] -> Free (SpecCommand context m) () -> Free (SpecCommand context m) ()-filterTree matches (Free (It'' loc no l ex next))-  | all (`L.isInfixOf` l) matches = Free (It'' loc no l ex (filterTree matches next))-  | otherwise = filterTree matches (filterTree matches next)-filterTree matches (Free (Introduce'' loc no l cl alloc cleanup subspec next))-  | all (`L.isInfixOf` l) matches = Free (Introduce'' loc no l cl alloc cleanup subspec (filterTree matches next))-  | otherwise = case filterTree matches subspec of-      (Pure _) -> filterTree matches next-      x -> Free (Introduce'' loc no l cl alloc cleanup x (filterTree matches next))-filterTree matches (Free (IntroduceWith'' loc no l cl action subspec next))-  | all (`L.isInfixOf` l) matches = Free (IntroduceWith'' loc no l cl action subspec (filterTree matches next))-  | otherwise = case filterTree matches subspec of-      (Pure _) -> filterTree matches next-      x -> Free (IntroduceWith'' loc no l cl action x (filterTree matches next))-filterTree matches (Free (Parallel'' loc no subspec next)) =-  case filterTree matches subspec of-    (Pure _) -> filterTree matches next-    x -> Free (Parallel'' loc no x (filterTree matches next))-filterTree matches (Free x)-  | all (`L.isInfixOf` label x) matches = Free (x { next = (filterTree matches (next x)) })-  | otherwise = case filterTree matches (subspec x) of-      (Pure _) -> filterTree matches (next x)+filterTree :: Free (SpecCommand context m) () -> String -> Free (SpecCommand context m) ()+filterTree (Free (It'' loc no l ex next)) match+  | l `matches` match = Free (It'' loc no l ex (filterTree next match))+  | otherwise = filterTree (filterTree next match) match+filterTree (Free (Introduce'' loc no l cl alloc cleanup subspec next)) match+  | l `matches` match = Free (Introduce'' loc no l cl alloc cleanup subspec (filterTree next match))+  | otherwise = case filterTree subspec match of+      (Pure _) -> filterTree next match+      x -> Free (Introduce'' loc no l cl alloc cleanup x (filterTree next match))+filterTree (Free (IntroduceWith'' loc no l cl action subspec next)) match+  | l `matches` match = Free (IntroduceWith'' loc no l cl action subspec (filterTree next match))+  | otherwise = case filterTree subspec match of+      (Pure _) -> filterTree next match+      x -> Free (IntroduceWith'' loc no l cl action x (filterTree next match))+filterTree (Free (Parallel'' loc no subspec next)) match+  = case filterTree subspec match of+      (Pure _) -> filterTree next match+      x -> Free (Parallel'' loc no x (filterTree next match))+filterTree (Free x) match+  | label x `matches` match = Free (x { next = (filterTree (next x) match) })+  | otherwise = case filterTree (subspec x) match of+      (Pure _) -> filterTree (next x) match       subspec' -> Free (x { subspec = subspec'-                          , next = (filterTree matches (next x)) })-filterTree _ (Pure x) = Pure x+                          , next = (filterTree (next x) match) })+filterTree (Pure x) _ = Pure x+++matches :: String -> String -> Bool+matches l match = match `L.isInfixOf` l

@@ -1,5 +1,5 @@  module Test.Sandwich.Types.General where -data ExitReason = NormalExit | InterruptExit+data ExitReason = NormalExit | SignalExit   deriving (Show, Eq)

@@ -205,7 +205,7 @@       }   -- ^ Create a new test artifacts directory under '' test artifacts directory at the given path. -newtype TreeFilter = TreeFilter [String]+newtype TreeFilter = TreeFilter { unTreeFilter :: [String] }  type LogFn = Loc -> LogSource -> LogLevel -> LogStr -> IO ()