diff --git a/elisp/intero.el b/elisp/intero.el --- a/elisp/intero.el +++ b/elisp/intero.el @@ -70,7 +70,7 @@ :group 'haskell) (defcustom intero-package-version - "0.1.21" + "0.1.22" "Package version to auto-install. This version does not necessarily have to be the latest version @@ -217,7 +217,8 @@ ;;;###autoload (define-globalized-minor-mode intero-global-mode - intero-mode intero-mode-maybe) + intero-mode intero-mode-maybe + :require 'intero) (define-obsolete-function-alias 'global-intero-mode 'intero-global-mode) @@ -642,21 +643,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Flycheck integration -(defvar-local intero-check-last-hash nil - "Most recent hash for the current buffer when flycheck was last triggered.") - -(defvar-local intero-check-last-results nil - "Most recent flycheck results for the current buffer.") - -(defun intero-check-reuse-last-results (hash cont) - "If HASH is not new, return non-nil and call CONT with `intero-check-last-results'." - (let ((reuse (and intero-check-last-hash - (equal hash intero-check-last-hash)))) - (progn - (when reuse - (funcall cont 'finished intero-check-last-results)) - reuse))) - (defun intero-flycheck-enable () "Enable intero's flycheck support in this buffer." (flycheck-select-checker 'intero) @@ -664,13 +650,6 @@ intero-check-last-results nil) (flycheck-mode)) -(defun intero-check-calculate-hash () - "Calculate a hash for the current buffer that will change when it needs re-checking." - (secure-hash - 'md5 - (concat (prin1-to-string intero-start-time) ; Force re-check after intero-restart - (buffer-substring-no-properties (point-min) (point-max))))) - (defun intero-check (checker cont) "Run a check with CHECKER and pass the status onto CONT." (if (intero-gave-up 'backend) @@ -679,40 +658,53 @@ cont 'interrupted) (let* ((file-buffer (current-buffer)) + (staging-file (intero-localize-path (intero-staging-file-name))) (temp-file (intero-localize-path (intero-temp-file-name))) (hash (intero-check-calculate-hash))) - (unless (intero-check-reuse-last-results hash cont) - (intero-async-call - 'backend - (concat ":l " temp-file) - (list :cont cont - :file-buffer file-buffer - :hash hash - :checker checker) - (lambda (state string) - (with-current-buffer (plist-get state :file-buffer) - (unless (intero-check-reuse-last-results (plist-get state :hash) - (plist-get state :cont)) - (let* ((compile-ok (string-match "OK, modules loaded: \\(.*\\)\\.$" string)) - (modules (match-string 1 string)) - (msgs (intero-parse-errors-warnings-splices - (plist-get state :checker) - (current-buffer) - string))) - (intero-collect-compiler-messages msgs) - (let ((results (cl-remove-if (lambda (msg) - (eq 'splice (flycheck-error-level msg))) - msgs))) - (setq intero-check-last-hash (plist-get state :hash) - intero-check-last-results results) - (funcall (plist-get state :cont) 'finished results)) - (when compile-ok - (intero-async-call 'backend - (concat ":m + " - (replace-regexp-in-string modules "," "")) - nil - (lambda (_st _))))))))))))) - + ;; We queue up to :move the staging file to the target temp + ;; file, which also updates its modified time. + (intero-async-call + 'backend + (format ":move \"%s\" \"%s\"" + staging-file + temp-file)) + ;; We load up the target temp file, which has only been updated + ;; by the copy above. + (intero-async-call + 'backend + (concat ":l " temp-file) + (list :cont cont + :file-buffer file-buffer + :hash hash + :checker checker) + (lambda (state string) + (with-current-buffer (plist-get state :file-buffer) + (let* ((compile-ok (string-match "OK, modules loaded: \\(.*\\)\\.$" string)) + (modules (match-string 1 string)) + (msgs (intero-parse-errors-warnings-splices + (plist-get state :checker) + (current-buffer) + string))) + (intero-collect-compiler-messages msgs) + (let ((results (cl-remove-if (lambda (msg) + (eq 'splice (flycheck-error-level msg))) + msgs))) + (setq intero-check-last-hash (plist-get state :hash) + intero-check-last-results results) + (funcall (plist-get state :cont) 'finished results)) + (when compile-ok + (intero-async-call 'backend + (concat ":m + " + (replace-regexp-in-string modules "," "")) + nil + (lambda (_st _)))))))) + ;; We sleep for at least one second to allow a buffer period + ;; between module updates. GHCi will consider a module Foo to be + ;; unchanged even if its filename has changed or timestmap has + ;; changed, if the timestamp is less than 1 second. + (intero-async-call + 'backend + ":sleep 1")))) (flycheck-define-generic-checker 'intero "A syntax and type checker for Haskell using an Intero worker @@ -1629,30 +1621,34 @@ temporary-file-directory)) (defun intero-temp-file-name (&optional buffer) + "Return the name of a temp file pertaining to BUFFER." + (with-current-buffer (or buffer (current-buffer)) + (or intero-temp-file-name + (progn (setq intero-temp-file-name + (intero-canonicalize-path + (intero-make-temp-file + "intero" nil + (concat "-TEMP." (if (buffer-file-name) + (file-name-extension (buffer-file-name)) + "hs"))))) + (puthash intero-temp-file-name + (current-buffer) + intero-temp-file-buffer-mapping) + intero-temp-file-name)))) + +(defun intero-staging-file-name (&optional buffer) "Return the name of a temp file containing an up-to-date copy of BUFFER's contents." (with-current-buffer (or buffer (current-buffer)) - (prog1 - (or intero-temp-file-name - (progn (setq intero-temp-file-name - (intero-canonicalize-path - (intero-make-temp-file - "intero" nil - (concat "." (if (buffer-file-name) - (file-name-extension (buffer-file-name)) - "hs"))))) - (puthash intero-temp-file-name - (current-buffer) - intero-temp-file-buffer-mapping) - intero-temp-file-name)) - (let* ((contents (buffer-string)) - (fname intero-temp-file-name) - (prev-contents (and (file-readable-p fname) - (with-temp-buffer - (insert-file-contents fname) - (buffer-string))))) - (unless (and prev-contents (string-equal contents prev-contents)) - (with-temp-file intero-temp-file-name - (insert contents))))))) + (let* ((contents (buffer-string)) + (fname (intero-canonicalize-path + (intero-make-temp-file + "intero" nil + (concat "-STAGING." (if (buffer-file-name) + (file-name-extension (buffer-file-name)) + "hs")))))) + (with-temp-file fname + (insert contents)) + fname))) (defun intero-localize-path (path) "Turn a possibly-remote PATH to a purely local one. @@ -2418,7 +2414,6 @@ (let ((map (copy-keymap widget-keymap))) (define-key map (kbd "C-c C-c") 'exit-recursive-edit) (define-key map (kbd "C-c C-k") 'abort-recursive-edit) - (define-key map (kbd "C-g") 'abort-recursive-edit) map)) (widget-setup) (recursive-edit) @@ -3087,7 +3082,6 @@ (define-key map (kbd "") 'intero-highlight-uses-mode-prev) (define-key map (kbd "RET") 'intero-highlight-uses-mode-stop-here) (define-key map (kbd "r") 'intero-highlight-uses-mode-replace) - (define-key map (kbd "C-g") 'intero-highlight-uses-mode) (define-key map (kbd "q") 'intero-highlight-uses-mode) map) "Keymap for using `intero-highlight-uses-mode'.") diff --git a/intero.cabal b/intero.cabal --- a/intero.cabal +++ b/intero.cabal @@ -1,7 +1,7 @@ name: intero version: - 0.1.21 + 0.1.22 synopsis: Complete interactive development program for Haskell license: @@ -112,4 +112,5 @@ process, transformers, directory, - regex-compat + regex-compat, + filepath diff --git a/src/InteractiveUI.hs b/src/InteractiveUI.hs --- a/src/InteractiveUI.hs +++ b/src/InteractiveUI.hs @@ -110,6 +110,10 @@ import Control.Monad as Monad import Control.Monad.Trans.Class import Control.Monad.IO.Class +import Control.Concurrent (threadDelay) +#if MIN_VERSION_directory(1,2,3) +import Data.Time (getCurrentTime) +#endif import Data.Array import qualified Data.ByteString.Char8 as BS @@ -157,7 +161,7 @@ pprTyThing', pprTyThingInContext' :: TyThing -> SDoc #if __GLASGOW_HASKELL__ >= 802 pprTyThing' = pprTyThingHdr -pprTyThingInContext' = pprTyThingInContext showToHeader +pprTyThingInContext' = pprTyThingInContext showToHeader #else pprTyThing' = pprTyThing pprTyThingInContext' = pprTyThingInContext @@ -234,6 +238,8 @@ ("browse!", keepGoing' (browseCmd True), completeModule), ("extensions", keepGoing' extensionsCmd, completeModule), ("cd", keepGoing' changeDirectory, completeFilename), + ("move", keepGoing' moveCommand, completeFilename), + ("sleep", keepGoing' sleepCommand, noCompletion), ("cd-ghc", keepGoing' changeDirectoryGHC, completeFilename), ("check", keepGoing' checkModule, completeHomeModule), ("continue", keepGoing continueCmd, noCompletion), @@ -1104,8 +1110,8 @@ return (case run_result of GHC.ExecComplete _ _ -> True; _ -> False) #else -afterRunStmt :: (SrcSpan -> Bool) -> GHC.RunResult -> GHCi Bool -afterRunStmt _ (GHC.RunException e) = liftIO $ Exception.throwIO e +afterRunStmt :: (SrcSpan -> Bool) -> GHC.RunResult -> GHCi Bool +afterRunStmt _ (GHC.RunException e) = liftIO $ Exception.throwIO e afterRunStmt step_here run_result = do resumes <- GHC.getResumeContext case run_result of @@ -1372,6 +1378,38 @@ doWithArgs :: [String] -> String -> GHCi () doWithArgs args cmd = enqueueCommands ["System.Environment.withArgs " ++ show args ++ " (" ++ cmd ++ ")"] + +-------------------------------------------------------------------------------- +-- :move + +moveCommand :: String -> InputT GHCi () +moveCommand i = + case toArgs i of + Right [from, to] -> liftIO (do moveUpdatingTime from to) + _ -> throwGhcException (CmdLineError "expected :move from to") + +moveUpdatingTime :: FilePath -> FilePath -> IO () +#if MIN_VERSION_directory(1,2,3) +moveUpdatingTime from to = do + renameFile from to + now <- getCurrentTime + setModificationTime to now +#else +moveUpdatingTime from to = do + copyFile from to + removeFile from +#endif + +-------------------------------------------------------------------------------- +-- :sleep + +sleepCommand :: String -> InputT GHCi () +sleepCommand i = + case reads i of + [(n, "")] -> do + liftIO (threadDelay (1000 * 1000 * n)) + pure () + _ -> throwGhcException (CmdLineError "expected :sleep ") () ----------------------------------------------------------------------------- -- :cd diff --git a/src/test/Main.hs b/src/test/Main.hs --- a/src/test/Main.hs +++ b/src/test/Main.hs @@ -9,7 +9,9 @@ import Data.Char import System.IO import System.IO.Temp +import System.FilePath (()) import System.Process +import System.Info (os) import Test.Hspec import Text.Regex @@ -66,8 +68,16 @@ (do reply <- withIntero [] (\_ repl -> repl ":i Nothing") shouldBe (subRegex (mkRegex "Data.Maybe") reply "GHC.Base") - "data Maybe a = Nothing | ... \t-- Defined in ‘GHC.Base’\n") + ("data Maybe a = Nothing | ... \t-- Defined in " ++ (quote "GHC.Base") ++ "\n")) it ":k Just" (eval ":k Maybe" "Maybe :: * -> *\n")) + where + quote s = opQuote : s ++ [clQuote] + opQuote = case os of + "mingw32" -> '`' + _ -> '‘' + clQuote = case os of + "mingw32" -> '\'' + _ -> '’' -- | Loading files and seeing the results. load :: Spec @@ -334,7 +344,7 @@ (locAtMultiple [("X.hs", "import Y"), ("Y.hs", "module Y where")] (1, 8, 1, 9, "Y") - (unlines ["./Y.hs:(1,8)-(1,9)"])) + (unlines ["." "Y.hs:(1,8)-(1,9)"])) issue "To unexported thing" "https://github.com/commercialhaskell/intero/issues/98"