diff --git a/CHANGELOG b/CHANGELOG
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -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)
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,67 +1,32 @@
-# 
intero [](https://travis-ci.org/commercialhaskell/intero)
+# intero [](https://travis-ci.org/commercialhaskell/intero) 
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+)
diff --git a/elisp/intero.el b/elisp/intero.el
--- a/elisp/intero.el
+++ b/elisp/intero.el
@@ -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
+;; Maintainer: Chris Done
+;; 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?"
diff --git a/intero.cabal b/intero.cabal
--- a/intero.cabal
+++ b/intero.cabal
@@ -1,7 +1,7 @@
name:
intero
version:
- 0.1.13
+ 0.1.14
synopsis:
Complete interactive development program for Haskell
license:
diff --git a/src/InteractiveUI.hs b/src/InteractiveUI.hs
--- a/src/InteractiveUI.hs
+++ b/src/InteractiveUI.hs
@@ -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 change directory to \n" ++
" :cmd run the commands returned by ::IO String\n" ++
" :complete [] list completions for partial input string\n" ++
+ " :completion Assign a certain completion type to a command:\n" ++
+ " " ++ completionsHelpText ++ "\n" ++
" :ctags[!] [] create tags file for Vi (default: \"tags\")\n" ++
" (!: use regex instead of line number)\n" ++
" :def define command : (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 " ++ 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
-- -----------------------------------------------------------------------------