intero 0.1.19 → 0.1.20
raw patch · 6 files changed
+366/−86 lines, 6 filesdep ~ghc
Dependency ranges changed: ghc
Files
- CHANGELOG +3/−0
- README.md +26/−0
- elisp/intero.el +305/−73
- intero.cabal +3/−2
- src/GhciFind.hs +12/−6
- src/test/Main.hs +17/−5
CHANGELOG view
@@ -1,3 +1,6 @@+0.1.20:+ * More robust name finding, fixes bug https://github.com/commercialhaskell/intero/issues/98+ 0.1.19: * Support completion of qualified identifiers
README.md view
@@ -20,6 +20,32 @@ `C-c C-k` | Clear REPL `C-c C-z` | Switch to and from the REPL +## Whitelisting/blacklisting projects++Typically Intero will enable for all projects, and for files+without a stack.yaml, it will assume the "global" project. Some users+prefer to enable Intero selectively. See below how to do that.++Find this line in your Emacs configuration and remove it:++``` lisp+(add-hook 'haskell-mode-hook 'intero-mode)+```++To whitelist specific directories (and ignore everything else), use:++``` lisp+(setq intero-whitelist '("/work/directories/" "/my/directories/"))+(add-hook 'haskell-mode-hook 'intero-mode-whitelist)+```++To blacklist specific directories (and allow everything else), use:++``` lisp+(setq intero-blacklist '("/path/to/bad/project" "/path/to/ignore/me"))+(add-hook 'haskell-mode-hook 'intero-mode-blacklist)+```+ ## Intero for IDE writers Please see
elisp/intero.el view
@@ -1,7 +1,9 @@ ;;; intero.el --- Complete development mode for Haskell ;; Copyright (c) 2016 Chris Done+;; Copyright (C) 2016 Артур Файзрахманов ;; Copyright (c) 2015 Athur Fayzrakhmanov+;; Copyright (C) 2015 Gracjan Polak ;; Copyright (c) 2013 Herbert Valerio Riedel ;; Copyright (c) 2007 Stefan Monnier @@ -66,7 +68,7 @@ :group 'haskell) (defcustom intero-package-version- "0.1.18"+ "0.1.20" "Package version to auto-install. This version does not necessarily have to be the latest version@@ -99,6 +101,28 @@ :group 'intero :type 'boolean) +(defcustom intero-whitelist+ nil+ "Projects to whitelist.++It should be a list of directories.++To use this, use the following mode hook:+ (add-hook 'haskell-mode-hook 'intero-mode-whitelist)"+ :group 'intero+ :type 'string)++(defcustom intero-blacklist+ nil+ "Projects to blacklist.++It should be a list of directories.++To use this, use the following mode hook:+ (add-hook 'haskell-mode-hook 'intero-mode-blacklist)"+ :group 'intero+ :type 'string)+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Modes @@ -127,6 +151,24 @@ (setq-local eldoc-documentation-function 'eldoc-intero)) (message "Intero mode disabled."))) +(defun intero-mode-whitelist ()+ "Run intero-mode when the current project is in `intero-whitelist'."+ (interactive)+ (let ((file (buffer-file-name)))+ (when (cl-remove-if-not (lambda (directory)+ (file-in-directory-p file directory))+ intero-whitelist)+ (intero-mode))))++(defun intero-mode-blacklist ()+ "Run intero-mode unless the current project is in `intero-blacklist'."+ (interactive)+ (let ((file (buffer-file-name)))+ (unless (cl-remove-if-not (lambda (directory)+ (file-in-directory-p file directory))+ intero-blacklist)+ (intero-mode))))+ (define-key intero-mode-map (kbd "C-c C-t") 'intero-type-at) (define-key intero-mode-map (kbd "C-c C-i") 'intero-info) (define-key intero-mode-map (kbd "M-.") 'intero-goto-definition)@@ -203,9 +245,19 @@ (defvar 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`.")+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Interactive commands +(defun intero-add-package (package)+ "Add a package dependency to the currently running project backend."+ (interactive "sPackage: ")+ (intero-blocking-call 'backend (concat ":set -package " package))+ (flycheck-buffer))+ (defun intero-toggle-debug () "Toggle debugging mode on/off." (interactive)@@ -240,7 +292,9 @@ "Return a haskell-fontified version of EXPRESSION." (with-temp-buffer (when (fboundp 'haskell-mode)- (haskell-mode))+ (let ((flycheck-checkers nil)+ (haskell-mode-hook nil))+ (haskell-mode))) (insert expression) (if (fboundp 'font-lock-ensure) (font-lock-ensure)@@ -286,7 +340,8 @@ (goto-char (point-min)))))))) (defun intero-goto-definition ()- "Jump to the definition of the thing at point."+ "Jump to the definition of the thing at point.+Returns nil when unable to find definition." (interactive) (let ((result (apply #'intero-get-loc-at (intero-thing-at-point)))) (when (string-match "\\(.*?\\):(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\))$"@@ -303,7 +358,8 @@ (pop-mark) (goto-char (point-min)) (forward-line (1- line))- (forward-char (1- col))))))+ (forward-char (1- col))+ t)))) (defun intero-restart () "Simply restart the process with the same configuration as before."@@ -312,7 +368,8 @@ (let ((targets (with-current-buffer (intero-buffer 'backend) intero-targets))) (intero-destroy 'backend)- (intero-get-worker-create 'backend targets (current-buffer)))))+ (intero-get-worker-create 'backend targets (current-buffer))+ (intero-repl-restart)))) (defun intero-targets () "Set the targets to use for stack ghci."@@ -333,7 +390,8 @@ " " t)))) (intero-destroy)- (intero-get-worker-create 'backend targets (current-buffer))))+ (intero-get-worker-create 'backend targets (current-buffer))+ (intero-repl-restart))) (defun intero-destroy (&optional worker) "Stop WORKER and kill its associated process buffer.@@ -722,20 +780,22 @@ (defun eldoc-intero () "ELDoc backend for intero."- (apply #'intero-get-type-at-async- (lambda (beg end ty)- (let ((response-status (intero-haskell-utils-repl-response-error-status ty)))- (if (eq 'no-error response-status)- (let ((msg (intero-fontify-expression- (replace-regexp-in-string "[ \n]+" " " ty))))- ;; Got an updated type-at-point, cache and print now:- (puthash (list beg end)- msg- eldoc-intero-cache)- (eldoc-intero-maybe-print msg))- ;; But if we're seeing errors, invalidate cache-at-point:- (remhash (list beg end) eldoc-intero-cache))))- (intero-thing-at-point))+ (let ((buffer (intero-buffer 'backend)))+ (when (and buffer (process-live-p (get-buffer-process buffer)))+ (apply #'intero-get-type-at-async+ (lambda (beg end ty)+ (let ((response-status (intero-haskell-utils-repl-response-error-status ty)))+ (if (eq 'no-error response-status)+ (let ((msg (intero-fontify-expression+ (replace-regexp-in-string "[ \n]+" " " ty))))+ ;; Got an updated type-at-point, cache and print now:+ (puthash (list beg end)+ msg+ eldoc-intero-cache)+ (eldoc-intero-maybe-print msg))+ ;; But if we're seeing errors, invalidate cache-at-point:+ (remhash (list beg end) eldoc-intero-cache))))+ (intero-thing-at-point)))) ;; If we have something cached at point, print that first: (gethash (intero-thing-at-point) eldoc-intero-cache)) @@ -769,6 +829,8 @@ 'option-missing) ((string-match-p "^<interactive>:" first-line) 'interactive-error)+ ((string-match-p "^<no location info>:" first-line)+ 'inspection-error) (t 'no-error)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;@@ -796,7 +858,10 @@ (with-current-buffer repl-buffer (comint-simple-send (get-buffer-process (current-buffer))- (concat ":l " file)))+ (if (string= intero-repl-last-loaded file)+ ":r"+ (concat ":l " file)))+ (setq intero-repl-last-loaded file)) (pop-to-buffer repl-buffer))) (defun intero-repl (&optional prompt-options)@@ -805,6 +870,24 @@ (interactive "P") (switch-to-buffer-other-window (intero-repl-buffer prompt-options t))) +(defun intero-repl-restart ()+ "Restart the REPL."+ (interactive)+ (let* ((root (intero-project-root))+ (package-name (intero-package-name))+ (backend-buffer (intero-buffer 'backend))+ (name (format "*intero:%s:%s:repl*"+ (file-name-nondirectory root)+ package-name)))+ (when (get-buffer name)+ (with-current-buffer (get-buffer name)+ (goto-char (point-max))+ (let ((process (get-buffer-process (current-buffer))))+ (when process (kill-process process)))+ (intero-repl-mode-start backend-buffer+ (buffer-local-value 'intero-targets backend-buffer)+ nil)))))+ (defun intero-repl-buffer (prompt-options &optional store-previous) "Start the REPL buffer. If PROMPT-OPTIONS is non-nil, prompt with an options list. When@@ -933,21 +1016,28 @@ (insert (propertize (format "Starting:\n stack ghci %s\n" (combine-and-quote-strings arguments)) 'face 'font-lock-comment-face))- (let ((script (with-current-buffer (find-file-noselect (make-temp-file "intero-script"))- (insert ":set prompt \"\"-:set -fobject-code+ (let* ((script-buffer+ (with-current-buffer (find-file-noselect (intero-make-temp-file "intero-script"))+ (insert ":set prompt \"\"+:set -fbyte-code :set prompt \"\\4 \" ")- (basic-save-buffer)- (intero-buffer-file-name))))- (let ((process (get-buffer-process (apply #'make-comint-in-buffer "intero" (current-buffer) "stack" nil "ghci"- (append arguments- (list "--verbosity" "silent")- (list "--ghci-options"- (concat "-ghci-script=" script)))))))+ (basic-save-buffer)+ (current-buffer)))+ (script+ (with-current-buffer script-buffer+ (intero-buffer-file-name))))+ (let ((process+ (get-buffer-process+ (apply #'make-comint-in-buffer "intero" (current-buffer) "stack" nil "ghci"+ (append arguments+ (list "--verbosity" "silent")+ (list "--ghci-options"+ (concat "-ghci-script=" script))))))) (when (process-live-p process) (set-process-query-on-exit-flag process nil)- (message "Started Intero process for REPL."))))))+ (message "Started Intero process for REPL.")+ (kill-buffer script-buffer)))))) (defun intero-repl-options (backend-buffer) "Open an option menu to set options used when starting the REPL.@@ -1021,44 +1111,134 @@ (buffer-substring-no-properties (car reg) (cdr reg))))) (defun intero-ident-pos-at-point ()- "Return the span of the identifier under point, or nil if none found.-May return a qualified name."- (save-excursion- ;; Skip whitespace if we're on it. That way, if we're at "map ", we'll- ;; see the word "map".- (if (and (not (eobp))- (eq ? (char-syntax (char-after))))- (skip-chars-backward " \t"))-- (let ((case-fold-search nil))- (cl-multiple-value-bind (start end)- (list- (progn (skip-syntax-backward "w_") (point))- (progn (skip-syntax-forward "w_") (point)))- ;; If we're looking at a module ID that qualifies further IDs, add- ;; those IDs.- (goto-char start)- (while (and (looking-at "[[:upper:]]") (eq (char-after end) ?.)- ;; It's a module ID that qualifies further IDs.- (goto-char (1+ end))- (save-excursion- (when (not (zerop (skip-syntax-forward- (if (looking-at "\\s_") "_" "w'"))))- (setq end (point))))))- ;; If we're looking at an ID that's itself qualified by previous- ;; module IDs, add those too.- (goto-char start)- (if (eq (char-after) ?.) (forward-char 1)) ;Special case for "."- (while (and (eq (char-before) ?.)- (progn (forward-char -1)- (not (zerop (skip-syntax-backward "w'"))))- (skip-syntax-forward "'")- (looking-at "[[:upper:]]"))- (setq start (point)))- ;; This is it.- (unless (= start end)+ "Return the span of the identifier near point going backward.+Returns nil if no identifier found or point is inside string or+comment. May return a qualified name."+ (when (not (nth 8 (syntax-ppss)))+ ;; Do not handle comments and strings+ (let (start end)+ ;; Initial point position is non-deterministic, it may occur anywhere+ ;; inside identifier span, so the approach is:+ ;; - first try go left and find left boundary+ ;; - then try go right and find right boundary+ ;;+ ;; In both cases assume the longest path, e.g. when going left take into+ ;; account than point may occur at the end of identifier, when going right+ ;; take into account that point may occur at the beginning of identifier.+ ;;+ ;; We should handle `.` character very careful because it is heavily+ ;; overloaded. Examples of possible cases:+ ;; Control.Monad.>>= -- delimiter+ ;; Control.Monad.when -- delimiter+ ;; Data.Aeson..: -- delimiter and operator symbol+ ;; concat.map -- composition function+ ;; .? -- operator symbol+ (save-excursion+ ;; First, skip whitespace if we're on it, moving point to last+ ;; identifier char. That way, if we're at "map ", we'll see the word+ ;; "map".+ (when (and (looking-at (rx eol))+ (not (bolp)))+ (backward-char))+ (when (and (not (eobp))+ (eq (char-syntax (char-after)) ? ))+ (skip-chars-backward " \t")+ (backward-char))+ ;; Now let's try to go left.+ (save-excursion+ (if (not (intero-mode--looking-at-varsym))+ ;; Looking at non-operator char, this is quite simple+ (progn+ (skip-syntax-backward "w_")+ ;; Remember position+ (setq start (point)))+ ;; Looking at operator char.+ (while (and (not (bobp))+ (intero-mode--looking-at-varsym))+ ;; skip all operator chars backward+ (setq start (point))+ (backward-char))+ ;; Extra check for case when reached beginning of the buffer.+ (when (intero-mode--looking-at-varsym)+ (setq start (point))))+ ;; Slurp qualification part if present. If identifier is qualified in+ ;; case of non-operator point will stop before `.` dot, but in case of+ ;; operator it will stand at `.` delimiting dot. So if we're looking+ ;; at `.` let's step one char forward and try to get qualification+ ;; part.+ (goto-char start)+ (when (looking-at-p (rx "."))+ (forward-char))+ (let ((pos (intero-mode--skip-qualification-backward)))+ (when pos+ (setq start pos))))+ ;; Finally, let's try to go right.+ (save-excursion+ ;; Try to slurp qualification part first.+ (skip-syntax-forward "w_")+ (setq end (point))+ (while (and (looking-at (rx "." upper))+ (not (zerop (progn (forward-char)+ (skip-syntax-forward "w_")))))+ (setq end (point)))+ ;; If point was at non-operator we already done, otherwise we need an+ ;; extra check.+ (while (intero-mode--looking-at-varsym)+ (forward-char)+ (setq end (point))))+ (when (not (= start end)) (cons start end)))))) +(defun intero-mode--looking-at-varsym ()+ "Return t when point stands at operator symbol."+ (when (not (eobp))+ (let ((lex (intero-lexeme-classify-by-first-char (char-after))))+ (or (eq lex 'varsym)+ (eq lex 'consym)))))++(defun intero-mode--skip-qualification-backward ()+ "Skip qualified part of identifier backward.+Expects point stands *after* delimiting dot.+Returns beginning position of qualified part or nil if no qualified part found."+ (when (not (and (bobp)+ (looking-at (rx bol))))+ (let ((case-fold-search nil)+ pos)+ (while (and (eq (char-before) ?.)+ (progn (backward-char)+ (not (zerop (skip-syntax-backward "w'"))))+ (skip-syntax-forward "'")+ (looking-at "[[:upper:]]"))+ (setq pos (point)))+ pos)))++(defun intero-lexeme-classify-by-first-char (char)+ "Classify token by CHAR.+CHAR is a chararacter that is assumed to be the first character+of a token."+ (let ((category (get-char-code-property char 'general-category)))++ (cond+ ((or (member char '(?! ?# ?$ ?% ?& ?* ?+ ?. ?/ ?< ?= ?> ?? ?@ ?^ ?| ?~ ?\\ ?-))+ (and (> char 127)+ (member category '(Pc Pd Po Sm Sc Sk So))))+ 'varsym)+ ((equal char ?:)+ 'consym)+ ((equal char ?\')+ 'char)+ ((equal char ?\")+ 'string)+ ((member category '(Lu Lt))+ 'conid)+ ((or (equal char ?_)+ (member category '(Ll Lo)))+ 'varid)+ ((and (>= char ?0) (<= char ?9))+ 'number)+ ((member char '(?\] ?\[ ?\( ?\) ?\{ ?\} ?\` ?\, ?\;))+ 'special))))+ (defun intero-buffer-file-name (&optional buffer) "Call function `buffer-file-name' for BUFFER and clean its result. The path returned is canonicalized and stripped of any text properties."@@ -1069,13 +1249,30 @@ (defvar-local intero-temp-file-name nil "The name of a temporary file to which the current buffer's content is copied.") +(defun intero-make-temp-file (prefix &optional dir-flag suffix)+ "Like `make-temp-file', but using a different temp directory.+PREFIX, DIR-FLAG and SUFFIX are all passed to `make-temp-file'+unmodified. A different directory is applied so that if docker+is used with stack, the commands run inside docker can find the+path."+ (let ((temporary-file-directory+ (expand-file-name ".stack-work/intero/"+ (intero-project-root))))+ (make-directory temporary-file-directory t)+ (make-temp-file prefix dir-flag suffix)))+ (defun intero-temp-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 (setq intero-temp-file-name- (intero-canonicalize-path (make-temp-file "intero" nil ".hs"))))+ (intero-canonicalize-path+ (intero-make-temp-file+ "intero" nil+ (concat "." (if (buffer-file-name)+ (file-name-extension (buffer-file-name))+ "hs")))))) (let ((contents (buffer-string))) (with-temp-file intero-temp-file-name (insert contents))))))@@ -1466,7 +1663,7 @@ (list "--no-build")) (when no-load (list "--no-load"))- (let ((dir (make-temp-file "intero" t)))+ (let ((dir (intero-make-temp-file "intero" t))) (list "--ghci-options" (concat "-odir=" dir) "--ghci-options"@@ -1534,6 +1731,9 @@ It may be obvious if there is some text above this message indicating a problem. +If you do not wish to use Intero for some projects, see+https://github.com/commercialhaskell/intero#whitelistingblacklisting-projects+ The process ended. Here is the reason that Emacs gives us: "@@ -1578,7 +1778,7 @@ (setq repeat t)) (when intero-debug (intero--warn "Received output but no callback in `intero-callbacks': %S"- string)))))+ string))))) (delete-region (point-min) (point)))))) (defun strip-carriage-returns (string)@@ -1645,7 +1845,14 @@ This can be caused by a syntax error in your stack.yaml file. Check that out. -Otherwise, please report this as a bug!")+If you do not wish to use Intero for some projects, see+https://github.com/commercialhaskell/intero#whitelistingblacklisting-projects++Otherwise, please report this as a bug!++For debugging purposes, try running the following in your terminal:++stack path --project-root") nil)))))) (defun intero-ghc-version ()@@ -1665,7 +1872,10 @@ (with-temp-buffer (cl-case (call-process "stack" nil (current-buffer) t "ide" "targets") (0- (split-string (buffer-string) nil t))+ (cl-remove-if-not+ (lambda (line)+ (string-match "^[A-Za-z0-9-:]+$" line))+ (split-string (buffer-string) "[\r\n]" t))) (1 nil)))) (defun intero-package-name (&optional cabal-file)@@ -1916,6 +2126,18 @@ (setq start (min (length text) (1+ (match-end 0)))))) ;; Messages of this format: ;;+ ;; Could not find module ‘Language.Haskell.TH’+ ;; It is a member of the hidden package ‘template-haskell’.+ ;; Use -v to see a list of the files searched for....+ (let ((start 0))+ (while (string-match "It is a member of the hidden package [‘`‛]\\([^ ]+\\)['’]" text start)+ (setq note t)+ (add-to-list 'intero-suggestions+ (list :type 'add-package+ :package (match-string 1 text)))+ (setq start (min (length text) (1+ (match-end 0))))))+ ;; Messages of this format:+ ;; ;; Defaulting the following constraint(s) to type ‘Integer’ ;; (Num a0) arising from the literal ‘1’ ;; In the expression: 2@@ -2092,6 +2314,10 @@ (plist-get suggestion :option) " #-}") :default t))+ (add-package+ (list :key suggestion+ :title (concat "Enable package: " (plist-get suggestion :package))+ :default t)) (remove-import (list :key suggestion :title (concat "Remove: import "@@ -2131,6 +2357,12 @@ (or (> lt-line gt-line) (and (= lt-line gt-line) (> lt-column gt-column))))))))+ ;; # Changes unrelated to the buffer+ (cl-loop+ for suggestion in sorted+ do (cl-case (plist-get suggestion :type)+ (add-package+ (intero-add-package (plist-get suggestion :package))))) ;; # Changes that do not increase/decrease line numbers ;; ;; Update in-place suggestions
intero.cabal view
@@ -1,7 +1,7 @@ name: intero version:- 0.1.19+ 0.1.20 synopsis: Complete interactive development program for Haskell license:@@ -69,7 +69,8 @@ bytestring, directory, filepath,- ghc >= 7.8 && <= 8.0.1,+ -- We permit any 8.0.1.*+ ghc >= 7.8 && < 8.0.2, ghc-paths, haskeline, process,
src/GhciFind.hs view
@@ -289,16 +289,22 @@ #endif showppr d modL))) Just info ->- case find (matchName name)+ case find (reliableNameEquality name) (modInfoExports (modinfoInfo info)) of Just name' -> return (Right name') Nothing ->- return (Left "No matching export in any local modules.")- where matchName :: Name -> Name -> Bool- matchName x y =- occNameString (getOccName x) ==- occNameString (getOccName y)+ case find (reliableNameEquality name)+ (fromMaybe [] (modInfoTopLevelScope (modinfoInfo info))) of+ Just name' ->+ return (Right name')+ Nothing -> do+ result <- lookupGlobalName name+ case result of+ Nothing ->+ return (Left ("No matching export in any local modules: " ++ showppr d name))+ Just tyThing ->+ return (Right (getName tyThing)) -- | Try to resolve the type display from the given span. resolveName :: [SpanInfo] -> Int -> Int -> Int -> Int -> Maybe Var
src/test/Main.hs view
@@ -296,26 +296,38 @@ describe "Definition location" (do it- ":loc-at X.hs 1 1 1 1 x -- from definition site"+ "From definition site" (locAt "x = 'a' : x" (1, 1, 1, 1, "x") (unlines ["X.hs:(1,1)-(1,2)"])) it- ":loc-at X.hs 1 11 1 12 x -- from use site"+ "From use site" (locAt "x = 'a' : x" (1, 11, 1, 12, "x") (unlines ["X.hs:(1,1)-(1,12)"])) it- ":loc-at X.hs 1 11 1 12 x -- to function argument"+ "To function argument" (locAt "f x = 'a' : x" (1, 13, 1, 14, "x") (unlines ["X.hs:(1,3)-(1,4)"])) it- ":loc-at X.hs 1 11 1 12 x -- to pattern match"+ "To pattern match" (locAt "f (Just x) = 'a' : x" (1, 20, 1, 21, "x")- (unlines ["X.hs:(1,9)-(1,10)"])))+ (unlines ["X.hs:(1,9)-(1,10)"]))+ issue+ "To unexported thing"+ "https://github.com/commercialhaskell/intero/issues/98"+ (locAt+ (unlines+ [ "module X () where"+ , "data MyType = MyCons"+ , "t :: MyType"+ , "t = MyCons :: MyType"+ ])+ (3, 6, 3, 12, "MyType")+ (unlines ["X.hs:(2,1)-(2,21)"]))) -- | Test interactive completions. completion :: Spec