Commit 43111a0b authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺

GHCi: Fix multi-line input line/column-number refs

This commit addresses #8051 by fixing

 - Incorrect column indices reported in error messages for
   single-line and multi-line input,

 - incorrect line numbers reported in error messages for
   expressions entered in multi-line input, and

 - inhibiting the confusing interaction between `:{` and `:set +m`
   causing the triggering of implicit multi-line continuation
   mode right after `:}` terminates the multi-line entry block.
parent ed3c59a4
...@@ -717,7 +717,7 @@ runOneCommand eh gCmd = do ...@@ -717,7 +717,7 @@ runOneCommand eh gCmd = do
(\c -> case removeSpaces c of (\c -> case removeSpaces c of
"" -> noSpace q "" -> noSpace q
":{" -> multiLineCmd q ":{" -> multiLineCmd q
c' -> return (Just c') ) _ -> return (Just c) )
multiLineCmd q = do multiLineCmd q = do
st <- lift getGHCiState st <- lift getGHCiState
let p = prompt st let p = prompt st
...@@ -736,7 +736,7 @@ runOneCommand eh gCmd = do ...@@ -736,7 +736,7 @@ runOneCommand eh gCmd = do
collectCommand q c = q >>= collectCommand q c = q >>=
maybe (liftIO (ioError collectError)) maybe (liftIO (ioError collectError))
(\l->if removeSpaces l == ":}" (\l->if removeSpaces l == ":}"
then return (Just $ removeSpaces c) then return (Just c)
else collectCommand q (c ++ "\n" ++ map normSpace l)) else collectCommand q (c ++ "\n" ++ map normSpace l))
where normSpace '\r' = ' ' where normSpace '\r' = ' '
normSpace x = x normSpace x = x
...@@ -747,7 +747,7 @@ runOneCommand eh gCmd = do ...@@ -747,7 +747,7 @@ runOneCommand eh gCmd = do
doCommand :: String -> InputT GHCi (Maybe Bool) doCommand :: String -> InputT GHCi (Maybe Bool)
-- command -- command
doCommand (':' : cmd) = do doCommand stmt | (':' : cmd) <- removeSpaces stmt = do
result <- specialCommand cmd result <- specialCommand cmd
case result of case result of
True -> return Nothing True -> return Nothing
...@@ -755,19 +755,46 @@ runOneCommand eh gCmd = do ...@@ -755,19 +755,46 @@ runOneCommand eh gCmd = do
-- haskell -- haskell
doCommand stmt = do doCommand stmt = do
-- if 'stmt' was entered via ':{' it will contain '\n's
let stmt_nl_cnt = length [ () | '\n' <- stmt ]
ml <- lift $ isOptionSet Multiline ml <- lift $ isOptionSet Multiline
if ml if ml && stmt_nl_cnt == 0 -- don't trigger automatic multi-line mode for ':{'-multiline input
then do then do
fst_line_num <- lift (line_number <$> getGHCiState)
mb_stmt <- checkInputForLayout stmt gCmd mb_stmt <- checkInputForLayout stmt gCmd
case mb_stmt of case mb_stmt of
Nothing -> return $ Just True Nothing -> return $ Just True
Just ml_stmt -> do Just ml_stmt -> do
result <- timeIt $ lift $ runStmt ml_stmt GHC.RunToCompletion -- temporarily compensate line-number for multi-line input
result <- timeIt $ lift $ runStmtWithLineNum fst_line_num ml_stmt GHC.RunToCompletion
return $ Just result return $ Just result
else do else do -- single line input and :{-multiline input
result <- timeIt $ lift $ runStmt stmt GHC.RunToCompletion last_line_num <- lift (line_number <$> getGHCiState)
-- reconstruct first line num from last line num and stmt
let fst_line_num | stmt_nl_cnt > 0 = last_line_num - (stmt_nl_cnt2 + 1)
| otherwise = last_line_num -- single line input
stmt_nl_cnt2 = length [ () | '\n' <- stmt' ]
stmt' = dropLeadingWhiteLines stmt -- runStmt doesn't like leading empty lines
-- temporarily compensate line-number for multi-line input
result <- timeIt $ lift $ runStmtWithLineNum fst_line_num stmt' GHC.RunToCompletion
return $ Just result return $ Just result
-- runStmt wrapper for temporarily overridden line-number
runStmtWithLineNum :: Int -> String -> SingleStep -> GHCi Bool
runStmtWithLineNum lnum stmt step = do
st0 <- getGHCiState
setGHCiState st0 { line_number = lnum }
result <- runStmt stmt step
-- restore original line_number
getGHCiState >>= \st -> setGHCiState st { line_number = line_number st0 }
return result
-- note: this is subtly different from 'unlines . dropWhile (all isSpace) . lines'
dropLeadingWhiteLines s | (l0,'\n':r) <- break (=='\n') s
, all isSpace l0 = dropLeadingWhiteLines r
| otherwise = s
-- #4316 -- #4316
-- lex the input. If there is an unclosed layout context, request input -- lex the input. If there is an unclosed layout context, request input
checkInputForLayout :: String -> InputT GHCi (Maybe String) checkInputForLayout :: String -> InputT GHCi (Maybe String)
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment