intero 0.1.13 → 0.1.14
raw patch · 5 files changed
+428/−201 lines, 5 files
Files
- CHANGELOG +3/−0
- README.md +21/−56
- elisp/intero.el +350/−142
- intero.cabal +1/−1
- src/InteractiveUI.hs +53/−2
CHANGELOG view
@@ -1,3 +1,6 @@+0.1.14:+ * Bring back :completion+ 0.1.13: * Fix bug in :type-at returning outer span info (https://github.com/commercialhaskell/intero/issues/47)
README.md view
@@ -1,67 +1,32 @@-# <img src="https://github.com/commercialhaskell/intero/raw/master/images/intero.svg" height=25> intero [](https://travis-ci.org/commercialhaskell/intero)+# <img src="https://github.com/commercialhaskell/intero/raw/master/images/intero.svg" height=25> intero [](https://travis-ci.org/commercialhaskell/intero) <a href="https://melpa.org/#/intero"><img alt="MELPA" src="https://melpa.org/packages/intero-badge.svg"/></a> Complete interactive development program for Haskell -## Supported GHC versions--Intero been built and tested on the following GHC versions:--* GHC 8.0.1-* GHC 7.10.3-* GHC 7.10.2-* GHC 7.8.4--## Features--It's basically GHCi plus extra features. Those are:--* [Find uses of an identifier in a module.](https://github.com/commercialhaskell/intero/blob/28609611c9f7c7d63370ce66e8ebb97676a8374e/src/test/Main.hs#L118)-* [Find definition of an identifier in a module.](https://github.com/commercialhaskell/intero/blob/28609611c9f7c7d63370ce66e8ebb97676a8374e/src/test/Main.hs#L143)-* [Show the type of an expression or identifier](https://github.com/commercialhaskell/intero/blob/28609611c9f7c7d63370ce66e8ebb97676a8374e/src/test/Main.hs#L82).-* [List all types of all expressions of all modules loaded.](https://github.com/commercialhaskell/intero/blob/28609611c9f7c7d63370ce66e8ebb97676a8374e/src/test/Main.hs#L98)-* [Completion of identifiers within a module's scope.](https://github.com/commercialhaskell/intero/blob/bbd71951edb89f06a939910024f85cc44c11c16e/src/test/Main.hs#L242)--Probably more to come.--## Requirements--The following dependencies are necessary:--* The `tinfo` and `ncurses` library.-- * Ubuntu and Debian users can install it using the following- command:-- $ apt-get install libtinfo-dev- $ apt-get install libncurses5-dev--## Installing--Use `stack build` (not `install`) for each of your package sets. Each-LTS or nightly should have a separate `stack build`. **If you use**-`stack install` **you will run into incompatibility issues-between package sets.**--Standard:-- $ stack build intero+## Intero for Emacs -From source:+Please see+[the homepage for Intero for Emacs](http://commercialhaskell.github.io/intero). - $ git clone https://github.com/commercialhaskell/intero.git- $ cd intero- $ stack build intero+#### Default key bindings -## Running+Key binding | Description+--- | ---+`M-.` | Jump to definition+`C-c C-i` | Show information of identifier at point+`C-c C-t` | Show the type of thing at point, or the selection+`C-c C-l` | Load this module in the REPL -To run it plainly use:+## Intero for IDE writers - $ stack exec intero+Please see+[the TOOLING.md file for how to use Intero to integrate your own editor.](https://github.com/commercialhaskell/intero/blob/master/TOOLING.md). -You'll have to run `stack build intero` within each separate LTS-version you use, this ensures that the intero you launch correctly-matches the GHC version that you're working with.+## Issues -To load up your stack project use:+Issues are split into low/medium/high priorities which dictates which+ones will be implemented first. - $ stack ghci --with-ghc intero+* [High priority issues](https://github.com/commercialhaskell/intero/issues?utf8=%E2%9C%93&q=is%3Aissue+is%3Aopen+label%3A%22priority%3A+high%22+)+* [Medium priority issues](https://github.com/commercialhaskell/intero/issues?utf8=%E2%9C%93&q=is%3Aissue+is%3Aopen+label%3A%22priority%3A+medium%22)+* [Low priority issues](https://github.com/commercialhaskell/intero/issues?utf8=%E2%9C%93&q=is%3Aissue+is%3Aopen+label%3A%22priority%3A+low%22)+* [Unprioritized issues](https://github.com/commercialhaskell/intero/issues?utf8=%E2%9C%93&q=is%3Aissue+is%3Aopen+-label%3A%22priority%3A+low%22++-label%3A%22priority%3A+medium%22++-label%3A%22priority%3A+high%22+)
elisp/intero.el view
@@ -5,7 +5,13 @@ ;; Copyright (c) 2013 Herbert Valerio Riedel ;; Copyright (c) 2007 Stefan Monnier -;; Package-Requires: ((flycheck "26") (company "0.9.0"))+;; Author: Chris Done <chrisdone@fpcomplete.com>+;; Maintainer: Chris Done <chrisdone@fpcomplete.com>+;; URL: https://github.com/commercialhaskell/intero+;; Created: 3rd June 2016+;; Version: 0.1.13+;; Keywords: haskell, tools+;; Package-Requires: ((flycheck "0.25") (company "0.8") (emacs "24.3") (haskell-mode "13.0")) ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by@@ -33,7 +39,10 @@ ;; * Info ✓ ;; * REPL ;; * Find uses+;; * Completion of stack targets ;; * List all types in all expressions+;; * Import management+;; * Dependency management ;;; Code: @@ -54,15 +63,24 @@ (defvar intero-mode-map (make-sparse-keymap) "Intero minor mode's map.") -(define-minor-mode intero-mode "Minor mode for Intero"+;;;###autoload+(define-minor-mode intero-mode+ "Minor mode for Intero++\\{intero-mode-map}" :lighter " Intero" :keymap intero-mode-map- (when (buffer-file-name)+ (when (bound-and-true-p interactive-haskell-mode)+ (when (fboundp 'interactive-haskell-mode)+ (message "Disabling interactive-haskell-mode ...")+ (interactive-haskell-mode -1)))+ (when (intero-buffer-file-name) (if intero-mode (progn (flycheck-select-checker 'intero) (flycheck-mode) (add-to-list (make-local-variable 'company-backends) 'company-intero)- (company-mode))+ (company-mode)+ (set (make-local-variable 'eldoc-documentation-function) 'eldoc-intero)) (message "Intero mode disabled.")))) (define-key intero-mode-map (kbd "C-c C-t") 'intero-type-at)@@ -71,6 +89,24 @@ (define-key intero-mode-map (kbd "C-c C-l") 'intero-repl-load) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; Global variables/state++(defvar intero-global-mode nil+ "Global mode is enabled?")++(defun global-intero-mode ()+ "Enable Intero on all Haskell mode buffers."+ (interactive)+ (setq intero-global-mode (not intero-global-mode))+ (if intero-global-mode+ (add-hook 'haskell-mode-hook 'intero-mode)+ (remove-hook 'haskell-mode-hook 'intero-mode))+ (when (eq this-command 'global-intero-mode)+ (message "Intero mode is now %s on all future Haskell buffers."+ (if intero-global-mode+ "enabled" "disabled"))))++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Buffer-local variables/state (defvar intero-callbacks (list)@@ -85,6 +121,10 @@ "Targets used for the stack process.") (make-variable-buffer-local 'intero-targets) +(defvar intero-source-buffer (list)+ "Buffer from which Intero was first requested to start.")+(make-variable-buffer-local 'intero-source-buffer)+ (defvar intero-project-root nil "The project root of the current buffer.") (make-variable-buffer-local 'intero-project-root)@@ -97,6 +137,23 @@ "The process of the buffer is being deleted.") (make-variable-buffer-local 'intero-deleting) +(defvar intero-give-up nil+ "The backend could not start, or could not be+ installed. Abandon trying to automate it. The user will have to+ manually run M-x intero-restart or M-x intero-targets to+ destroy the buffer and create a fresh one without this variable+ enabled.")+(make-variable-buffer-local 'intero-give-up)++(defvar intero-try-with-build nil+ "Try starting intero without --no-build. Slower, but will build+ required dependencies.")+(make-variable-buffer-local 'intero-try-with-build)++(defvar intero-starting nil+ "Is the intero process starting up?")+(make-variable-buffer-local 'intero-starting)+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Interactive commands @@ -167,6 +224,10 @@ (let ((result (apply #'intero-get-loc-at (intero-thing-at-point)))) (when (string-match "\\(.*?\\):(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\))$" result)+ (if (fboundp 'xref-push-marker-stack) ;; Emacs 25+ (xref-push-marker-stack)+ (with-no-warnings+ (ring-insert find-tag-marker-ring (point-marker)))) (let ((file (match-string 1 result)) (line (string-to-number (match-string 2 result))) (col (string-to-number (match-string 3 result))))@@ -245,36 +306,41 @@ (defun intero-check (checker cont) "Run a check and pass the status onto CONT."- (let ((file-buffer (current-buffer)))- (write-region (point-min) (point-max) (buffer-file-name))- (clear-visited-file-modtime)- (intero-async-call- 'backend- (concat ":l " (buffer-file-name))- (list :cont cont- :file-buffer file-buffer- :checker checker)- (lambda (state string)- (with-current-buffer (plist-get state :file-buffer)- (funcall (plist-get state :cont)- 'finished- (intero-parse-errors-warnings- (plist-get state :checker)- (current-buffer)- string))- (when (string-match "OK, modules loaded: \\(.*\\)\\.$" string)- (let ((modules (match-string 1 string)))- (intero-async-call 'backend- (concat ":m + "- (replace-regexp-in-string modules "," ""))- nil- (lambda (_st _))))))))))+ (if (intero-gave-up 'backend)+ (run-with-timer 0+ nil+ cont+ 'interrupted)+ (let ((file-buffer (current-buffer)))+ (write-region (point-min) (point-max) (intero-buffer-file-name) nil 'no-message)+ (clear-visited-file-modtime)+ (intero-async-call+ 'backend+ (concat ":l " (intero-buffer-file-name))+ (list :cont cont+ :file-buffer file-buffer+ :checker checker)+ (lambda (state string)+ (with-current-buffer (plist-get state :file-buffer)+ (funcall (plist-get state :cont)+ 'finished+ (intero-parse-errors-warnings+ (plist-get state :checker)+ (current-buffer)+ string))+ (when (string-match "OK, modules loaded: \\(.*\\)\\.$" string)+ (let ((modules (match-string 1 string)))+ (intero-async-call 'backend+ (concat ":m + "+ (replace-regexp-in-string modules "," ""))+ nil+ (lambda (_st _))))))))))) (flycheck-define-generic-checker 'intero "A syntax and type checker for Haskell using an Intero worker process." :start 'intero-check- :modes '(haskell-mode)+ :modes '(haskell-mode literate-haskell-mode) :next-checkers '((warning . haskell-hlint))) (add-to-list 'flycheck-checkers 'intero)@@ -290,12 +356,14 @@ (concat "[\r\n]\\([A-Z]?:?[^ \r\n:][^:\n\r]+\\):\\([0-9()-:]+\\):" "[ \n\r]+\\([[:unibyte:][:nonascii:]]+?\\)\n[^ ]") nil t 1)- (let* ((file (match-string 1))+ (let* ((file (intero-canonicalize-path (match-string 1))) (location-raw (match-string 2))- (msg (match-string 3))+ (msg (match-string 3)) ;; Replace gross bullet points. (type (cond ((string-match "^Warning:" msg) (setq msg (replace-regexp-in-string "^Warning: *" "" msg))- 'warning)+ (if (string-match "^\\[-Wdeferred-type-errors\\]" msg)+ 'error+ 'warning)) ((string-match "^Splicing " msg) 'splice) (t 'error))) (location (intero-parse-error@@ -306,12 +374,12 @@ (cons (flycheck-error-new-at line column type msg :checker checker- :buffer (when (string= (buffer-file-name buffer)+ :buffer (when (string= (intero-buffer-file-name buffer) file) buffer) :filename file) messages))))- messages)))+ (delete-dups messages)))) (defconst intero-error-regexp-alist `((,(concat@@ -361,17 +429,20 @@ (interactive (list 'interactive)) (cl-case command (interactive (company-begin-backend 'company-intero))- (prefix (let ((prefix-info (intero-completions-grab-prefix)))- (when prefix-info- (cl-destructuring-bind- (beg end prefix _type) prefix-info- prefix))))+ (prefix+ (unless (intero-gave-up 'backend)+ (let ((prefix-info (intero-completions-grab-prefix)))+ (when prefix-info+ (cl-destructuring-bind+ (beg end prefix _type) prefix-info+ prefix))))) (candidates- (let ((prefix-info (intero-completions-grab-prefix)))- (when prefix-info- (cl-destructuring-bind- (beg end prefix _type) prefix-info- (intero-get-completions beg end)))))))+ (unless (intero-gave-up 'backend)+ (let ((prefix-info (intero-completions-grab-prefix)))+ (when prefix-info+ (cl-destructuring-bind+ (beg end prefix _type) prefix-info+ (intero-get-completions beg end)))))))) (defun intero-completions-grab-prefix (&optional minlen) "Grab prefix at point for possible completion."@@ -428,6 +499,21 @@ (when value (list start end value type))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; ELDoc integration++(defun eldoc-intero ()+ "ELDoc backend for intero."+ (let* ((ty (apply #'intero-get-type-at (intero-thing-at-point)))+ (is-error (string-match "^<.+>:.+:" ty)))+ (unless is-error+ (with-temp-buffer+ (when (fboundp 'haskell-mode)+ (haskell-mode))+ (insert (replace-regexp-in-string "[ \n]+" " " ty))+ (font-lock-fontify-buffer)+ (buffer-string)))))++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; REPL (defconst intero-prompt-regexp "^\4 ")@@ -435,7 +521,8 @@ (defun intero-repl-load () "Load the current file in the REPL." (interactive)- (let ((file (buffer-file-name))+ (save-buffer)+ (let ((file (intero-buffer-file-name)) (repl-buffer (intero-repl-buffer))) (with-current-buffer repl-buffer (comint-send-string@@ -461,7 +548,8 @@ (get-buffer-create name) (cd root) (intero-repl-mode)- (intero-repl-mode-start (buffer-local-value 'intero-targets backend-buffer))+ (intero-repl-mode-start backend-buffer+ (buffer-local-value 'intero-targets backend-buffer)) (current-buffer))))) (define-derived-mode intero-repl-mode comint-mode "Intero-REPL"@@ -471,12 +559,17 @@ (error "You probably meant to run: M-x intero-repl")) (set (make-local-variable 'comint-prompt-regexp) intero-prompt-regexp)) -(defun intero-repl-mode-start (targets)+(defun intero-repl-mode-start (buffer targets) "Start the process for the repl buffer." (setq intero-targets targets)- (let ((arguments (intero-make-options-list intero-targets)))+ (let ((arguments (intero-make-options-list+ (or targets+ (let ((package-name (buffer-local-value 'intero-package-name buffer)))+ (unless (equal "" package-name)+ (list package-name))))+ t))) (insert (propertize- (format "Starting:\n stack ghci %s\n" (mapconcat #'identity arguments " "))+ (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 \"\"@@ -484,13 +577,14 @@ :set prompt \"\\4 \" ") (basic-save-buffer)- (buffer-file-name))))+ (intero-buffer-file-name)))) (let ((process (apply #'start-process "intero" (current-buffer) "stack" "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.")))))) ;; For live migration, remove later@@ -585,6 +679,26 @@ (unless (= start end) (cons start end)))))) +(defun intero-buffer-file-name (&optional buffer)+ "Return buffer-file-name stripped of any text properties."+ (let ((name (buffer-file-name buffer)))+ (when name+ (intero-canonicalize-path (substring-no-properties name)))))++(defun intero-canonicalize-path (path)+ "Standardizes path names and ensures drive names are+capitalized (relevant on Windows)"+ (intero-capitalize-drive-letter (convert-standard-filename path)))++(defun intero-capitalize-drive-letter (path)+ "Ensures the drive letter is capitalized in paths of the form+x:\\foo\\bar (i.e., Windows)."+ (save-match-data+ (let ((drive-path (split-string path ":\\\\")))+ (if (or (null (car drive-path)) (null (cdr drive-path)))+ path+ (concat (upcase (car drive-path)) ":\\" (cadr drive-path))))))+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Query/commands @@ -599,7 +713,7 @@ (intero-blocking-call 'backend (format ":type-at %S %d %d %d %d %S"- (buffer-file-name)+ (intero-buffer-file-name) (save-excursion (goto-char beg) (line-number-at-pos)) (save-excursion (goto-char beg)@@ -625,7 +739,7 @@ (intero-blocking-call 'backend (format ":loc-at %S %d %d %d %d %S"- (buffer-file-name)+ (intero-buffer-file-name) (save-excursion (goto-char beg) (line-number-at-pos)) (save-excursion (goto-char beg)@@ -643,7 +757,7 @@ (intero-blocking-call 'backend (format ":uses %S %d %d %d %d %S"- (buffer-file-name)+ (intero-buffer-file-name) (save-excursion (goto-char beg) (line-number-at-pos)) (save-excursion (goto-char beg)@@ -660,7 +774,7 @@ (intero-blocking-call 'backend (format ":complete-at %S %d %d %d %d %S"- (buffer-file-name)+ (intero-buffer-file-name) (save-excursion (goto-char beg) (line-number-at-pos)) (save-excursion (goto-char beg)@@ -703,14 +817,17 @@ (defun intero-async-call (worker cmd &optional state callback) "Make an asynchronous call of CMD (string) to the process, calling CALLBACK as (CALLBACK STATE REPLY)."- (with-current-buffer (intero-buffer worker)- (setq intero-callbacks- (append intero-callbacks- (list (list state- (or callback #'ignore)- cmd)))))- (process-send-string (intero-process worker)- (concat cmd "\n")))+ (let ((buffer (intero-buffer worker)))+ (if (and buffer (process-live-p (get-buffer-process buffer)))+ (progn (with-current-buffer buffer+ (setq intero-callbacks+ (append intero-callbacks+ (list (list state+ (or callback #'ignore)+ cmd)))))+ (process-send-string (intero-process worker)+ (concat cmd "\n")))+ (error "Intero process is not running. Run M-x intero-restart to start it.")))) (defun intero-buffer (worker) "Get the worker buffer for the current directory."@@ -735,109 +852,176 @@ (defun intero-auto-install (buffer install-status &optional targets source-buffer) "Automatically install Intero."- (let ((source-buffer (or source-buffer (current-buffer))))- (switch-to-buffer buffer)- (erase-buffer)- (insert (cl-case install-status- (not-installed "Intero is not installed in the Stack environment.")- (wrong-version "The wrong version of Intero is installed for this Emacs package."))- (format "+ (if (buffer-local-value 'intero-give-up buffer)+ buffer+ (let ((source-buffer (or source-buffer (current-buffer))))+ (switch-to-buffer buffer)+ (erase-buffer)+ (insert (cl-case install-status+ (not-installed "Intero is not installed in the Stack environment.")+ (wrong-version "The wrong version of Intero is installed for this Emacs package."))+ (format " Installing intero-%s automatically ... " intero-package-version))- (redisplay)- (cl-case (call-process "stack" nil (current-buffer) t "build"- (with-current-buffer buffer- (let* ((cabal-file (intero-cabal-find-file))- (package-name (intero-package-name cabal-file)))- ;; For local development. Most users'll- ;; never hit this behaviour.- (if (string= package-name "intero")- "intero"- (concat "intero-" intero-package-version)))))- (0- (message "Installed successfully! Starting Intero in a moment ...")- (bury-buffer buffer)- (switch-to-buffer source-buffer)- (intero-start-process-in-buffer buffer targets source-buffer))- (1 (insert (propertize "Could not install Intero!+ (redisplay)+ (cl-case (call-process "stack" nil (current-buffer) t "build"+ (with-current-buffer buffer+ (let* ((cabal-file (intero-cabal-find-file))+ (package-name (intero-package-name cabal-file)))+ ;; For local development. Most users'll+ ;; never hit this behaviour.+ (if (string= package-name "intero")+ "intero"+ (concat "intero-" intero-package-version))))+ "ghc-paths" "syb")+ (0+ (message "Installed successfully! Starting Intero in a moment ...")+ (bury-buffer buffer)+ (switch-to-buffer source-buffer)+ (intero-start-process-in-buffer buffer targets source-buffer))+ (1+ (with-current-buffer buffer (setq-local intero-give-up t))+ (insert (propertize "Could not install Intero! We don't know why it failed. Please read the above output and try installing manually. If that doesn't work, report this as a problem.++WHAT TO DO NEXT++If you don't want to Intero to try installing itself again for+this project, just keep this buffer around in your Emacs.++If you'd like to try again next time you try use an Intero+feature, kill this buffer. "- 'face 'compilation-error))))))+ 'face 'compilation-error))+ nil))))) (defun intero-start-process-in-buffer (buffer &optional targets source-buffer) "Start an Intero worker in BUFFER for TARGETS, automatically performing a initial actions in SOURCE-BUFFER, if specified."- (let* ((options- (intero-make-options-list- (or targets- (list (buffer-local-value 'intero-package-name buffer)))))- (arguments options)- (process (with-current-buffer buffer- (when debug-on-error- (message "Intero arguments: %S" arguments))- (message "Booting up intero ...")- (apply #'start-process "stack" buffer "stack" "ghci"- arguments))))- (process-send-string process ":set -fobject-code\n")- (process-send-string process ":set prompt \"\\4\"\n")- (with-current-buffer buffer- (erase-buffer)- (setq intero-targets targets)- (setq intero-arguments arguments)- (setq intero-callbacks- (list (list source-buffer- (lambda (source-buffer _msg)- (when source-buffer- (with-current-buffer source-buffer- (when flycheck-mode- (run-with-timer 0 nil- 'intero-call-in-buffer- (current-buffer)- 'flycheck-buffer))))- (message "Booted up intero!"))))))- (set-process-filter process- (lambda (process string)- (when (buffer-live-p (process-buffer process))- (with-current-buffer (process-buffer process)- (goto-char (point-max))- (insert string)- (intero-read-buffer)))))- (set-process-sentinel process 'intero-sentinel)- buffer))+ (if (buffer-local-value 'intero-give-up buffer)+ buffer+ (let* ((options+ (intero-make-options-list+ (or targets+ (let ((package-name (buffer-local-value 'intero-package-name buffer)))+ (unless (equal "" package-name)+ (list package-name))))+ (not (buffer-local-value 'intero-try-with-build buffer))))+ (arguments options)+ (process (with-current-buffer buffer+ (when debug-on-error+ (message "Intero arguments: %s" (combine-and-quote-strings arguments)))+ (message "Booting up intero ...")+ (apply #'start-process "stack" buffer "stack" "ghci"+ arguments))))+ (set-process-query-on-exit-flag process nil)+ (process-send-string process ":set -fobject-code\n")+ (process-send-string process ":set prompt \"\\4\"\n")+ (with-current-buffer buffer+ (erase-buffer)+ (setq intero-targets targets)+ (setq intero-source-buffer source-buffer)+ (setq intero-arguments arguments)+ (setq intero-starting t)+ (setq intero-callbacks+ (list (list (cons source-buffer+ buffer)+ (lambda (buffers _msg)+ (let ((source-buffer (car buffers))+ (process-buffer (cdr buffers)))+ (with-current-buffer process-buffer+ (setq-local intero-starting nil))+ (when source-buffer+ (with-current-buffer source-buffer+ (when flycheck-mode+ (run-with-timer 0 nil+ 'intero-call-in-buffer+ (current-buffer)+ 'intero-flycheck-buffer)))))+ (message "Booted up intero!"))))))+ (set-process-filter process+ (lambda (process string)+ (when (buffer-live-p (process-buffer process))+ (with-current-buffer (process-buffer process)+ (goto-char (point-max))+ (insert string)+ (when (and intero-try-with-build+ intero-starting)+ (let ((last-line (buffer-substring-no-properties+ (line-beginning-position)+ (line-end-position))))+ (if (string-match "^Progress" last-line)+ (message "Booting up intero (building dependencies: %s)"+ (downcase+ (or (car (split-string (replace-regexp-in-string+ "\u0008+" "\n"+ last-line)+ "\n" t))+ "...")))+ (message "Booting up intero ..."))))+ (intero-read-buffer)))))+ (set-process-sentinel process 'intero-sentinel)+ buffer))) -(defun intero-make-options-list (targets)+(defun intero-flycheck-buffer ()+ "Run flycheck in the buffer. Restarting in case there was a+problem and flycheck is stuck."+ (flycheck-mode -1)+ (flycheck-mode)+ (flycheck-buffer))++(defun intero-make-options-list (targets no-build) "Make the stack ghci options list." (append (list "--with-ghc" "intero" "--docker-run-args=--interactive=true --tty=false" "--no-load"- "--no-build")+ )+ (when no-build+ (list "--no-build")) (let ((dir (make-temp-file "intero" t))) (list "--ghci-options"- (format "%S" (concat "-odir=" dir))+ (concat "-odir=" dir) "--ghci-options"- (format "%S" (concat "-hidir=" dir))))+ (concat "-hidir=" dir))) targets)) (defun intero-sentinel (process change) "Handle a CHANGE to the PROCESS." (when (buffer-live-p (process-buffer process)) (when (and (not (process-live-p process)))- (if (with-current-buffer (process-buffer process)- intero-deleting)- (message "Intero process deleted.")- (intero-show-process-problem process change)))))+ (let ((buffer (process-buffer process)))+ (if (with-current-buffer buffer intero-deleting)+ (message "Intero process deleted.")+ (if (and (intero-unsatisfied-package-p buffer)+ (not (buffer-local-value 'intero-try-with-build buffer)))+ (progn (with-current-buffer buffer (setq-local intero-try-with-build t))+ (intero-start-process-in-buffer+ buffer+ (buffer-local-value 'intero-targets buffer)+ (buffer-local-value 'intero-source-buffer buffer)))+ (progn (with-current-buffer buffer (setq-local intero-give-up t))+ (intero-show-process-problem process change)))))))) +(defun intero-unsatisfied-package-p (buffer)+ "Does the buffer contain GHCi's unsatisfied package complaint?"+ (with-current-buffer buffer+ (save-excursion+ (goto-char (point-min))+ (search-forward-regexp "cannot satisfy -package" nil t 1))))+ (defun intero-installed-p () "Is intero (of the right version) installed in the stack environment?" (redisplay) (with-temp-buffer- (if (= 0 (call-process "stack" nil t nil "exec" "--" "intero" "--version"))+ (if (= 0 (call-process "stack" nil t nil "exec"+ "--verbosity" "silent"+ "--" "intero" "--version")) (progn (goto-char (point-min)) (if (string= (buffer-substring (point-min) (line-end-position))@@ -859,6 +1043,8 @@ "This is the buffer where Emacs talks to intero. It's normally hidden, but a problem occcured. +TROUBLESHOOTING+ It may be obvious if there is some text above this message indicating a problem. @@ -871,15 +1057,22 @@ " (format " stack ghci %s"- (mapconcat #'identity- intero-arguments- " "))+ (combine-and-quote-strings intero-arguments)) " -After fixing this problem, you could switch back to your code and-run M-x intero-restart to try again.+WHAT TO DO NEXT -You can kill this buffer when you're done reading it.\n")+If you fixed the problem, just kill this buffer, Intero will make+a fresh one and attempt to start the process automatically as+soon as you start editing code again.++If you are unable to fix the problem, just leave this buffer+around in Emacs and Intero will not attempt to start the process+anymore.++You can always run M-x intero-restart to make it try again.++") 'face 'compilation-error))) (defun intero-read-buffer ()@@ -892,7 +1085,7 @@ (let* ((next-callback (pop intero-callbacks)) (state (nth 0 next-callback)) (func (nth 1 next-callback)))- (let ((string (buffer-substring (point-min) (1- (point)))))+ (let ((string (strip-carriage-returns (buffer-substring (point-min) (1- (point)))))) (if next-callback (progn (with-temp-buffer (funcall func state string))@@ -902,18 +1095,33 @@ string))))) (delete-region (point-min) (point)))))) +(defun strip-carriage-returns (string)+ "Removes the \r from \r\n newlines on Windows"+ (replace-regexp-in-string "\r" "" string))+ (defun intero-get-buffer-create (worker) "Get or create the stack buffer for this current directory and the given targets."- (let* ((cabal-file (intero-cabal-find-file))- (package-name (intero-package-name cabal-file))+ (let* ((root (intero-project-root))+ (cabal-file (intero-cabal-find-file))+ (package-name (if cabal-file+ (intero-package-name cabal-file)+ "")) (buffer-name (intero-buffer-name worker))- (default-directory (file-name-directory cabal-file)))+ (default-directory (if cabal-file+ (file-name-directory cabal-file)+ root))) (with-current-buffer (get-buffer-create buffer-name) (setq intero-package-name package-name) (cd default-directory) (current-buffer))))++(defun intero-gave-up (worker)+ "Did starting/installation give up?"+ (and (intero-buffer-p worker)+ (let ((buffer (get-buffer (intero-buffer-name worker))))+ (buffer-local-value 'intero-give-up buffer)))) (defun intero-buffer-p (worker) "Does a buffer exist for a given worker?"
intero.cabal view
@@ -1,7 +1,7 @@ name: intero version:- 0.1.13+ 0.1.14 synopsis: Complete interactive development program for Haskell license:
src/InteractiveUI.hs view
@@ -205,6 +205,7 @@ ("check", keepGoing' checkModule, completeHomeModule), ("continue", keepGoing continueCmd, noCompletion), ("complete", keepGoing completeCmd, noCompletion),+ ("completion", keepGoing completeCmdSet, completeMacro), ("cmd", keepGoing cmdCmd, completeExpression), ("ctags", keepGoing createCTagsWithLineNumbersCmd, completeFilename), ("ctags!", keepGoing createCTagsWithRegExesCmd, completeFilename),@@ -286,6 +287,25 @@ defShortHelpText :: String defShortHelpText = "use :? for help.\n" +completions :: [(String, Bool, CompletionFunc GHCi)]+completions = [+ ( "none", True, noCompletion),+ ( "expr", True, completeExpression),+ ( "file", True, completeFilename),+ ( "module", True, completeModule),+ ( "home-module", False, completeHomeModule),+ ( "home-mod-file", False, completeHomeModuleOrFile),+ ( "identifier", True, completeIdentifier),+ ( "macro", False, completeMacro),+ ( "seti", False, completeSeti),+ ( "set-module", False, completeSetModule),+ ( "set-options", False, completeSetOptions),+ ( "showi", False, completeShowiOptions),+ ( "show-options", False, completeShowOptions) ]++completionsHelpText :: String+completionsHelpText = concat . intersperse "|" . map (\ (name, _, _) -> name) . filter (\ (_, enabled, _) -> enabled) $ completions+ defFullHelpText :: String defFullHelpText = " Commands available from the prompt:\n" ++@@ -299,6 +319,8 @@ " :cd <dir> change directory to <dir>\n" ++ " :cmd <expr> run the commands returned by <expr>::IO String\n" ++ " :complete <dom> [<rng>] <s> list completions for partial input string\n" +++ " :completion <cmd> <ctype> Assign a certain completion type to a command:\n" +++ " " ++ completionsHelpText ++ "\n" ++ " :ctags[!] [<file>] create tags file for Vi (default: \"tags\")\n" ++ " (!: use regex instead of line number)\n" ++ " :def <cmd> <expr> define command :<cmd> (later defined command has\n" ++@@ -1777,8 +1799,8 @@ result <- findCompletions infos fp sample sl sc el ec case result of Left err -> error err- Right completions ->- liftIO (mapM_ putStrLn completions)+ Right completions' ->+ liftIO (mapM_ putStrLn completions') _ -> return () -----------------------------------------------------------------------------@@ -2947,6 +2969,35 @@ completeExpression = completeQuotedWord (Just '\\') "\"" listFiles completeIdentifier++-----------------------------------------------------------------------------+-- :completion++completeCmdSet :: String -> GHCi ()+completeCmdSet s = do+ (macro_name, completion_name) <-+ case words s of+ (a : b : []) -> return (a, b)+ _ -> throwGhcException (CmdLineError $ "syntax: :completion <macro> " ++ completionsHelpText)++ macros <- liftIO (readIORef macros_ref)++ completionFunc <-+ case filter (\ (name, enabled, _) -> name == completion_name && enabled) completions of+ (_, _, f) : _ -> return f+ [] -> throwGhcException (CmdLineError $ "Unknown completion mode: must be one of " ++ completionsHelpText)++ let updatedMacros = updateFirst ((== macro_name) . cmdName) (\ (name, f, _) -> (name, f, completionFunc)) macros++ case updatedMacros of+ (True, newMacros) -> liftIO (writeIORef macros_ref newMacros)+ (False, _) -> throwGhcException (CmdLineError $ "Could not find macro: '" ++ macro_name ++ "'")+++updateFirst :: (a -> Bool) -> (a -> a) -> [a] -> (Bool, [a])+updateFirst _ _ [] = (False, [])+updateFirst p f (x:xs) | p x = (True, f x : xs)+ | otherwise = (x :) <$> updateFirst p f xs -- -----------------------------------------------------------------------------