Improve dry run behavior and add command line option

.hlint.yaml

@@ -1,3 +1,4 @@
 
 - ignore: {name: "Redundant bracket"}
+- ignore: {name: "Redundant multi-way if"}
 - ignore: {name: "Use <$>"}

sandwich/src/Test/Sandwich/ArgParsing.hs

@@ -76,6 +76,7 @@ mainCommandLineOptions userOptionsParser individualTestParser = CommandLineOptio
   <*> optional (strOption (long "filter" <> short 'f' <> help "Filter test tree by string matching text example labels" <> metavar "STRING"))
   <*> option auto (long "repeat" <> short 'r' <> showDefault <> help "Repeat the test N times and report how many failures occur" <> value 1 <> metavar "INT")
   <*> optional (strOption (long "fixed-root" <> help "Store test artifacts at a fixed path" <> metavar "STRING"))
+  <*> optional (flag False True (long "dry-run" <> help "Skip actually launching the tests. This is useful if you want to see the set of the tests that would be run, or start them manually in the terminal UI."))
 
   <*> optional (flag False True (long "list-tests" <> help "List individual test modules"))
   <*> optional (flag False True (long "print-quickcheck-flags" <> help "Print the additional QuickCheck flags"))
@@ -212,6 +213,7 @@ addOptionsFromArgs baseOptions (CommandLineOptions {..}) = do
       Just path -> TestArtifactsFixedDirectory path
     , optionsFilterTree = TreeFilter <$> optTreeFilter
     , optionsFormatters = baseFormatters <> catMaybes [maybeMainFormatter]
+    , optionsDryRun = fromMaybe (optionsDryRun baseOptions) optDryRun
     }
 
   return (options, optRepeatCount)

sandwich/src/Test/Sandwich/Formatters/FailureReport.hs

@@ -100,6 +100,7 @@ runWithIndentation frf@(FailureReportFormatter {..}) idToLabel node = do
   -- Print the failure reason
   case result of
     Success -> return ()
+    DryRun -> return ()
     Failure (ChildrenFailed {}) -> return ()
     Failure reason -> do
       p "\n"

sandwich/src/Test/Sandwich/Formatters/Print.hs

@@ -87,6 +87,7 @@ runWithIndentation node@(RunNodeIt {..}) = do
   -- Print the main header
   case result of
     Success -> pGreenLn runTreeLabel
+    DryRun -> pin runTreeLabel
     (Failure (Pending _ _)) -> pYellowLn runTreeLabel
     (Failure reason) -> do
       pRedLn runTreeLabel
@@ -117,5 +118,6 @@ runWithIndentation node = do
       case result of
         Failure r -> withBumpIndent $ printFailureReason r
         Success -> return ()
+        DryRun -> return ()
       finishPrinting common result
     False -> return () -- TODO: print failure info even though node should be hidden?

sandwich/src/Test/Sandwich/Formatters/TerminalUI/AttrMap.hs

@@ -127,6 +127,7 @@ chooseAttr (Running {}) = runningAttr
 chooseAttr (Done _ _ (Success {})) = successAttr
 chooseAttr (Done _ _ (Failure (Pending {}))) = pendingAttr
 chooseAttr (Done _ _ (Failure {})) = failureAttr
+chooseAttr (Done _ _ DryRun) = notStartedAttr
 
 -- * Logging and callstacks
 

sandwich/src/Test/Sandwich/Formatters/TerminalUI/Draw/ColorProgressBar.hs

@@ -68,6 +68,7 @@ sumChunk = foldl combine zeroChunkSum
         lensForStatus (Done {statusResult=Success}) = success
         lensForStatus (Done {statusResult=(Failure (Pending {}))}) = pending
         lensForStatus (Done {statusResult=(Failure _)}) = failure
+        lensForStatus (Done {statusResult=DryRun}) = notStarted
 
 maxBy :: (Foldable t, Ord a) => (b -> a) -> t b -> b
 maxBy = maximumBy . comparing

sandwich/src/Test/Sandwich/Formatters/TerminalUI/Draw/ToBrickWidget.hs

@@ -34,6 +34,7 @@ instance ToBrickWidget Status where
   toBrickWidget (Running {statusStartTime}) = return $ strWrap [i|Started at #{statusStartTime}|]
   toBrickWidget (Done startTime endTime Success) = return $ strWrap [i|Succeeded in #{formatNominalDiffTime (diffUTCTime endTime startTime)}|]
   toBrickWidget (Done {statusResult=(Failure failureReason)}) = toBrickWidget failureReason
+  toBrickWidget (Done {statusResult=DryRun}) = return $ strWrap "Not started due to dry run"
 
 instance ToBrickWidget FailureReason where
   toBrickWidget (ExpectedButGot _ (SEB x1) (SEB x2)) = do

sandwich/src/Test/Sandwich/Internal/Running.hs

@@ -48,8 +48,8 @@ startSandwichTree' baseContext (Options {..}) spec' = do
 
   runTree <- atomically $ specToRunTreeVariable baseContext spec
 
-  unless optionsDryRun $ do
-    void $ async $ void $ runNodesSequentially runTree baseContext
+  if | optionsDryRun -> markAllChildrenWithResult runTree baseContext DryRun
+     | otherwise -> void $ async $ void $ runNodesSequentially runTree baseContext
 
   return runTree
 

sandwich/src/Test/Sandwich/Interpreters/StartTree.hs

@@ -9,6 +9,7 @@
 module Test.Sandwich.Interpreters.StartTree (
   startTree
   , runNodesSequentially
+  , markAllChildrenWithResult
   ) where
 
 
@@ -66,6 +67,9 @@ startTree node@(RunNodeBefore {..}) ctx' = do
       Success -> do
         void $ runNodesSequentially runNodeChildren ctx
         return Success
+      DryRun -> do
+        void $ runNodesSequentially runNodeChildren ctx
+        return DryRun
 startTree node@(RunNodeAfter {..}) ctx' = do
   let RunNodeCommonWithStatus {..} = runNodeCommon
   let ctx = modifyBaseContext ctx' $ baseContextFromCommon runNodeCommon

sandwich/src/Test/Sandwich/Types/ArgParsing.hs

@@ -49,6 +49,7 @@ data CommandLineOptions a = CommandLineOptions {
   , optTreeFilter :: Maybe String
   , optRepeatCount :: Int
   , optFixedRoot :: Maybe String
+  , optDryRun :: Maybe Bool
 
   , optListAvailableTests :: Maybe Bool
   , optPrintQuickCheckFlags :: Maybe Bool

sandwich/src/Test/Sandwich/Types/Spec.hs

@@ -74,6 +74,7 @@ instance (Monad m, MonadThrow m) => MonadFail (ExampleT context m) where
 
 data Result = Success
             | Failure FailureReason
+            | DryRun
   deriving (Show, Eq)
 
 data ShowEqBox = forall s. (Show s, Eq s) => SEB s