Source line info for test steps from parsing

3 files changed, 33 insertions, 19 deletions

diff --git a/src/Main.hs b/src/Main.hs
index e062dee..5e1e7b2 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -267,8 +267,8 @@ tryMatch re (x:xs) | Right (Just (_, _, _, capture)) <- regexec re x = Just ((x,
                    | otherwise = fmap (x:) <$> tryMatch re xs
 tryMatch _ [] = Nothing
 
-expect :: Process -> Regex -> Text -> [VarName] -> TestRun ()
-expect p re pat vars = do
+expect :: SourceLine -> Process -> Regex -> [VarName] -> TestRun ()
+expect (SourceLine sline) p re vars = do
     timeout <- asks $ optTimeout . teOptions
     delay <- liftIO $ registerDelay $ ceiling $ 1000000 * timeout
     mbmatch <- atomicallyTest $ (Nothing <$ (check =<< readTVar delay)) <|> do
@@ -281,19 +281,19 @@ expect p re pat vars = do
     case mbmatch of
          Just (line, capture) -> do
              when (length vars /= length capture) $ do
-                 outLine OutputMatchFail (Just $ procName p) $ T.pack "mismatched number of capture variables /" `T.append` pat `T.append` T.pack "/"
+                 outLine OutputMatchFail (Just $ procName p) $ T.pack "mismatched number of capture variables on " `T.append` sline
                  throwError ()
 
              forM_ vars $ \name -> do
                  cur <- gets (lookup name . tsVars)
                  when (isJust cur) $ do
-                     outLine OutputMatchFail (Just $ procName p) $ T.pack "variable already exists: '" `T.append` textVarName name `T.append` T.pack "'"
+                     outLine OutputMatchFail (Just $ procName p) $ T.pack "variable '" `T.append` textVarName name `T.append` T.pack "' already exists on " `T.append` sline
                      throwError ()
 
              modify $ \s -> s { tsVars = zip vars capture ++ tsVars s }
              outLine OutputMatch (Just $ procName p) line
          Nothing -> do
-             outLine OutputMatchFail (Just $ procName p) $ T.pack "expect failed /" `T.append` pat `T.append` T.pack "/"
+             outLine OutputMatchFail (Just $ procName p) $ T.pack "expect failed on " `T.append` sline
              throwError ()
 
 allM :: Monad m => [a] -> (a -> m Bool) -> m Bool
@@ -335,11 +335,10 @@ runTest out opts test = do
                 line <- eval expr
                 send p line
 
-            Expect pname expr@(Regex ps) captures -> do
+            Expect line pname expr captures -> do
                 p <- getProcess net pname
                 regex <- eval expr
-                pat <- eval (Concat ps)
-                expect p regex pat captures
+                expect line p regex captures
 
             Wait -> do
                 outPrompt $ T.pack "Waiting..."
diff --git a/src/Parser.hs b/src/Parser.hs
index 6131a78..0608ccd 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -152,16 +152,28 @@ instance (GInit f, GInit h) => GInit (f :*: h) where ginit = ginit :*: ginit
 
 data Param a = forall b. Param String (Lens' a (Maybe b)) (TestParser b)
 
-command :: (Generic b, GInit (Rep b)) => String -> [Param b] -> (b -> TestParser a) -> TestParser [a]
+getSourceLine :: TestParser SourceLine
+getSourceLine = do
+    pstate <- statePosState <$> getParserState
+    return $ SourceLine $ T.concat
+        [ T.pack $ sourcePosPretty $ pstateSourcePos pstate
+        , T.pack ": "
+        , TL.toStrict $ TL.takeWhile (/='\n') $ pstateInput pstate
+        ]
+
+command :: (Generic b, GInit (Rep b)) => String -> [Param b] -> (SourceLine -> b -> TestParser a) -> TestParser [a]
 command name params fin = do
+    origline <- getSourceLine
     wsymbol name
-    let blockHelper prev cur = L.indentBlock scn $ helper prev cur
-        helper prev cur = choice $ concat
+    let blockHelper line prev cur = L.indentBlock scn $ helper line prev cur
+        helper line prev cur = choice $ concat
             [[ do void $ eol
-                  L.IndentNone . (:[]) <$> fin cur
+                  L.IndentNone . (:[]) <$> fin line cur
              ]
             ,[ do void $ lexeme (char ':')
-                  return $ L.IndentSome Nothing (return . concat) (blockHelper prev cur)
+                  return $ L.IndentSome Nothing (return . concat) $ do
+                      line' <- getSourceLine
+                      blockHelper line' prev cur
              ]
             , flip map params $ \(Param sym l p) -> do
                 x <- if null sym
@@ -175,10 +187,10 @@ command name params fin = do
                         when (any (== sym) prev) $ do
                             fail $ "multiple '" ++ sym ++ "' parameters"
                         p
-                helper (sym:prev) (l .~ Just x $ cur)
+                helper line (sym:prev) (l .~ Just x $ cur)
             ]
 
-    blockHelper [] (G.to ginit)
+    blockHelper origline [] (G.to ginit)
 
 
 data SpawnBuilder = SpawnBuilder
@@ -193,7 +205,7 @@ testSpawn :: TestParser [TestStep]
 testSpawn = command "spawn"
     [ Param "on" spawnBuilderNode nodeName
     , Param "as" spawnBuilderProc procName
-    ] $ \b -> Spawn
+    ] $ \_ b -> Spawn
         <$> (maybe (fail "missing 'as' <proc>") return $ b ^. spawnBuilderProc)
         <*> (maybe (fail "missing 'on' <node>") return $ b ^. spawnBuilderNode)
 
@@ -210,7 +222,7 @@ testSend :: TestParser [TestStep]
 testSend = command "send"
     [ Param "to" sendBuilderProc procName
     , Param "" sendBuilderLine quotedString
-    ] $ \b -> Send
+    ] $ \_ b -> Send
         <$> (maybe (fail "missing 'to' <proc>") return $ b ^. sendBuilderProc)
         <*> (maybe (fail "missing line to send") return $ b ^. sendBuilderLine)
 
@@ -229,7 +241,7 @@ testExpect = command "expect"
     [ Param "from" expectBuilderProc procName
     , Param "" expectBuilderRegex regex
     , Param "capture" expectBuilderCaptures (listOf $ VarName . (:[]) <$> identifier)
-    ] $ \b -> Expect
+    ] $ \s b -> Expect s
         <$> (maybe (fail "missing 'from' <proc>") return $ b ^. expectBuilderProc)
         <*> (maybe (fail "missing regex to match") return $ b ^. expectBuilderRegex)
         <*> (maybe (return []) return $ b ^. expectBuilderCaptures)
diff --git a/src/Test.hs b/src/Test.hs
index ab97bc7..404d965 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -1,6 +1,7 @@
 module Test (
     Test(..),
     TestStep(..),
+    SourceLine(..),
 
     ProcName(..), textProcName, unpackProcName,
     NodeName(..), textNodeName, unpackNodeName,
@@ -29,9 +30,11 @@ data Test = Test
 
 data TestStep = Spawn ProcName NodeName
               | Send ProcName (Expr Text)
-              | Expect ProcName (Expr Regex) [VarName]
+              | Expect SourceLine ProcName (Expr Regex) [VarName]
               | Wait
 
+newtype SourceLine = SourceLine Text
+
 newtype NodeName = NodeName Text
     deriving (Eq, Ord)