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.23" + "0.1.24" "Package version to auto-install. This version does not necessarily have to be the latest version @@ -129,6 +129,12 @@ :group 'intero :type 'string) +(defcustom intero-pop-to-repl + t + "When non-nil, pop to REPL when code is sent to it." + :group 'intero + :type 'boolean) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Modes @@ -196,9 +202,10 @@ (defun intero-directories-contain-file (file dirs) "Return non-nil if FILE is contained in at least one of DIRS." - (cl-some (lambda (directory) - (file-in-directory-p file directory)) - dirs)) + (and (not (null file)) + (cl-some (lambda (directory) + (file-in-directory-p file directory)) + dirs))) (defun intero-mode-maybe () "Enable `intero-mode' in all Haskell mode buffers. @@ -531,10 +538,10 @@ "Simply restart the process with the same configuration as before." (interactive) (when (intero-buffer-p 'backend) - (let ((targets (with-current-buffer (intero-buffer 'backend) - intero-targets)) - (stack-yaml (with-current-buffer (intero-buffer 'backend) - intero-stack-yaml))) + (let ((targets (buffer-local-value 'intero-targets + (intero-buffer 'backend))) + (stack-yaml (buffer-local-value 'intero-stack-yaml + (intero-buffer 'backend)))) (intero-destroy 'backend) (intero-get-worker-create 'backend targets (current-buffer) stack-yaml) (intero-repl-restart)))) @@ -542,8 +549,7 @@ (defun intero-read-targets () "Read a list of stack targets." (let ((old-targets - (with-current-buffer (intero-buffer 'backend) - intero-targets)) + (buffer-local-value 'intero-targets (intero-buffer 'backend))) (available-targets (intero-get-targets))) (if available-targets (intero-multiswitch @@ -665,8 +671,15 @@ (intero-async-call 'backend (format ":move \"%s\" \"%s\"" - staging-file - temp-file)) + ;; 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))) ;; We load up the target temp file, which has only been updated ;; by the copy above. (intero-async-call @@ -719,7 +732,8 @@ (insert string) (goto-char (point-min)) (let ((messages (list)) - (temp-file (intero-temp-file-name buffer))) + (temp-file (intero-temp-file-name buffer)) + (found-error-as-warning nil)) (while (search-forward-regexp (concat "[\r\n]\\([A-Z]?:?[^ \r\n:][^:\n\r]+\\):\\([0-9()-:]+\\):" "[ \n\r]+\\([[:unibyte:][:nonascii:]]+?\\)\n[^ ]") @@ -727,11 +741,17 @@ (let* ((local-file (intero-canonicalize-path (match-string 1))) (file (intero-extend-path-by-buffer-host local-file buffer)) (location-raw (match-string 2)) - (msg (match-string 3)) ;; Replace gross bullet points. + (msg (replace-regexp-in-string + "[\n\r ]*|$" + "" + (match-string 3))) ;; Replace gross bullet points. (type (cond ((string-match "^Warning:" msg) (setq msg (replace-regexp-in-string "^Warning: *" "" msg)) - (if (string-match "^\\[-Wdeferred-type-errors\\]" msg) - 'error + (if (or (string-match "^\\[-Wdeferred-type-errors\\]" msg) + (string-match "^\\[-Wdeferred-out-of-scope-variables\\]" msg) + (string-match "^\\[-Wtyped-holes\\]" msg)) + (progn (setq found-error-as-warning t) + 'error) 'warning)) ((string-match "^Splicing " msg) 'splice) (t 'error))) @@ -749,7 +769,10 @@ :filename (intero-buffer-file-name buffer)) messages))) (forward-line -1)) - (delete-dups messages)))) + (delete-dups + (if found-error-as-warning + (cl-remove-if (lambda (msg) (eq 'warning (flycheck-error-level msg))) messages) + messages))))) (defconst intero-error-regexp-alist `((,(concat @@ -1103,14 +1126,15 @@ `(let ((,repl-buffer (intero-repl-buffer ,prompt-options t))) (with-current-buffer ,repl-buffer ,@body) - (pop-to-buffer ,repl-buffer)))) + (when intero-pop-to-repl + (pop-to-buffer ,repl-buffer))))) (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-temp-file-name)))) + (let ((file (intero-localize-path (intero-buffer-file-name)))) (intero-with-repl-buffer prompt-options (comint-simple-send (get-buffer-process (current-buffer)) @@ -1198,70 +1222,6 @@ map) "Keymap for clicking on links in REPL.") -(defun intero-find-file-with-line-and-char () - "Jump to the file and location indicated by text properties at point." - (interactive) - (let ((file (get-text-property (point) 'file)) - (line (get-text-property (point) 'line)) - (char (get-text-property (point) 'char))) - (with-no-warnings (find-file-other-window file)) - (goto-char (point-min)) - (forward-line (1- line)) - (forward-char (1- char)))) - -(defun intero-linkify-file-line-char (begin end) - "Linkify all occurences of ::: betwen BEGIN and END." - (when (> end begin) - (let ((end-marker (copy-marker end)) - ;; match - /path/to/file.ext::: - ;; - /path/to/file.ext::- - ;; - /path/to/file.ext:(:) - (file:line:char-regexp "\\([A-Z]?:?[^ \r\n:][^:\n\r]+\\)[:](?\\([0-9]+\\)[:,]\\([0-9]+\\)[:)-]")) - (save-excursion - (goto-char begin) - ;; Delete unrecognized escape sequences. - (while (re-search-forward file:line:char-regexp end-marker t) - (let ((file (match-string-no-properties 1)) - (line (match-string-no-properties 2)) - (char (match-string-no-properties 3)) - (link-start (1+ (match-beginning 1))) - (link-end (1+ (match-end 2)))) - (let ((unmangled-file (intero-unmangle-file-path file))) - (when unmangled-file - (setq file unmangled-file) - (replace-match unmangled-file nil nil nil 1))) - (add-text-properties - link-start link-end - (list 'keymap intero-hyperlink-map - 'file file - 'line (string-to-number line) - 'char (string-to-number char) - 'help-echo "mouse-2: visit this file")))))))) - -(defvar intero-last-output-newline-marker nil) - -(defun intero-linkify-process-output (_) - "Comint filter function to make ::: into clickable links. - -Note that this function uses the `intero-last-output-newline-marker', -to keep track of line breaks. The `intero-linkify-file-line-char' -function is subsequently applied to each line, once." - (unless intero-last-output-newline-marker - (setq-local intero-last-output-newline-marker (make-marker)) - (set-marker intero-last-output-newline-marker (marker-position comint-last-output-start))) - (let ((start-marker (if (and (markerp intero-last-output-newline-marker) - (eq (marker-buffer intero-last-output-newline-marker) - (current-buffer)) - (marker-position intero-last-output-newline-marker)) - comint-last-output-start - (point-min-marker))) - (end-marker (process-mark (get-buffer-process (current-buffer))))) - (save-excursion - (goto-char start-marker) - (while (re-search-forward "[\n\r]" end-marker t) - (intero-linkify-file-line-char intero-last-output-newline-marker (match-beginning 0)) - (set-marker intero-last-output-newline-marker (match-end 0)))))) - (define-derived-mode intero-repl-mode comint-mode "Intero-REPL" "Interactive prompt for Intero." (when (and (not (eq major-mode 'fundamental-mode)) @@ -1269,9 +1229,6 @@ (error "You probably meant to run: M-x intero-repl")) (setq-local comint-prompt-regexp intero-prompt-regexp) (setq-local warning-suppress-types (cons '(undo discard-info) warning-suppress-types)) - (add-hook 'comint-output-filter-functions - 'intero-linkify-process-output - t t) (setq-local comint-prompt-read-only t) (add-hook 'completion-at-point-functions 'intero-completion-at-point nil t) (add-to-list (make-local-variable 'company-backends) 'intero-company) @@ -1311,6 +1268,7 @@ (with-current-buffer (find-file-noselect (intero-make-temp-file "intero-script")) (insert ":set prompt \"\" :set -fbyte-code +:set -fdefer-type-errors :set prompt \"\\4 \" ") (basic-save-buffer) @@ -1876,8 +1834,8 @@ result (lambda (result reply) (setf (car result) reply))) - (with-current-buffer (intero-buffer worker) - (while (not (null intero-callbacks)) + (let ((buffer (intero-buffer worker))) + (while (not (null (buffer-local-value 'intero-callbacks buffer))) (sleep-for 0.0001))) (car result))) @@ -2003,6 +1961,7 @@ arguments)))) (set-process-query-on-exit-flag process nil) (process-send-string process ":set -fobject-code\n") + (process-send-string process ":set -fdefer-type-errors\n") (process-send-string process ":set prompt \"\\4\"\n") (with-current-buffer buffer (erase-buffer) @@ -2165,8 +2124,17 @@ (format " %s %s" intero-stack-executable (combine-and-quote-strings intero-arguments)) + " +It's worth checking that the correct stack executable is being +found on your path, or has been set via +`intero-stack-executable'. The executable being used now is: + + " + (executable-find intero-stack-executable) + " + WHAT TO DO NEXT If you fixed the problem, just kill this buffer, Intero will make @@ -2542,7 +2510,7 @@ This may update in-place the MSGS objects to hint that suggestions are available." (setq intero-suggestions nil) - (let ((extension-regex (regexp-opt (intero-extensions))) + (let ((extension-regex (concat " " (regexp-opt (intero-extensions) t) "\\>")) (quoted-symbol-regex "[‘`‛]\\([^ ]+\\)['’]")) (cl-loop for msg in msgs @@ -2559,7 +2527,7 @@ (setq note t) (add-to-list 'intero-suggestions (list :type 'add-extension - :extension (match-string 0 text))) + :extension (match-string 1 text))) (setq start (min (length text) (1+ (match-end 0)))))) ;; Messages of this format: ;; @@ -2812,7 +2780,10 @@ :title (concat "Add {-# OPTIONS_GHC " (plist-get suggestion :option) " #-}") - :default t)) + :default (not + (string= + (plist-get suggestion :option) + "-fno-warn-name-shadowing")))) (add-package (list :key suggestion :title (concat "Enable package: " (plist-get suggestion :package)) @@ -2883,7 +2854,8 @@ (save-excursion (goto-char (point-min)) (forward-line (1- (plist-get suggestion :line))) - (let* ((start (point)) + (let* ((case-fold-search nil) + (start (search-forward "(" nil t 1)) (end (or (save-excursion (when (search-forward-regexp "\n[^ \t]" nil t 1) (1- (point)))) @@ -2894,23 +2866,26 @@ (mapconcat (lambda (ident) (if (string-match "^[_a-zA-Z]" ident) - (concat "\\<" (regexp-quote ident) "\\>") + (concat "\\<" (regexp-quote ident) "\\> ?" "\\("(regexp-quote "(..)") "\\)?") (concat "(" (regexp-quote ident) ")"))) (plist-get suggestion :idents) "\\|") "\\)")) (string (buffer-substring start end))) (delete-region start end) - (insert (replace-regexp-in-string - "([\n ]*," "(" - (replace-regexp-in-string - "[\n ,]*,[\n ,]*" ", " - (replace-regexp-in-string - ",[\n ]*)" ")" - (replace-regexp-in-string - regex "" - string)))) - (make-string (1- (length (split-string string "\n" t))) 10))))) + (insert + (replace-regexp-in-string + ",[\n ]*)" ")" + (replace-regexp-in-string + "^[\n ,]*" "" + (replace-regexp-in-string + "[\n ,]*,[\n ,]*" ", " + (replace-regexp-in-string + ",[\n ]*)" ")" + (replace-regexp-in-string + regex "" + string))))) + (make-string (1- (length (split-string string "\n" t))) 10))))) (fix-typo (save-excursion (goto-char (point-min)) @@ -2975,15 +2950,22 @@ (add-extension (save-excursion (goto-char (point-min)) + (intero-skip-shebangs) (insert "{-# LANGUAGE " (plist-get suggestion :extension) " #-}\n"))) (add-ghc-option (save-excursion (goto-char (point-min)) + (intero-skip-shebangs) (insert "{-# OPTIONS_GHC " (plist-get suggestion :option) " #-}\n")))))))))) + +(defun intero-skip-shebangs () + "Skip #! and -- shebangs used in Haskell scripts." + (when (looking-at "#!") (forward-line 1)) + (when (looking-at "-- stack ") (forward-line 1))) (defun intero--warn (message &rest args) "Display a warning message made from (format MESSAGE ARGS...). diff --git a/intero.cabal b/intero.cabal --- a/intero.cabal +++ b/intero.cabal @@ -1,7 +1,7 @@ name: intero version: - 0.1.23 + 0.1.24 synopsis: Complete interactive development program for Haskell license: @@ -73,7 +73,7 @@ directory, filepath, -- We permit any 8.0.1.* or 8.0.2.* or 8.2.1 - ghc >= 7.8 && < 8.2.2, + ghc >= 7.8 && <= 8.2.2, ghc-paths, haskeline, process, diff --git a/src/test/Main.hs b/src/test/Main.hs --- a/src/test/Main.hs +++ b/src/test/Main.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Test that various commands work properly. @@ -34,6 +35,7 @@ definition bytecode completion + it "Support GHC 8.2 better" pending -- | Argument parsing should be user-friendly. argsparser :: Spec @@ -253,6 +255,14 @@ , "X.hs:(2,5)-(2,13): String" , "X.hs:(1,5)-(1,8): Integer"]))) +-- | Are we on ghc8_2 or above? +ghc8_2 :: Bool +#if __GLASGOW_HASKELL__ >= 802 +ghc8_2 = True +#else +ghc8_2 = False +#endif + -- | Find uses of a variable. use :: Spec use = @@ -272,7 +282,9 @@ "x = 'a' : x" (1, 11, 1, 12, "x") id - (unlines ["X.hs:(1,1)-(1,2)", "X.hs:(1,11)-(1,12)"])) + (if ghc8_2 + then unlines ["X.hs:(1,1)-(1,2)","X.hs:(1,1)-(1,2)","X.hs:(1,11)-(1,12)"] + else unlines ["X.hs:(1,1)-(1,2)", "X.hs:(1,11)-(1,12)"])) it ":uses X.hs 1 5 1 6 id -- package definition" (uses @@ -311,7 +323,9 @@ (unlines ["data X = X", "foo :: X -> X", "foo x = X"]) (3, 9, 3, 10, "X") lines - ["X.hs:(1,10)-(1,11)", "X.hs:(3,9)-(3,10)"])) + (if ghc8_2 + then ["X.hs:(1,1)-(1,11)"] + else ["X.hs:(1,10)-(1,11)", "X.hs:(3,9)-(3,10)"]))) -- | Find loc-ats of a variable. definition :: Spec @@ -326,7 +340,9 @@ (locAt "x = 'a' : x" (1, 11, 1, 12, "x") - (unlines ["X.hs:(1,1)-(1,12)"])) + (unlines (if ghc8_2 + then ["X.hs:(1,1)-(1,2)"] + else ["X.hs:(1,1)-(1,12)"]))) it "To function argument" (locAt