intero 0.1.30 → 0.1.31
raw patch · 4 files changed
+139/−67 lines, 4 files
Files
- CHANGELOG +3/−0
- elisp/intero.el +102/−65
- intero.cabal +1/−1
- src/GhciInfo.hs +33/−1
CHANGELOG view
@@ -1,3 +1,6 @@+0.1.31:+ * Collecting type info no longer prints messages+ 0.1.29: * Support GHC 8.4
elisp/intero.el view
@@ -74,7 +74,7 @@ ;; Until <https://github.com/haskell/network/issues/313> is fixed: (windows-nt "0.1.28") (cygwin "0.1.28")- (t "0.1.29"))+ (t "0.1.30")) "Package version to auto-install. This version does not necessarily have to be the latest version@@ -286,6 +286,12 @@ (defvar-local intero-targets (list) "Targets used for the stack process.") +(defvar-local intero-repl-last-loaded nil+ "Last loaded module in the REPL.")++(defvar-local intero-repl-send-after-load nil+ "Send a command after every load.")+ (defvar-local intero-start-time nil "Start time of the stack process.") @@ -330,10 +336,6 @@ (defvar-local intero-ghc-version nil "GHC version used by the project.") -(defvar-local intero-repl-last-loaded- nil- "The last loaded thing with `intero-repl-load`.")- (defvar-local intero-buffer-host nil "The hostname of the box hosting the intero process for the current buffer.") @@ -550,7 +552,7 @@ (intero-with-dump-splices (let* ((output (intero-blocking-call 'backend- (concat ":load " (intero-localize-path (intero-temp-file-name)))))+ (concat ":load " (intero-path-for-ghci (intero-temp-file-name))))) (msgs (intero-parse-errors-warnings-splices nil (current-buffer) output)) (line (line-number-at-pos)) (column (if (save-excursion@@ -703,22 +705,13 @@ 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))))+ (staging-file (intero-path-for-ghci (intero-staging-file-name)))+ (temp-file (intero-path-for-ghci (intero-temp-file-name)))) ;; 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\""- ;; TODO: This is a temporary fix. I don't want to use- ;; %S as that may escape things that Haskell doesn't- ;; consider escapable; Intero's function reads with- ;; 'read' (not my implementation!). Instead, I should- ;; implement an alternative reading function for Intero- ;; which would consume only "strings" and treat any- ;; non-double-quote characters as-is.- (replace-regexp-in-string "\\\\" "\\\\\\\\" staging-file)- (replace-regexp-in-string "\\\\" "\\\\\\\\" temp-file)))+ (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@@ -1113,8 +1106,8 @@ (intero-async-call 'backend (format- ":fill %S %d %d"- (intero-localize-path (intero-temp-file-name))+ ":fill %s %d %d"+ (intero-path-for-ghci (intero-temp-file-name)) (save-excursion (goto-char beg) (line-number-at-pos)) (save-excursion (goto-char beg)@@ -1249,17 +1242,44 @@ (when intero-pop-to-repl (pop-to-buffer ,repl-buffer))))) +(defun intero-repl-after-load ()+ "Set the command to run after load."+ (interactive)+ (if (eq major-mode 'intero-repl-mode)+ (setq intero-repl-send-after-load+ (read-from-minibuffer+ "Command to run: "+ (or intero-repl-send-after-load+ (car (ring-elements comint-input-ring))+ "")))+ (error "Run this in the REPL.")))+ (defun intero-repl-load (&optional prompt-options) "Load the current file in the REPL. If PROMPT-OPTIONS is non-nil, prompt with an options list." (interactive "P") (save-buffer)- (let ((file (intero-localize-path (intero-buffer-file-name))))+ (let ((file (intero-path-for-ghci (intero-buffer-file-name)))) (intero-with-repl-buffer prompt-options (comint-simple-send- (get-buffer-process (current-buffer))- (concat ":load " file))- (setq intero-repl-last-loaded file))))+ (get-buffer-process (current-buffer))+ ":set prompt \"\\n\"")+ (if (or (not intero-repl-last-loaded)+ (not (equal file intero-repl-last-loaded)))+ (progn+ (comint-simple-send+ (get-buffer-process (current-buffer))+ (concat ":load " file))+ (setq intero-repl-last-loaded file))+ (comint-simple-send+ (get-buffer-process (current-buffer))+ ":reload"))+ (when intero-repl-send-after-load+ (comint-simple-send+ (get-buffer-process (current-buffer))+ intero-repl-send-after-load))+ (comint-simple-send (get-buffer-process (current-buffer))+ ":set prompt \"\\4 \"")))) (defun intero-repl-eval-region (begin end &optional prompt-options) "Evaluate the code in region from BEGIN to END in the REPL.@@ -1360,8 +1380,8 @@ STACK-YAML is the stack yaml config to use. When nil, tries to use project-wide intero-stack-yaml when nil, otherwise uses stack's default)."- (setq intero-repl-last-loaded nil) (setq intero-targets targets)+ (setq intero-repl-last-loaded nil) (when stack-yaml (setq intero-stack-yaml stack-yaml)) (when prompt-options@@ -1727,6 +1747,14 @@ (insert contents)) fname))) +(defun intero-quote-path-for-ghci (path)+ "Quote PATH as necessary so that it can be passed to a GHCi :command."+ (concat "\"" (replace-regexp-in-string "\\([\\\"]\\)" "\\\\\\1" path nil nil) "\""))++(defun intero-path-for-ghci (path)+ "Turn a possibly-remote PATH into one that can be passed to a GHCi :command."+ (intero-quote-path-for-ghci (intero-localize-path path)))+ (defun intero-localize-path (path) "Turn a possibly-remote PATH to a purely local one. This is used to create paths which a remote intero process can load."@@ -1801,8 +1829,8 @@ (defun intero-format-get-type-at (beg end) "Compose a request for getting types in region from BEG to END."- (format ":type-at %S %d %d %d %d %S"- (intero-localize-path (intero-temp-file-name))+ (format ":type-at %s %d %d %d %d %S"+ (intero-path-for-ghci (intero-temp-file-name)) (save-excursion (goto-char beg) (line-number-at-pos)) (save-excursion (goto-char beg)@@ -1832,7 +1860,7 @@ (unless (member 'save flycheck-check-syntax-automatically) (intero-async-call 'backend- (concat ":load " (intero-localize-path (intero-temp-file-name)))))+ (concat ":load " (intero-path-for-ghci (intero-temp-file-name))))) (intero-async-call 'backend ":set -fobject-code")@@ -1861,8 +1889,8 @@ "\n$" "" (intero-blocking-network-call 'backend- (format ":loc-at %S %d %d %d %d %S"- (intero-localize-path (intero-temp-file-name))+ (format ":loc-at %s %d %d %d %d %S"+ (intero-path-for-ghci (intero-temp-file-name)) (save-excursion (goto-char beg) (line-number-at-pos)) (save-excursion (goto-char beg)@@ -1879,8 +1907,8 @@ "\n$" "" (intero-blocking-call 'backend- (format ":loc-at %S %d %d %d %d %S"- (intero-localize-path (intero-temp-file-name))+ (format ":loc-at %s %d %d %d %d %S"+ (intero-path-for-ghci (intero-temp-file-name)) (save-excursion (goto-char beg) (line-number-at-pos)) (save-excursion (goto-char beg)@@ -1907,8 +1935,8 @@ "\n$" "" (intero-blocking-network-call 'backend- (format ":uses %S %d %d %d %d %S"- (intero-localize-path (intero-temp-file-name))+ (format ":uses %s %d %d %d %d %S"+ (intero-path-for-ghci (intero-temp-file-name)) (save-excursion (goto-char beg) (line-number-at-pos)) (save-excursion (goto-char beg)@@ -1925,8 +1953,8 @@ "\n$" "" (intero-blocking-call 'backend- (format ":uses %S %d %d %d %d %S"- (intero-localize-path (intero-temp-file-name))+ (format ":uses %s %d %d %d %d %S"+ (intero-path-for-ghci (intero-temp-file-name)) (save-excursion (goto-char beg) (line-number-at-pos)) (save-excursion (goto-char beg)@@ -1943,8 +1971,8 @@ passed to CONT in SOURCE-BUFFER." (intero-async-network-call 'backend- (format ":complete-at %S %d %d %d %d %S"- (intero-localize-path (intero-temp-file-name))+ (format ":complete-at %s %d %d %d %d %S"+ (intero-path-for-ghci (intero-temp-file-name)) (save-excursion (goto-char beg) (line-number-at-pos)) (save-excursion (goto-char beg)@@ -2077,34 +2105,41 @@ (error "Intero process is not running: run M-x intero-restart to start it")))) (defun intero-network-call-sentinel (process event)- (with-current-buffer (process-buffer process)- (if (string= "open\n" event)- (progn- (when intero-debug (message "Connected to service, sending %S" intero-async-network-cmd))- (setq intero-async-network-connected t)- (if intero-async-network-cmd- (process-send-string process (concat intero-async-network-cmd "\n"))- (delete-process process)))- (progn- (if intero-async-network-connected- (when intero-async-network-callback- (when intero-debug (message "Calling callback with %S" (buffer-string)))- (funcall intero-async-network-callback- intero-async-network-state- (buffer-string)))- ;; We didn't successfully connect, so let's fallback to the- ;; process pipe.- (when intero-async-network-callback- (when intero-debug (message "Failed to connect, falling back ... "))- (setq intero-async-network-callback nil)- (intero-async-call- intero-async-network-worker- intero-async-network-cmd- intero-async-network-state- intero-async-network-callback)))- ;; In any case we clean up the connection.- (delete-process process)))))+ (pcase event+ ;; This event sometimes gets sent when (delete-process) is called, but+ ;; inconsistently. We can't rely on it for killing buffers, but we need to+ ;; handle the possibility.+ ("deleted\n") + ("open\n"+ (with-current-buffer (process-buffer process)+ (when intero-debug (message "Connected to service, sending %S" intero-async-network-cmd))+ (setq intero-async-network-connected t)+ (if intero-async-network-cmd+ (process-send-string process (concat intero-async-network-cmd "\n"))+ (delete-process process)+ (kill-buffer (process-buffer process)))))+ (_+ (with-current-buffer (process-buffer process)+ (if intero-async-network-connected+ (when intero-async-network-callback+ (when intero-debug (message "Calling callback with %S" (buffer-string)))+ (funcall intero-async-network-callback+ intero-async-network-state+ (buffer-string)))+ ;; We didn't successfully connect, so let's fallback to the+ ;; process pipe.+ (when intero-async-network-callback+ (when intero-debug (message "Failed to connect, falling back ... "))+ (setq intero-async-network-callback nil)+ (intero-async-call+ intero-async-network-worker+ intero-async-network-cmd+ intero-async-network-state+ intero-async-network-callback))))+ (delete-process process)+ (kill-buffer (process-buffer process)))))+ (defun intero-async-call (worker cmd &optional state callback) "Send WORKER the command string CMD. The result, along with the given STATE, is passed to CALLBACK@@ -3220,6 +3255,8 @@ (forward-line (1- (plist-get suggestion :line))) (move-to-column (- (plist-get suggestion :column) 1)) (search-forward "{")+ (unless (looking-at "}")+ (save-excursion (insert ", "))) (insert (mapconcat (lambda (field) (concat field " = _")) (plist-get suggestion :fields) ", "))))))
intero.cabal view
@@ -1,7 +1,7 @@ name: intero version:- 0.1.30+ 0.1.31 synopsis: Complete interactive development program for Haskell license:
src/GhciInfo.hs view
@@ -19,9 +19,11 @@ import Data.Time import DataCon import Desugar+import DynFlags import GHC import GhcMonad import GhciTypes+import HscTypes import Intero.Compat import Outputable import Prelude hiding (mod)@@ -82,12 +84,42 @@ do m <- getModSummary name p <- parseModule m let location = getModuleLocation (parsedSource p)- typechecked <- typecheckModule p+ typechecked <- typecheckModuleSilent p let Just (_, imports, _, _) = renamedSource typechecked allTypes <- processAllTypeCheckedModule typechecked let i = tm_checked_module_info typechecked now <- liftIO getCurrentTime return (ModInfo m allTypes i now imports location)++-- | Type-check the module without logging messages.+typecheckModuleSilent :: GhcMonad m => ParsedModule -> m TypecheckedModule+#if MIN_VERSION_ghc(8,0,1)+typecheckModuleSilent parsed = do+ typecheckModule+ parsed+ { GHC.pm_mod_summary =+ (GHC.pm_mod_summary parsed)+ { HscTypes.ms_hspp_opts =+ (HscTypes.ms_hspp_opts (GHC.pm_mod_summary parsed))+ {log_action = nullLogAction}+ }+ }+ where+ nullLogAction _df _reason _sev _span _style _msgdoc = pure ()+#else+typecheckModuleSilent parsed = do+ typecheckModule+ parsed+ { GHC.pm_mod_summary =+ (GHC.pm_mod_summary parsed)+ { HscTypes.ms_hspp_opts =+ (HscTypes.ms_hspp_opts (GHC.pm_mod_summary parsed))+ {log_action = nullLogAction}+ }+ }+ where+ nullLogAction _df _reason _sev _span _style = pure ()+#endif getModuleLocation :: ParsedSource -> SrcSpan getModuleLocation pSource = case hsmodName (unLoc pSource) of