Fixes #95 :edit command should jump to the last error
authorLorenzo Tabacchini <lortabac@gmx.com>
Sun, 8 Jun 2014 08:54:39 +0000 (10:54 +0200)
committerJoachim Breitner <mail@joachim-breitner.de>
Fri, 13 Jun 2014 15:01:26 +0000 (08:01 -0700)
docs/users_guide/ghci.xml
ghc/GhciMonad.hs
ghc/InteractiveUI.hs
testsuite/tests/ghci/prog013/Bad.hs [new file with mode: 0644]
testsuite/tests/ghci/prog013/Good.hs [new file with mode: 0644]
testsuite/tests/ghci/prog013/prog013.T [new file with mode: 0644]
testsuite/tests/ghci/prog013/prog013.script [new file with mode: 0644]
testsuite/tests/ghci/prog013/prog013.stderr [new file with mode: 0644]
testsuite/tests/ghci/prog013/prog013.stdout [new file with mode: 0644]

index 912ecb2..50b59e9 100644 (file)
@@ -2432,7 +2432,9 @@ Prelude> :. cmds.ghci
         <listitem>
           <para>Opens an editor to edit the file
           <replaceable>file</replaceable>, or the most recently loaded
-          module if <replaceable>file</replaceable> is omitted.  The
+          module if <replaceable>file</replaceable> is omitted.
+          If there were errors during the last loading,
+          the cursor will be positioned at the line of the first error. The
           editor to invoke is taken from the <literal>EDITOR</literal>
           environment variable, or a default editor on your system if
           <literal>EDITOR</literal> is not set.  You can change the
index 8f429c5..22109c4 100644 (file)
@@ -33,6 +33,7 @@ import Outputable       hiding (printForUser, printForUserPartWay)
 import qualified Outputable
 import Util
 import DynFlags
+import FastString
 import HscTypes
 import SrcLoc
 import Module
@@ -105,7 +106,8 @@ data GHCiState = GHCiState
 
         -- help text to display to a user
         short_help :: String,
-        long_help  :: String
+        long_help  :: String,
+        lastErrorLocations :: IORef [(FastString, Int)]
      }
 
 type TickArray = Array Int [(BreakIndex,SrcSpan)]
index 53ada93..0a56799 100644 (file)
@@ -28,6 +28,7 @@ import Debugger
 
 -- The GHC interface
 import DynFlags
