From cbdf425247214d1cfb78c547bf7620ea7314004d Mon Sep 17 00:00:00 2001
From: Veit Heller <veit@veitheller.de>
Date: Fri, 23 Jul 2021 21:24:59 +0200
Subject: [PATCH] fix: respect line number in repl (#1282)

* fix: respect line number in repl

* refactor: simplify Parse.parse

* fix: multiline line counter in repl
---
 src/Eval.hs    |  7 +++++--
 src/Parsing.hs | 10 +++++++---
 src/Repl.hs    | 12 ++++++------
 3 files changed, 18 insertions(+), 11 deletions(-)

diff --git a/src/Eval.hs b/src/Eval.hs
index 505aa0b6..b7ba61c6 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -501,10 +501,13 @@ apply ctx@Context {contextInternalEnv = internal} body params args =
 
 -- | Parses a string and then converts the resulting forms to commands, which are evaluated in order.
 executeString :: Bool -> Bool -> Context -> String -> String -> IO Context
-executeString doCatch printResult ctx input fileName =
+executeString = executeStringAtLine 1
+
+executeStringAtLine :: Int -> Bool -> Bool -> Context -> String -> String -> IO Context
+executeStringAtLine line doCatch printResult ctx input fileName =
   if doCatch then catch exec (catcher ctx) else exec
   where
-    exec = case parse input fileName of
+    exec = case parseAtLine line input fileName of
       Left parseError ->
         let sourcePos = Parsec.errorPos parseError
             parseErrorXObj =
diff --git a/src/Parsing.hs b/src/Parsing.hs
index 58081e85..b9781f76 100644
--- a/src/Parsing.hs
+++ b/src/Parsing.hs
@@ -2,6 +2,7 @@
 
 module Parsing
   ( parse,
+    parseAtLine,
     validCharacters,
     balance,
   )
@@ -599,11 +600,14 @@ lispSyntax = do
   Parsec.eof
   pure result
 
-parse :: String -> String -> Either Parsec.ParseError [XObj]
-parse text fileName =
-  let initState = ParseState (Info 1 1 fileName (Set.fromList []) 0)
+parseAtLine :: Int -> String -> String -> Either Parsec.ParseError [XObj]
+parseAtLine line text fileName =
+  let initState = ParseState (Info line 1 fileName (Set.fromList []) 0)
    in Parsec.runParser lispSyntax initState fileName text
 
+parse :: String -> String -> Either Parsec.ParseError [XObj]
+parse = parseAtLine 1
+
 {-# ANN balance "HLint: ignore Use String" #-}
 
 -- | For detecting the parenthesis balance in a string, i.e. "((( ))" = 1
diff --git a/src/Repl.hs b/src/Repl.hs
index a6f439cc..960935eb 100644
--- a/src/Repl.hs
+++ b/src/Repl.hs
@@ -112,8 +112,8 @@ treatSpecialInput (':' : rest) =
         Nothing -> rewriteError ("Unknown special command: :" ++ [cmd])
 treatSpecialInput arg = arg
 
-repl :: String -> String -> InputT (StateT Context IO) ()
-repl readSoFar prompt =
+repl :: Int -> String -> String -> InputT (StateT Context IO) ()
+repl line readSoFar prompt =
   do
     context <- lift get
     input <- getInputLine (strWithColor Yellow prompt)
@@ -128,10 +128,10 @@ repl readSoFar prompt =
         case balanced of
           "" -> do
             let input' = if concatenated == "\n" then contextLastInput context else concatenated -- Entering an empty string repeats last input
-            context' <- liftIO $ executeString True True (resetAlreadyLoadedFiles context) (treatSpecialInput input') "REPL"
+            context' <- liftIO $ executeStringAtLine line True True (resetAlreadyLoadedFiles context) (treatSpecialInput input') "REPL"
             lift $ put context'
-            repl "" (projectPrompt proj)
-          _ -> repl concatenated (if projectBalanceHints proj then balanced else "")
+            repl (line + (length (filter ('\n' ==) input'))) "" (projectPrompt proj)
+          _ -> repl line concatenated (if projectBalanceHints proj then balanced else "")
 
 resetAlreadyLoadedFiles :: Context -> Context
 resetAlreadyLoadedFiles context =
@@ -143,4 +143,4 @@ runRepl :: Context -> IO ((), Context)
 runRepl context = do
   historyPath <- configPath "history"
   createDirectoryIfMissing True (takeDirectory historyPath)
-  runStateT (runInputT (readlineSettings historyPath) (repl "" (projectPrompt (contextProj context)))) context
+  runStateT (runInputT (readlineSettings historyPath) (repl 1 "" (projectPrompt (contextProj context)))) context