From f40765688cc5c383cbf07550b06e7843e3acfe45 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 20 Aug 2022 14:51:42 +0200
Subject: Print relevant variables for guard failure

---
 src/Main.hs | 21 +++++++++++----------
 1 file changed, 11 insertions(+), 10 deletions(-)

(limited to 'src')

diff --git a/src/Main.hs b/src/Main.hs
index bb5ec02..29c45bc 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -267,6 +267,14 @@ tryMatch re (x:xs) | Right (Just (_, _, _, capture)) <- regexec re x = Just ((x,
                    | otherwise = fmap (x:) <$> tryMatch re xs
 tryMatch _ [] = Nothing
 
+exprFailed :: Text -> SourceLine -> Maybe ProcName -> Expr a -> TestRun ()
+exprFailed desc (SourceLine sline) pname expr = do
+    exprVars <- gatherVars expr
+    outLine OutputMatchFail pname $ T.concat [desc, T.pack " failed on ", sline]
+    forM_ exprVars $ \(name, value) ->
+        outLine OutputMatchFail pname $ T.concat [T.pack "  ", textVarName name, T.pack " = ", textSomeVarValue value]
+    throwError ()
+
 expect :: SourceLine -> Process -> Expr Regex -> [VarName] -> TestRun ()
 expect (SourceLine sline) p expr vars = do
     re <- eval expr
@@ -293,19 +301,12 @@ expect (SourceLine sline) p expr vars = do
 
              modify $ \s -> s { tsVars = zip vars (map SomeVarValue capture) ++ tsVars s }
              outLine OutputMatch (Just $ procName p) line
-         Nothing -> do
-             outLine OutputMatchFail (Just $ procName p) $ T.pack "expect failed on " `T.append` sline
-             exprVars <- gatherVars expr
-             forM_ exprVars $ \(name, value) ->
-                 outLine OutputMatchFail (Just $ procName p) $ T.concat [T.pack "  ", textVarName name, T.pack " = ", textSomeVarValue value]
-             throwError ()
+         Nothing -> exprFailed (T.pack "expect") (SourceLine sline) (Just $ procName p) expr
 
 testStepGuard :: SourceLine -> Expr Bool -> TestRun ()
-testStepGuard (SourceLine sline) expr = do
+testStepGuard sline expr = do
     x <- eval expr
-    when (not x) $ do
-         outLine OutputMatchFail Nothing $ T.pack "guard failed on " `T.append` sline
-         throwError ()
+    when (not x) $ exprFailed (T.pack "guard") sline Nothing expr
 
 allM :: Monad m => [a] -> (a -> m Bool) -> m Bool
 allM (x:xs) p = p x >>= \case True -> allM xs p; False -> return False
-- 
cgit v1.2.3