+import ErrUtils
 import GhcMonad ( modifySession )
 import qualified GHC
 import GHC ( LoadHowMuch(..), Target(..),  TargetId(..), InteractiveImport(..),
@@ -72,7 +73,7 @@ import Data.Array
 import qualified Data.ByteString.Char8 as BS
 import Data.Char
 import Data.Function
-import Data.IORef ( IORef, readIORef, writeIORef )
+import Data.IORef ( IORef, modifyIORef, newIORef, readIORef, writeIORef )
 import Data.List ( find, group, intercalate, intersperse, isPrefixOf, nub,
                    partition, sort, sortBy )
 import Data.Maybe
@@ -104,7 +105,6 @@ import GHC.IO.Exception ( IOErrorType(InvalidArgument) )
 import GHC.IO.Handle ( hFlushAll )
 import GHC.TopHandler ( topHandler )
 
-
 -----------------------------------------------------------------------------
 
 data GhciSettings = GhciSettings {
@@ -380,6 +380,12 @@ interactiveUI config srcs maybe_exprs = do
                $ dflags
    GHC.setInteractiveDynFlags dflags'
 
+   lastErrLocationsRef <- liftIO $ newIORef []
+   progDynFlags <- GHC.getProgramDynFlags
+   _ <- GHC.setProgramDynFlags $
+      progDynFlags { log_action = ghciLogAction lastErrLocationsRef }
+
    liftIO $ when (isNothing maybe_exprs) $ do
         -- Only for GHCi (not runghc and ghc -e):
 
@@ -400,31 +406,46 @@ interactiveUI config srcs maybe_exprs = do
 #endif
 
    default_editor <- liftIO $ findEditor
-
    startGHCi (runGHCi srcs maybe_exprs)
-        GHCiState{ progname       = default_progname,
-                   GhciMonad.args = default_args,
-                   prompt         = defPrompt config,
-                   prompt2        = defPrompt2 config,
-                   stop           = default_stop,
-                   editor         = default_editor,
-                   options        = [],
-                   line_number    = 1,
-                   break_ctr      = 0,
-                   breaks         = [],
-                   tickarrays     = emptyModuleEnv,
-                   ghci_commands  = availableCommands config,
-                   last_command   = Nothing,
-                   cmdqueue       = [],
-                   remembered_ctx = [],
-                   transient_ctx  = [],
-                   ghc_e          = isJust maybe_exprs,
-                   short_help     = shortHelpText config,
-                   long_help      = fullHelpText config
+        GHCiState{ progname           = default_progname,
+                   GhciMonad.args     = default_args,
+                   prompt             = defPrompt config,
+                   prompt2            = defPrompt2 config,
+                   stop               = default_stop,
+                   editor             = default_editor,
+                   options            = [],
+                   line_number        = 1,
+                   break_ctr          = 0,
+                   breaks             = [],
+                   tickarrays         = emptyModuleEnv,
+                   ghci_commands      = availableCommands config,
+                   last_command       = Nothing,
+                   cmdqueue           = [],
+                   remembered_ctx     = [],
+                   transient_ctx      = [],
+                   ghc_e              = isJust maybe_exprs,
+                   short_help         = shortHelpText config,
+                   long_help          = fullHelpText config,
+                   lastErrorLocations = lastErrLocationsRef
                  }
-
+    
    return ()
 
+resetLastErrorLocations :: GHCi ()
+resetLastErrorLocations = do
+    st <- getGHCiState
+    liftIO $ writeIORef (lastErrorLocations st) []
+
+ghciLogAction :: IORef [(FastString, Int)] ->  LogAction
+ghciLogAction lastErrLocations dflags severity srcSpan style msg = do
+    defaultLogAction dflags severity srcSpan style msg
+    case severity of
+        SevError -> case srcSpan of
+            RealSrcSpan rsp -> modifyIORef lastErrLocations
+                (++ [(srcLocFile (realSrcSpanStart rsp), srcLocLine (realSrcSpanStart rsp))])
+            _ -> return ()
+        _ -> return ()
+
 withGhcAppData :: (FilePath -> IO a) -> IO a -> IO a
 withGhcAppData right left = do
     either_dir <- tryIO (getAppUserDataDirectory "ghc")
@@ -1170,10 +1191,18 @@ editFile :: String -> InputT GHCi ()
 editFile str =
   do file <- if null str then lift chooseEditFile else expandPath str
      st <- lift getGHCiState
+     errs <- liftIO $ readIORef $ lastErrorLocations st
      let cmd = editor st
      when (null cmd)
        $ throwGhcException (CmdLineError "editor not set, use :set editor")
-     code <- liftIO $ system (cmd ++ ' ':file)
+     lineOpt <- liftIO $ do
+         curFileErrs <- filterM (\(f, _) -> unpackFS f `sameFile` file) errs
+         return $ case curFileErrs of
+             (_, line):_ -> " +" ++ show line
+             _ -> ""
+     let cmdArgs = ' ':(file ++ lineOpt)
+     code <- liftIO $ system (cmd ++ cmdArgs)
+
      when (code == ExitSuccess)
        $ reloadModule ""
 
@@ -1364,6 +1393,7 @@ doLoad retain_context howmuch = do
   -- the ModBreaks will have gone away.
   lift discardActiveBreakPoints
 
+  lift resetLastErrorLocations
   -- Enable buffering stdout and stderr as we're compiling. Keeping these
   -- handles unbuffered will just slow the compilation down, especially when
   -- compiling in parallel.
@@ -1388,7 +1418,6 @@ afterLoad ok retain_context = do
   modulesLoadedMsg ok loaded_mods
   lift $ setContextAfterLoad retain_context loaded_mod_summaries
 
-
 setContextAfterLoad :: Bool -> [GHC.ModSummary] -> GHCi ()
 setContextAfterLoad keep_ctxt [] = do
   setContextKeepingPackageModules keep_ctxt []
@@ -3118,7 +3147,13 @@ expandPathIO p =
         tilde <- getHomeDirectory -- will fail if HOME not defined
         return (tilde ++ '/':d)
    other ->
-        return other
+        return other    
+
+sameFile :: FilePath -> FilePath -> IO Bool
+sameFile path1 path2 = do
+    absPath1 <- canonicalizePath path1
+    absPath2 <- canonicalizePath path2
+    return $ absPath1 == absPath2
 
 wantInterpretedModule :: GHC.GhcMonad m => String -> m Module
 wantInterpretedModule str = wantInterpretedModuleName (GHC.mkModuleName str)
diff --git a/testsuite/tests/ghci/prog013/Bad.hs b/testsuite/tests/ghci/prog013/Bad.hs
new file mode 100644 (file)
index 0000000..2c26204
--- /dev/null
@@ -0,0 +1,3 @@
+a = 1
+b = 2
+bad = '
diff --git a/testsuite/tests/ghci/prog013/Good.hs b/testsuite/tests/ghci/prog013/Good.hs
new file mode 100644 (file)
index 0000000..a9aeef0
--- /dev/null
@@ -0,0 +1,3 @@
+a = 1
+b = 2
+c = 3
diff --git a/testsuite/tests/ghci/prog013/prog013.T b/testsuite/tests/ghci/prog013/prog013.T
new file mode 100644 (file)
index 0000000..020bdf8
--- /dev/null
@@ -0,0 +1,2 @@
+test('prog013', normal, ghci_script, ['prog013.script'])
+
diff --git a/testsuite/tests/ghci/prog013/prog013.script b/testsuite/tests/ghci/prog013/prog013.script
new file mode 100644 (file)
index 0000000..b9df968
--- /dev/null
@@ -0,0 +1,8 @@
+:set editor /bin/echo
+:l Good.hs
+:e
+:l Bad.hs
+:e
+:e ./Bad.hs
+:l Good.hs
+:e
diff --git a/testsuite/tests/ghci/prog013/prog013.stderr b/testsuite/tests/ghci/prog013/prog013.stderr
new file mode 100644 (file)
index 0000000..d8970d4
--- /dev/null
@@ -0,0 +1,9 @@
+
+Bad.hs:3:8:
+    lexical error in string/character literal at character '\n'
+
+Bad.hs:3:8:
+    lexical error in string/character literal at character '\n'
+
+Bad.hs:3:8:
+    lexical error in string/character literal at character '\n'
diff --git a/testsuite/tests/ghci/prog013/prog013.stdout b/testsuite/tests/ghci/prog013/prog013.stdout
new file mode 100644 (file)
index 0000000..0d621da
--- /dev/null
@@ -0,0 +1,4 @@
+Good.hs
+Bad.hs +3
+./Bad.hs +3
+Good.hs