intero 0.1.21 → 0.1.22
raw patch · 4 files changed
+130/−87 lines, 4 files
Files
- elisp/intero.el +74/−80
- intero.cabal +3/−2
- src/InteractiveUI.hs +41/−3
- src/test/Main.hs +12/−2
elisp/intero.el view
@@ -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 "<backtab>") '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'.")
intero.cabal view
@@ -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
src/InteractiveUI.hs view
@@ -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 <n seconds>") () ----------------------------------------------------------------------------- -- :cd
src/test/Main.hs view
@@ -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"