intero 0.1.23 → 0.1.24
raw patch · 3 files changed
+106/−108 lines, 3 filesdep ~ghc
Dependency ranges changed: ghc
Files
- elisp/intero.el +85/−103
- intero.cabal +2/−2
- src/test/Main.hs +19/−3
elisp/intero.el view
@@ -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 <file>:<line>:<char>: betwen BEGIN and END."- (when (> end begin)- (let ((end-marker (copy-marker end))- ;; match - /path/to/file.ext:<line>:<char>:- ;; - /path/to/file.ext:<line>:<char>-- ;; - /path/to/file.ext:(<line>:<char>)- (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 <file>:<line>:<char>: 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...).
intero.cabal view
@@ -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,
src/test/Main.hs view
@@ -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