intero 0.1.8 → 0.1.9
raw patch · 11 files changed
+1546/−100 lines, 11 filesdep +ghc-boot-thdep +ghcidep +regex-compatdep ~ghc
Dependencies added: ghc-boot-th, ghci, regex-compat
Dependency ranges changed: ghc
Files
- CHANGELOG +7/−0
- README.md +7/−0
- elisp/haskell-simple-indent.el +273/−0
- elisp/intero.el +944/−0
- intero.cabal +12/−3
- src/GhciFind.hs +4/−1
- src/GhciInfo.hs +11/−2
- src/GhciMonad.hs +14/−2
- src/InteractiveUI.hs +231/−80
- src/Main.hs +10/−3
- src/test/Main.hs +33/−9
CHANGELOG view
@@ -1,3 +1,10 @@+0.1.9:+ * Support GHC 8+ * Fix completion before any module is loaded (https://github.com/chrisdone/intero/issues/34)+ * Add completion for custom commands+ * Add data-files entry for Emacs Lisp code+ * Collect type-info whenever anything is loaded (https://github.com/chrisdone/intero/issues/37)+ 0.1.8: * Don't use -dynamic on Windows.
README.md view
@@ -2,6 +2,13 @@ Complete interactive development program for Haskell +## Supported GHCs++* 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:
+ elisp/haskell-simple-indent.el view
@@ -0,0 +1,273 @@+;;; haskell-simple-indent.el --- Simple indentation module for Haskell Mode -*- lexical-binding: t -*-++;; Copyright (C) 1998 Heribert Schuetz, Graeme E Moss++;; Author: Heribert Schuetz <Heribert.Schuetz@informatik.uni-muenchen.de>+;; Graeme E Moss <gem@cs.york.ac.uk>+;; Keywords: indentation files Haskell++;; This file is not part of GNU Emacs.++;; 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+;; the Free Software Foundation; either version 3, or (at your option)+;; any later version.++;; This file is distributed in the hope that it will be useful,+;; but WITHOUT ANY WARRANTY; without even the implied warranty of+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+;; GNU General Public License for more details.++;; You should have received a copy of the GNU General Public License+;; along with this program. If not, see <http://www.gnu.org/licenses/>.++;;; Commentary:++;; Purpose:+;;+;; To support simple indentation of Haskell scripts.+;;+;;+;; Installation:+;;+;; To bind TAB to the indentation command for all Haskell buffers, add+;; this to .emacs:+;;+;; (add-hook 'haskell-mode-hook 'turn-on-haskell-simple-indent)+;;+;; Otherwise, call `turn-on-haskell-simple-indent'.+;;+;;+;; Customisation:+;;+;; None supported.+;;+;;+;; History:+;;+;; If you have any problems or suggestions, after consulting the list+;; below, email gem@cs.york.ac.uk quoting the version of you are+;; using, the version of Emacs you are using, and a small example of+;; the problem or suggestion.+;;+;; Version 1.0:+;; Brought over from Haskell mode v1.1.+;;+;; Present Limitations/Future Work (contributions are most welcome!):+;;+;; (None so far.)++;;; Code:++;; All functions/variables start with+;; `(turn-(on/off)-)haskell-simple-indent'.++(require 'haskell-mode)++;;;###autoload+(defgroup haskell-simple-indent nil+ "Simple Haskell indentation."+ :link '(custom-manual "(haskell-mode)Indentation")+ :group 'haskell+ :prefix "haskell-simple-indent-")++;; Version.+(defconst haskell-simple-indent-version "1.2"+ "`haskell-simple-indent' version number.")+(defun haskell-simple-indent-version ()+ "Echo the current version of `haskell-simple-indent' in the minibuffer."+ (interactive)+ (message "Using haskell-simple-indent version %s"+ haskell-simple-indent-version))++;; Partly stolen from `indent-relative' in indent.el:+(defun haskell-simple-indent ()+ "Space out to under next visible indent point.++Indent points are positions of non-whitespace following+whitespace in lines preceeding point. Example:++func arg cx = when (isTrue) $ do+ print 42+^ ^ ^ ^ ^ ^ ^ ^ ^ ^++A position is visible if it is to the left of the first+non-whitespace (indentation) of every nonblank line between the+position and the current line. If there is no visible indent+point beyond the current column, position given by+`indent-next-tab-stop' is used instead."+ (interactive)+ (let* ((start-column (or (save-excursion+ (back-to-indentation)+ (if (not (eolp))+ (current-column)))+ (current-column)))+ (invisible-from nil) ; `nil' means infinity here+ (found)+ (indent))+ (save-excursion+ ;; Loop stops if there no more lines above this one or when has+ ;; found a line starting at first column.+ (while (and (not found)+ (or (not invisible-from)+ (not (zerop invisible-from)))+ (zerop (forward-line -1)))+ ;; Ignore empty lines.+ (if (not (looking-at "[ \t]*\n"))+ (let ((this-indentation (current-indentation)))+ ;; Is this line so indented that it cannot have+ ;; influence on indentation points?+ (if (or (not invisible-from)+ (< this-indentation invisible-from))+ (if (> this-indentation start-column)+ (setq invisible-from this-indentation)+ (let ((end (line-end-position)))+ (move-to-column start-column)+ ;; Is start-column inside a tab on this line?+ (if (> (current-column) start-column)+ (backward-char 1))+ ;; Skip to the end of non-whitespace.+ (skip-chars-forward "^ \t" end)+ ;; Skip over whitespace.+ (skip-chars-forward " \t" end)+ ;; Indentation point found if not at the end of+ ;; line and if not covered by any line below+ ;; this one. In that case use invisible-from.+ (setq indent (if (or (= (point) end)+ (and invisible-from+ (> (current-column) invisible-from)))+ invisible-from+ (current-column)))+ ;; Signal that solution is found.+ (setq found t))))))))+++ (let ((opoint (point-marker)))+ ;; Indent to the calculated indent or last know invisible-from+ ;; or use tab-to-tab-stop. Try hard to keep cursor in the same+ ;; place or move it to the indentation if it was before it. And+ ;; keep content of the line intact.+ (setq indent (or indent+ invisible-from+ (if (fboundp 'indent-next-tab-stop)+ (indent-next-tab-stop start-column))+ (let ((tabs tab-stop-list))+ (while (and tabs (>= start-column (car tabs)))+ (setq tabs (cdr tabs)))+ (if tabs (car tabs)))+ (* (/ (+ start-column tab-width) tab-width) tab-width)))+ (indent-line-to indent)+ (if (> opoint (point))+ (goto-char opoint))+ (set-marker opoint nil))))++(defun haskell-simple-indent-backtab ()+ "Indent backwards. Dual to `haskell-simple-indent'."+ (interactive)+ (let ((saved-column (or (save-excursion+ (back-to-indentation)+ (if (not (eolp))+ (current-column)))+ (current-column)))+ (i 0)+ (x 0))++ (save-excursion+ (back-to-indentation)+ (delete-region (line-beginning-position) (point)))+ (while (< (or (save-excursion+ (back-to-indentation)+ (if (not (eolp))+ (current-column)))+ (current-column)) saved-column)+ (haskell-simple-indent)+ (setq i (+ i 1)))++ (save-excursion+ (back-to-indentation)+ (delete-region (line-beginning-position) (point)))+ (while (< x (- i 1))+ (haskell-simple-indent)+ (setq x (+ x 1)))))++(defun haskell-simple-indent-newline-same-col ()+ "Make a newline and go to the same column as the current line."+ (interactive)+ (let ((start-end+ (save-excursion+ (let* ((start (line-beginning-position))+ (end (progn (goto-char start)+ (search-forward-regexp+ "[^ ]" (line-end-position) t 1))))+ (when end (cons start (1- end)))))))+ (if start-end+ (progn (newline)+ (insert (buffer-substring-no-properties+ (car start-end) (cdr start-end))))+ (newline))))++(defun haskell-simple-indent-newline-indent ()+ "Make a newline on the current column and indent on step."+ (interactive)+ (haskell-simple-indent-newline-same-col)+ (insert (make-string haskell-indent-spaces ? )))++(defun haskell-simple-indent-comment-indent-function ()+ "Haskell version of `comment-indent-function'."+ ;; This is required when filladapt is turned off. Without it, when+ ;; filladapt is not used, comments which start in column zero+ ;; cascade one character to the right+ (save-excursion+ (beginning-of-line)+ (let ((eol (line-end-position)))+ (and comment-start-skip+ (re-search-forward comment-start-skip eol t)+ (setq eol (match-beginning 0)))+ (goto-char eol)+ (skip-chars-backward " \t")+ (max comment-column (+ (current-column) (if (bolp) 0 1))))))++;;;###autoload+(define-minor-mode haskell-simple-indent-mode+ "Simple Haskell indentation mode that uses simple heuristic.+In this minor mode, `indent-for-tab-command' (bound to <tab> by+default) will move the cursor to the next indent point in the+previous nonblank line, whereas `haskell-simple-indent-backtab'+\ (bound to <backtab> by default) will move the cursor the+previous indent point. An indent point is a non-whitespace+character following whitespace.++Runs `haskell-simple-indent-hook' on activation."+ :lighter " Ind"+ :group 'haskell-simple-indent+ :keymap '(([backtab] . haskell-simple-indent-backtab))+ (kill-local-variable 'comment-indent-function)+ (kill-local-variable 'indent-line-function)+ (when haskell-simple-indent-mode+ (when (and (bound-and-true-p haskell-indentation-mode)+ (fboundp 'haskell-indentation-mode))+ (haskell-indentation-mode 0))+ (set (make-local-variable 'comment-indent-function) #'haskell-simple-indent-comment-indent-function)+ (set (make-local-variable 'indent-line-function) 'haskell-simple-indent)+ (run-hooks 'haskell-simple-indent-hook)))++;; The main functions.+;;;###autoload+(defun turn-on-haskell-simple-indent ()+ "Turn on function `haskell-simple-indent-mode'."+ (interactive)+ (haskell-simple-indent-mode))+(make-obsolete 'turn-on-haskell-simple-indent+ 'haskell-simple-indent-mode+ "2015-07-23")++(defun turn-off-haskell-simple-indent ()+ "Turn off function `haskell-simple-indent-mode'."+ (interactive)+ (haskell-simple-indent-mode 0))++;; Provide ourselves:++(provide 'haskell-simple-indent)++;;; haskell-simple-indent.el ends here
+ elisp/intero.el view
@@ -0,0 +1,944 @@+;;; intero.el --- Complete development mode for Haskell++;; Copyright (c) 2016 Chris Done+;; Copyright (c) 2015 Athur Fayzrakhmanov+;; Copyright (c) 2013 Herbert Valerio Riedel+;; Copyright (c) 2007 Stefan Monnier++;; Package-Requires: ((flycheck "26") (company "0.9.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+;; the Free Software Foundation; either version 3, or (at your option)+;; any later version.++;; This file is distributed in the hope that it will be useful,+;; but WITHOUT ANY WARRANTY; without even the implied warranty of+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+;; GNU General Public License for more details.++;; You should have received a copy of the GNU General Public License+;; along with GNU Emacs; see the file COPYING. If not, write to+;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,+;; Boston, MA 02110-1301, USA.++;;; Commentary:+;;+;; Mode that enables:+;;+;; * Flycheck type checking ✓+;; * Company mode completion ✓+;; * Go to definition ✓+;; * Type of selection ✓+;; * Info ✓+;; * REPL+;; * Find uses+;; * List all types in all expressions++;;; Code:++(require 'flycheck)+(require 'cl-lib)+(require 'company)+(require 'comint)++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; Configuration++(defconst intero-package-version "intero-0.1.8"+ "Package version to auto-install.")++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; Modes++(defvar intero-mode-map (make-sparse-keymap)+ "Intero minor mode's map.")++(define-minor-mode intero-mode "Minor mode for Intero"+ :lighter " Intero"+ :keymap intero-mode-map+ (when (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))+ (message "Intero mode disabled."))))++(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)+(define-key intero-mode-map (kbd "C-c C-l") 'intero-repl-load)++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; Buffer-local variables/state++(defvar intero-callbacks (list)+ "List of callbacks waiting for output. FIFO.")+(make-variable-buffer-local 'intero-callbacks)++(defvar intero-arguments (list)+ "Arguments used to call the stack process.")+(make-variable-buffer-local 'intero-arguments)++(defvar intero-targets (list)+ "Targets used for the stack process.")+(make-variable-buffer-local 'intero-targets)++(defvar intero-project-root nil+ "The project root of the current buffer.")+(make-variable-buffer-local 'intero-project-root)++(defvar intero-package-name nil+ "The package name associated with the current buffer.")+(make-variable-buffer-local 'intero-package-name)++(defvar intero-deleting nil+ "The process of the buffer is being deleted.")+(make-variable-buffer-local 'intero-deleting)++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; Interactive commands++(defun intero-cd ()+ "Change directory in the backend process."+ (interactive)+ (intero-async-call+ 'backend+ (concat ":cd "+ (read-directory-name "Change Intero directory: "))))++(defun intero-type-at (insert)+ "Get the type of the thing or selection at point."+ (interactive "P")+ (let ((ty (apply #'intero-get-type-at (intero-thing-at-point))))+ (if insert+ (save-excursion+ (goto-char (line-beginning-position))+ (insert+ (format "%s\n"+ (with-temp-buffer+ (when (fboundp 'haskell-mode)+ (haskell-mode))+ (insert ty)+ (font-lock-fontify-buffer)+ (buffer-string)))))+ (message+ "%s"+ (with-temp-buffer+ (when (fboundp 'haskell-mode)+ (haskell-mode))+ (insert ty)+ (font-lock-fontify-buffer)+ (buffer-string))))))++(defun intero-info (insert)+ "Get the info of the thing at point."+ (interactive "P")+ (let ((info (intero-get-info-of (intero-ident-at-point))))+ (message+ "%s"+ (with-temp-buffer+ (when (fboundp 'haskell-mode)+ (haskell-mode))+ (insert info)+ (font-lock-fontify-buffer)+ (buffer-string)))))++(defun intero-goto-definition ()+ "Jump to the definition of the thing at point."+ (interactive)+ (let ((result (apply #'intero-get-loc-at (intero-thing-at-point))))+ (when (string-match "\\(.*?\\):(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\))$"+ result)+ (let ((file (match-string 1 result))+ (line (string-to-number (match-string 2 result)))+ (col (string-to-number (match-string 3 result))))+ (find-file file)+ (pop-mark)+ (goto-char (point-min))+ (forward-line (1- line))+ (forward-char (1- col))))))++(defun intero-restart ()+ "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)))+ (intero-destroy 'backend)+ (intero-get-worker-create 'backend targets (current-buffer)))))++(defun intero-targets ()+ "Set the targets to use for stack ghci."+ (interactive)+ (let ((targets (split-string (read-from-minibuffer "Targets: ")+ " "+ t)))+ (intero-destroy)+ (intero-get-worker-create 'backend targets (current-buffer))))++(defun intero-destroy (&optional worker)+ "Stop the current worker process and kill its associated."+ (interactive)+ (if worker+ (intero-delete-worker worker)+ (intero-delete-worker 'backend)))++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; DevelMain integration++(defun intero-devel-reload ()+ "Reload the module `DevelMain' and then run `DevelMain.update'.++This is for doing live update of the code of servers or GUI+applications. Put your development version of the program in+`DevelMain', and define `update' to auto-start the program on a+new thread, and use the `foreign-store' package to access the+running context across :load/:reloads in Intero."+ (interactive)+ (unwind-protect+ (with-current-buffer+ (or (get-buffer "DevelMain.hs")+ (if (y-or-n-p+ "You need to open a buffer named DevelMain.hs. Find now?")+ (ido-find-file)+ (error "No DevelMain.hs buffer.")))+ (message "Reloading ...")+ (intero-async-call+ 'backend+ ":l DevelMain"+ (current-buffer)+ (lambda (buffer reply)+ (if (string-match "^OK, modules loaded" reply)+ (intero-async-call+ 'backend+ "DevelMain.update"+ buffer+ (lambda (_buffer reply)+ (message "DevelMain updated. Output was:\n%s"+ reply)))+ (progn+ (message "DevelMain FAILED. Switch to DevelMain.hs and compile that.")+ (switch-to-buffer buffer)+ (flycheck-buffer)+ (flycheck-list-errors))))))))++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; Flycheck integration++(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 _))))))))))++(flycheck-define-generic-checker 'intero+ "A syntax and type checker for Haskell using an Intero worker+process."+ :start 'intero-check+ :modes '(haskell-mode)+ :next-checkers '((warning . haskell-hlint)))++(add-to-list 'flycheck-checkers 'intero)++(defun intero-parse-errors-warnings (checker buffer string)+ "Parse from the given STRING a list of flycheck errors and+warnings, adding CHECKER and BUFFER to each one."+ (with-temp-buffer+ (insert string)+ (goto-char (point-min))+ (let ((messages (list)))+ (while (search-forward-regexp+ (concat "[\r\n]\\([A-Z]?:?[^ \r\n:][^:\n\r]+\\):\\([0-9()-:]+\\):"+ "[ \n\r]+\\([[:unibyte:][:nonascii:]]+?\\)\n[^ ]")+ nil t 1)+ (let* ((file (match-string 1))+ (location-raw (match-string 2))+ (msg (match-string 3))+ (type (cond ((string-match "^Warning:" msg)+ (setq msg (replace-regexp-in-string "^Warning: *" "" msg))+ 'warning)+ ((string-match "^Splicing " msg) 'splice)+ (t 'error)))+ (location (intero-parse-error+ (concat file ":" location-raw ": x")))+ (line (plist-get location :line))+ (column (plist-get location :col)))+ (setq messages+ (cons (flycheck-error-new-at+ line column type msg+ :checker checker+ :buffer (when (string= (buffer-file-name buffer)+ file)+ buffer)+ :filename file)+ messages))))+ messages)))++(defconst intero-error-regexp-alist+ `((,(concat+ "^ *\\(?1:[^\t\r\n]+?\\):"+ "\\(?:"+ "\\(?2:[0-9]+\\):\\(?4:[0-9]+\\)\\(?:-\\(?5:[0-9]+\\)\\)?" ;; "121:1" & "12:3-5"+ "\\|"+ "(\\(?2:[0-9]+\\),\\(?4:[0-9]+\\))-(\\(?3:[0-9]+\\),\\(?5:[0-9]+\\))" ;; "(289,5)-(291,36)"+ "\\)"+ ":\\(?6: Warning:\\)?")+ 1 (2 . 3) (4 . 5) (6 . nil)) ;; error/warning locus++ ;; multiple declarations+ ("^ \\(?:Declared at:\\| \\) \\(?1:[^ \t\r\n]+\\):\\(?2:[0-9]+\\):\\(?4:[0-9]+\\)$"+ 1 2 4 0) ;; info locus++ ;; this is the weakest pattern as it's subject to line wrapping et al.+ (" at \\(?1:[^ \t\r\n]+\\):\\(?2:[0-9]+\\):\\(?4:[0-9]+\\)\\(?:-\\(?5:[0-9]+\\)\\)?[)]?$"+ 1 2 (4 . 5) 0)) ;; info locus+ "Regexps used for matching GHC compile messages.")++(defun intero-parse-error (string)+ "Parse the line number from the error."+ (let ((span nil))+ (cl-loop for regex+ in intero-error-regexp-alist+ do (when (string-match (car regex) string)+ (setq span+ (list :file (match-string 1 string)+ :line (string-to-number (match-string 2 string))+ :col (string-to-number (match-string 4 string))+ :line2 (when (match-string 3 string)+ (string-to-number (match-string 3 string)))+ :col2 (when (match-string 5 string)+ (string-to-number (match-string 5 string)))))))+ span))++(defun intero-call-in-buffer (buffer func &rest args)+ "Utility function which calls FUNC in BUFFER with ARGS."+ (with-current-buffer buffer+ (apply func args)))++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; Company integration (auto-completion)++(defun company-intero (command &optional arg &rest ignored)+ (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))))+ (candidates (intero-get-completions arg))))++(defun intero-completions-grab-prefix (&optional minlen)+ "Grab prefix at point for possible completion."+ (when (intero-completions-can-grab-prefix)+ (let ((prefix (cond+ ((intero-completions-grab-identifier-prefix)))))+ (cond ((and minlen prefix)+ (when (>= (length (nth 2 prefix)) minlen)+ prefix))+ (prefix prefix)))))++(defun intero-completions-can-grab-prefix ()+ "Check if the case is appropriate for grabbing completion prefix."+ (when (not (region-active-p))+ (when (looking-at-p (rx (| space line-end punct)))+ (when (not (bobp))+ (save-excursion+ (backward-char)+ (not (looking-at-p (rx (| space line-end)))))))))++(defun intero-completions-grab-identifier-prefix ()+ "Grab identifier prefix."+ (let ((pos-at-point (intero-ident-pos-at-point))+ (p (point)))+ (when pos-at-point+ (let* ((start (car pos-at-point))+ (end (cdr pos-at-point))+ (type 'haskell-completions-identifier-prefix)+ (case-fold-search nil)+ value)+ (when (<= p end)+ (setq end p)+ (setq value (buffer-substring-no-properties start end))+ (when (string-match-p (rx bos upper) value)+ (save-excursion+ (goto-char (line-beginning-position))+ (when (re-search-forward+ (rx "import"+ (? (1+ space) "qualified")+ (1+ space)+ upper+ (1+ (| alnum ".")))+ p ;; bound+ t) ;; no-error+ (if (equal p (point))+ (setq type 'haskell-completions-module-name-prefix)+ (when (re-search-forward+ (rx (| " as " "("))+ start+ t)+ (setq type 'haskell-completions-identifier-prefix))))))+ (when (nth 8 (syntax-ppss))+ (setq type 'haskell-completions-general-prefix))+ (when value (list start end value type)))))))++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; REPL++(defconst intero-prompt-regexp "^\4 ")++(defun intero-repl-load ()+ "Load the current file in the REPL."+ (interactive)+ (let ((file (buffer-file-name))+ (repl-buffer (intero-repl-buffer)))+ (with-current-buffer repl-buffer+ (comint-send-string+ (get-buffer-process (current-buffer))+ (concat ":l " file "\n")))+ (pop-to-buffer repl-buffer)))++(defun intero-repl ()+ "Start up the REPL for this stack project."+ (interactive)+ (switch-to-buffer (intero-repl-buffer)))++(defun intero-repl-buffer ()+ (let* ((root (intero-project-root))+ (package-name (intero-package-name))+ (name (format "*intero:%s:%s:repl*"+ (file-name-nondirectory root)+ package-name)))+ (if (get-buffer name)+ (get-buffer name)+ (with-current-buffer+ (get-buffer-create name)+ (cd root)+ (intero-repl-mode)+ (current-buffer)))))++(define-derived-mode intero-repl-mode comint-mode "Intero-REPL"+ "Interactive prompt for Intero."+ (when (and (not (eq major-mode 'fundamental-mode))+ (eq this-command 'intero-repl-mode))+ (error "You probably meant to run: M-x intero-repl"))+ (set (make-local-variable 'comint-prompt-regexp) intero-prompt-regexp)+ (let ((arguments (intero-make-options-list intero-targets)))+ (insert (propertize+ (format "Starting:\n stack ghci %s\n" (mapconcat #'identity 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+:set prompt \"\\4 \"+")+ (basic-save-buffer)+ (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)+ (message "Started Intero process for REPL."))))))++(font-lock-add-keywords+ 'intero-repl-mode+ '(("\\(\4\\)"+ (0 (prog1 ()+ (compose-region (match-beginning 1)+ (match-end 1)+ ?λ))))))++(define-key intero-repl-mode-map [remap move-beginning-of-line] 'intero-repl-beginning-of-line)+(define-key intero-repl-mode-map [remap delete-backward-char] 'intero-repl-delete-backward-char)++(defun intero-repl-delete-backward-char ()+ "Delete backwards, excluding the prompt."+ (interactive)+ (unless (looking-back intero-prompt-regexp)+ (call-interactively 'delete-backward-char)))++(defun intero-repl-beginning-of-line ()+ "Go to the beginning of the line, excluding the prompt."+ (interactive)+ (if (search-backward-regexp intero-prompt-regexp (line-beginning-position) t 1)+ (goto-char (+ 2 (line-beginning-position)))+ (call-interactively 'move-beginning-of-line)))++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; Buffer operations++(defun intero-thing-at-point ()+ "Return (list START END) of something at the point."+ (if (region-active-p)+ (list (region-beginning)+ (region-end))+ (let ((pos (intero-ident-pos-at-point)))+ (if pos+ (list (car pos) (cdr pos))+ (list (point) (point))))))++(defun intero-ident-at-point ()+ "Return the identifier under point, or nil if none found.+May return a qualified name."+ (let ((reg (intero-ident-pos-at-point)))+ (when reg+ (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)+ (cons start end))))))++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; Query/commands++(defun intero-get-all-types ()+ "Get all types in all expressions in all modules."+ (intero-blocking-call 'backend ":all-types"))++(defun intero-get-type-at (beg end)+ "Get the type at the given region denoted by BEG and END."+ (replace-regexp-in-string+ "\n$" ""+ (intero-blocking-call+ 'backend+ (format ":type-at %S %d %d %d %d %S"+ (buffer-file-name)+ (save-excursion (goto-char beg)+ (line-number-at-pos))+ (save-excursion (goto-char beg)+ (1+ (current-column)))+ (save-excursion (goto-char end)+ (line-number-at-pos))+ (save-excursion (goto-char end)+ (1+ (current-column)))+ (buffer-substring-no-properties beg end)))))++(defun intero-get-info-of (thing)+ "Get info for the thing."+ (replace-regexp-in-string+ "\n$" ""+ (intero-blocking-call+ 'backend+ (format ":i %s" thing))))++(defun intero-get-loc-at (beg end)+ "Get the location of the identifier denoted by BEG and END."+ (replace-regexp-in-string+ "\n$" ""+ (intero-blocking-call+ 'backend+ (format ":loc-at %S %d %d %d %d %S"+ (buffer-file-name)+ (save-excursion (goto-char beg)+ (line-number-at-pos))+ (save-excursion (goto-char beg)+ (1+ (current-column)))+ (save-excursion (goto-char end)+ (line-number-at-pos))+ (save-excursion (goto-char end)+ (1+ (current-column)))+ (buffer-substring-no-properties beg end)))))++(defun intero-get-uses-at (beg end)+ "Get the uses of the identifier denoted by BEG and END."+ (replace-regexp-in-string+ "\n$" ""+ (intero-blocking-call+ 'backend+ (format ":uses %S %d %d %d %d %S"+ (buffer-file-name)+ (save-excursion (goto-char beg)+ (line-number-at-pos))+ (save-excursion (goto-char beg)+ (1+ (current-column)))+ (save-excursion (goto-char end)+ (line-number-at-pos))+ (save-excursion (goto-char end)+ (1+ (current-column)))+ (buffer-substring-no-properties beg end)))))++(defun intero-get-completions (prefix)+ "Get completions for a PREFIX."+ (mapcar #'read+ (cdr (split-string+ (intero-blocking-call+ 'backend+ (format ":complete repl %S" prefix))+ "\n"+ t))))++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;+;; Process communication++(defun intero-delete-worker (worker)+ "Delete the given worker."+ (when (intero-buffer-p worker)+ (with-current-buffer (intero-get-buffer-create worker)+ (when (get-buffer-process (current-buffer))+ (setq intero-deleting t)+ (kill-process (get-buffer-process (current-buffer)))+ (delete-process (get-buffer-process (current-buffer))))+ (kill-buffer (current-buffer)))))++(defun intero-blocking-call (worker cmd)+ "Make a synchronous call of CMD to the process."+ (let ((result (list nil)))+ (intero-async-call+ worker+ cmd+ result+ (lambda (result reply)+ (setf (car result) reply)))+ (with-current-buffer (intero-buffer worker)+ (while (not (null intero-callbacks))+ (sleep-for 0.0001)))+ (car result)))++(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")))++(defun intero-buffer (worker)+ "Get the worker buffer for the current directory."+ (let ((buffer (intero-get-buffer-create worker)))+ (if (get-buffer-process buffer)+ buffer+ (intero-get-worker-create worker nil (current-buffer)))))++(defun intero-process (worker)+ "Get the worker process for the current directory."+ (get-buffer-process (intero-buffer worker)))++(defun intero-get-worker-create (worker &optional targets source-buffer)+ "Start an Intero worker."+ (let* ((buffer (intero-get-buffer-create worker)))+ (if (get-buffer-process buffer)+ buffer+ (if (intero-installed-p)+ (intero-start-process-in-buffer buffer targets source-buffer)+ (intero-auto-install buffer targets source-buffer)))))++(defun intero-auto-install (buffer &optional targets source-buffer)+ "Automatically install Intero."+ (let ((source-buffer (or source-buffer (current-buffer))))+ (switch-to-buffer buffer)+ (erase-buffer)+ (insert "Intero is not installed in the Stack environment.++Installing automatically ...++")+ (redisplay)+ (cl-case (call-process "stack" nil (current-buffer) t "build" 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!++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.+"+ 'face 'compilation-error))))))++(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))++(defun intero-make-options-list (targets)+ "Make the stack ghci options list."+ (append (list "--with-ghc"+ "intero"+ "--docker-run-args=--interactive=true --tty=false"+ "--no-load"+ "--no-build")+ (let ((dir (make-temp-file "intero" t)))+ (list "--ghci-options"+ (format "%S" (concat "-odir=" dir))+ "--ghci-options"+ (format "%S" (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)))))++(defun intero-installed-p ()+ "Is intero installed in the stack environment?"+ (redisplay)+ (= 0 (call-process "stack" nil nil nil "exec" "--" "intero" "--version")))++(defun intero-show-process-problem (process change)+ "Show the user that a CHANGE occurred on PROCESS, causing it to+end."+ (message "Problem with Intero!")+ (switch-to-buffer (process-buffer process))+ (goto-char (point-max))+ (insert "\n---\n\n")+ (insert+ (propertize+ (concat+ "This is the buffer where Emacs talks to intero. It's normally hidden,+but a problem occcured.++It may be obvious if there is some text above this message+indicating a problem.++The process ended. Here is the reason that Emacs gives us:++"+ " " change+ "\n"+ "For troubleshooting purposes, here are the arguments used to launch intero:++"+ (format " stack ghci %s"+ (mapconcat #'identity+ intero-arguments+ " "))+ "++After fixing this problem, you could switch back to your code and+run M-x intero-restart to try again.++You can kill this buffer when you're done reading it.\n")+ 'face 'compilation-error)))++(defun intero-read-buffer ()+ "In the process buffer, we read what's in it."+ (let ((repeat t))+ (while repeat+ (setq repeat nil)+ (goto-char (point-min))+ (when (search-forward "\4" (point-max) t 1)+ (let* ((next-callback (pop intero-callbacks))+ (state (nth 0 next-callback))+ (func (nth 1 next-callback)))+ (let ((string (buffer-substring (point-min) (1- (point)))))+ (if next-callback+ (progn (with-temp-buffer+ (funcall func state string))+ (setq repeat t))+ (when debug-on-error+ (warn "Received output but no callback in `intero-callbacks': %S"+ string)))))+ (delete-region (point-min) (point))))))++(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))+ (buffer-name (intero-buffer-name worker))+ (default-directory (file-name-directory cabal-file)))+ (with-current-buffer+ (get-buffer-create buffer-name)+ (setq intero-package-name package-name)+ (cd default-directory)+ (current-buffer))))++(defun intero-buffer-p (worker)+ "Does a buffer exist for a given worker?"+ (get-buffer (intero-buffer-name worker)))++(defun intero-buffer-name (worker)+ "For a given WORKER, create a buffer name."+ (let* ((root (intero-project-root))+ (package-name (intero-package-name)))+ (concat " intero:"+ (format "%s" worker)+ ":"+ package-name+ " "+ root)))++(defun intero-project-root ()+ "Get the directory where the stack.yaml is placed for this+project, or the global one."+ (if intero-project-root+ intero-project-root+ (setq intero-project-root+ (with-temp-buffer+ (save-excursion+ (call-process "stack" nil+ (current-buffer)+ nil+ "path"+ "--project-root"+ "--verbosity" "silent"))+ (buffer-substring (line-beginning-position) (line-end-position))))))++(defun intero-package-name (&optional cabal-file)+ "Get the current package name from a nearby .cabal file. If+there is none, return empty string."+ (or intero-package-name+ (setq intero-package-name+ (let ((cabal-file (or cabal-file+ (intero-cabal-find-file))))+ (if cabal-file+ (replace-regexp-in-string+ ".cabal$" ""+ (file-name-nondirectory cabal-file))+ "")))))++(defun intero-cabal-find-file (&optional dir)+ "Search for package description file upwards starting from DIR.+If DIR is nil, `default-directory' is used as starting point for+directory traversal. Upward traversal is aborted if file owner+changes. Uses `intero-cabal-find-pkg-desc' internally."+ (let ((use-dir (or dir default-directory)))+ (while (and use-dir (not (file-directory-p use-dir)))+ (setq use-dir (file-name-directory (directory-file-name use-dir))))+ (when use-dir+ (catch 'found+ (let ((user (nth 2 (file-attributes use-dir)))+ ;; Abbreviate, so as to stop when we cross ~/.+ (root (abbreviate-file-name use-dir)))+ ;; traverse current dir up to root as long as file owner doesn't change+ (while (and root (equal user (nth 2 (file-attributes root))))+ (let ((cabal-file (intero-cabal-find-pkg-desc root)))+ (when cabal-file+ (throw 'found cabal-file)))++ (let ((proot (file-name-directory (directory-file-name root))))+ (if (equal proot root) ;; fix-point reached?+ (throw 'found nil)+ (setq root proot))))+ nil)))))++(defun intero-cabal-find-pkg-desc (dir &optional allow-multiple)+ "Find a package description file in the directory DIR.+Returns nil if none or multiple \".cabal\" files were found. If+ALLOW-MULTIPLE is non nil, in case of multiple \".cabal\" files,+a list is returned instead of failing with a nil result."+ ;; This is basically a port of Cabal's+ ;; Distribution.Simple.Utils.findPackageDesc function+ ;; http://hackage.haskell.org/packages/archive/Cabal/1.16.0.3/doc/html/Distribution-Simple-Utils.html+ ;; but without the exception throwing.+ (let* ((cabal-files+ (cl-remove-if 'file-directory-p+ (cl-remove-if-not 'file-exists-p+ (directory-files dir t ".\\.cabal\\'")))))+ (cond+ ((= (length cabal-files) 1) (car cabal-files)) ;; exactly one candidate found+ (allow-multiple cabal-files) ;; pass-thru multiple candidates+ (t nil))))++;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;++(provide 'intero)++;;; intero.el ends here
intero.cabal view
@@ -1,7 +1,7 @@ name: intero version:- 0.1.8+ 0.1.9 synopsis: Complete interactive development program for Haskell license:@@ -32,6 +32,8 @@ cbits/PosixSource.h CHANGELOG README.md+data-files:+ elisp/*.el source-repository head type: git@@ -66,7 +68,7 @@ bytestring, directory, filepath,- ghc >= 7.8 && <= 7.10.3,+ ghc >= 7.8 && <= 8.0.1, ghc-paths, haskeline, process,@@ -74,6 +76,12 @@ syb, containers, time++ if impl(ghc>=8.0.1)+ build-depends:+ ghci,+ ghc-boot-th+ if os(windows) build-depends: Win32@@ -98,4 +106,5 @@ temporary, process, transformers,- directory+ directory,+ regex-compat
src/GhciFind.hs view
@@ -9,6 +9,7 @@ (findType,FindType(..),findLoc,findNameUses) where +import Module import Control.Exception import Data.List import Data.Map (Map)@@ -184,7 +185,9 @@ Just modL -> do case M.lookup (moduleName modL) infos of Nothing ->-#if __GLASGOW_HASKELL__ >= 709+#if __GLASGOW_HASKELL__ >= 800+ do (return (Left (unitIdString (moduleUnitId modL) ++ ":" +++#elif __GLASGOW_HASKELL__ >= 709 do (return (Left (showppr d (modulePackageKey modL) ++ ":" ++ #else do (return (Left (showppr d (modulePackageId modL) ++ ":" ++
src/GhciInfo.hs view
@@ -133,7 +133,11 @@ Nothing -> return Nothing Just expr -> return (Just (case unwrapVar (unLoc e) of+#if __GLASGOW_HASKELL__ >= 800+ HsVar (L _ i) -> Just i+#else HsVar i -> Just i+#endif _ -> Nothing ,getLoc e ,CoreUtils.exprType expr))@@ -145,8 +149,13 @@ => TypecheckedModule -> LPat Id -> m (Maybe (Maybe Id,SrcSpan,Type)) getTypeLPat _ (L spn pat) = return (Just (getMaybeId pat,spn,hsPatType pat))- where getMaybeId (VarPat vid) = Just vid- getMaybeId _ = Nothing+ where+#if __GLASGOW_HASKELL__ >= 800+ getMaybeId (VarPat (L _ vid)) = Just vid+#else+ getMaybeId (VarPat vid) = Just vid+#endif+ getMaybeId _ = Nothing -- | Get ALL source spans in the source. listifyAllSpans :: Typeable a
src/GhciMonad.hs view
@@ -2,7 +2,7 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-cse -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-cse -fno-warn-orphans -fno-warn-warnings-deprecations #-} -- -fno-cse is needed for GLOBAL_VAR's to behave properly -----------------------------------------------------------------------------@@ -34,7 +34,6 @@ -- ghci-ng import GhciTypes import Data.Map.Strict (Map)- import qualified GHC import GhcMonad hiding (liftIO) import Outputable hiding (printForUser, printForUserPartWay)@@ -44,7 +43,12 @@ import HscTypes import SrcLoc import Module+#if __GLASGOW_HASKELL__ >= 800+import GHCi.ObjLink as ObjLink+import GHC (BreakIndex)+#else import ObjLink+#endif import Linker import Exception@@ -383,9 +387,17 @@ initInterpBuffering :: Ghc () initInterpBuffering = do -- make sure these are linked+#if __GLASGOW_HASKELL__ < 800 dflags <- GHC.getSessionDynFlags+#else+ hscEnv <- getSession+#endif liftIO $ do+#if __GLASGOW_HASKELL__ >= 800+ initDynLinker hscEnv+#else initDynLinker dflags+#endif -- ToDo: we should really look up these names properly, but -- it's a fiddle and not all the bits are exposed via the GHC
src/InteractiveUI.hs view
@@ -26,6 +26,10 @@ #include "HsVersions.h" -- Intero+#if __GLASGOW_HASKELL__ >= 800+import GHCi+import GHCi.RemoteTypes+#endif import qualified Paths_intero import Data.Version (showVersion) import qualified Data.Map as M@@ -35,100 +39,109 @@ import GHC (getModuleGraph) -- GHCi+#if __GLASGOW_HASKELL__ >= 800+import GHC.LanguageExtensions.Type+import GHCi.BreakArray as GHC+#endif import qualified GhciMonad ( args, runStmt )-import GhciMonad hiding ( args, runStmt )-import GhciTags-import Debugger+import GhciMonad hiding ( args, runStmt )+import GhciTags+import Debugger -- The GHC interface-import DynFlags-import GhcMonad ( modifySession )+import DynFlags+import GhcMonad ( modifySession ) import qualified GHC import GHC ( LoadHowMuch(..), Target(..), TargetId(..), InteractiveImport(..), TyThing(..), Phase, BreakIndex, Resume, SingleStep, Ghc, handleSourceError )-import HsImpExp+import HsImpExp import HscTypes ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC, setInteractivePrintName )-import Module-import Name+import Module+import Name #if __GLASGOW_HASKELL__ < 709-import Packages ( trusted, getPackageDetails, exposed, exposedModules, pkgIdMap )+import Packages ( trusted, getPackageDetails, exposed, exposedModules, pkgIdMap ) #else-import Packages ( trusted, getPackageDetails, listVisibleModuleNames )+import Packages ( trusted, getPackageDetails, listVisibleModuleNames ) #endif-import PprTyThing-import RdrName ( getGRE_NameQualifier_maybes )-import SrcLoc+import PprTyThing+import RdrName ( getGRE_NameQualifier_maybes )+import SrcLoc import qualified Lexer -import StringBuffer+import StringBuffer #if __GLASGOW_HASKELL__ < 709-import UniqFM ( eltsUFM )+import UniqFM ( eltsUFM ) #endif-import Outputable hiding ( printForUser, printForUserPartWay, bold )+import Outputable hiding ( printForUser, printForUserPartWay, bold ) -- Other random utilities-import BasicTypes hiding ( isTopLevel )-import Config-import Digraph-import Encoding-import FastString-import Linker-import Maybes ( orElse, expectJust )-import NameSet-import Panic hiding ( showException )-import Util+import BasicTypes hiding ( isTopLevel )+import Config+import Digraph+import Encoding+import FastString+import Linker+import Maybes ( orElse, expectJust )+import NameSet+import Panic hiding ( showException )+import Util -- Haskell Libraries-import System.Console.Haskeline as Haskeline+import System.Console.Haskeline as Haskeline -import Control.Applicative hiding (empty)-import Control.Monad as Monad-import Control.Monad.Trans.Class-import Control.Monad.IO.Class+import Control.Applicative hiding (empty)+import Control.Monad as Monad+import Control.Monad.Trans.Class+import Control.Monad.IO.Class -import Data.Array+import Data.Array import qualified Data.ByteString.Char8 as BS-import Data.Char-import Data.Function-import Data.IORef ( IORef, readIORef, writeIORef )+import Data.Char+import Data.Function+import Data.IORef ( IORef, readIORef, writeIORef ) import Data.List ( find, group, intercalate, intersperse, isPrefixOf, nub, partition, sort, sortBy )-import Data.Maybe+import Data.Maybe -import Exception hiding (catch)+import Exception hiding (catch) -import Foreign.C+import Foreign.C #if __GLASGOW_HASKELL__ < 709-import Foreign.Safe+import Foreign.Safe #else-import Foreign+import Foreign #endif -import System.Directory-import System.Environment-import System.Exit ( exitWith, ExitCode(..) )-import System.FilePath-import System.IO-import System.IO.Error-import System.IO.Unsafe ( unsafePerformIO )-import System.Process-import Text.Printf-import Text.Read ( readMaybe )+import System.Directory+import System.Environment+import System.Exit ( exitWith, ExitCode(..) )+import System.FilePath+import System.IO+import System.IO.Error+import System.IO.Unsafe ( unsafePerformIO )+import System.Process+import Text.Printf+import Text.Read ( readMaybe ) #ifndef mingw32_HOST_OS-import System.Posix hiding ( getEnv )+import System.Posix hiding ( getEnv ) #else import qualified System.Win32 #endif -import GHC.Exts ( unsafeCoerce# )-import GHC.IO.Exception ( IOErrorType(InvalidArgument) )-import GHC.IO.Handle ( hFlushAll )-import GHC.TopHandler ( topHandler )+import GHC.Exts ( unsafeCoerce# )+import GHC.IO.Exception ( IOErrorType(InvalidArgument) )+import GHC.IO.Handle ( hFlushAll )+import GHC.TopHandler ( topHandler ) -#if __GLASGOW_HASKELL__ < 709+#if __GLASGOW_HASKELL__ >= 800+packageString :: UnitId -> String+packageString = unitIdString+modulePackage :: Module -> UnitId+modulePackage = moduleUnitId+#elif __GLASGOW_HASKELL__ < 709 packageString :: PackageId -> String packageString = packageIdString modulePackage :: Module -> PackageId@@ -405,6 +418,47 @@ default_args :: [String] default_args = [] ++#if __GLASGOW_HASKELL__ >= 800+compat_ExtendedDefaultRules :: Extension+compat_ExtendedDefaultRules =+ ExtendedDefaultRules+#else+compat_ExtendedDefaultRules :: ExtensionFlag+compat_ExtendedDefaultRules =+ Opt_ExtendedDefaultRules+#endif++#if __GLASGOW_HASKELL__ >= 800+compat_AlternativeLayoutRule :: Extension+compat_AlternativeLayoutRule =+ AlternativeLayoutRule+#else+compat_AlternativeLayoutRule :: ExtensionFlag+compat_AlternativeLayoutRule =+ Opt_AlternativeLayoutRule+#endif++#if __GLASGOW_HASKELL__ >= 800+compat_ImplicitPrelude :: Extension+compat_ImplicitPrelude =+ ImplicitPrelude+#else+compat_ImplicitPrelude :: ExtensionFlag+compat_ImplicitPrelude =+ Opt_ImplicitPrelude+#endif++#if __GLASGOW_HASKELL__ >= 800+compat_MonomorphismRestriction :: Extension+compat_MonomorphismRestriction =+ MonomorphismRestriction+#else+compat_MonomorphismRestriction :: ExtensionFlag+compat_MonomorphismRestriction =+ Opt_MonomorphismRestriction+#endif+ interactiveUI :: GhciSettings -> [(FilePath, Maybe Phase)] -> Maybe [String] -> Ghc () interactiveUI config srcs maybe_exprs = do@@ -434,8 +488,8 @@ -- as the global DynFlags, plus -XExtendedDefaultRules and -- -XNoMonomorphismRestriction. dflags <- getDynFlags- let dflags' = (`xopt_set` Opt_ExtendedDefaultRules)- . (`xopt_unset` Opt_MonomorphismRestriction)+ let dflags' = (`xopt_set` compat_ExtendedDefaultRules)+ . (`xopt_unset` compat_MonomorphismRestriction) $ dflags GHC.setInteractiveDynFlags dflags' @@ -451,8 +505,8 @@ -- intended for the program, so unbuffer stdin. hSetBuffering stdin NoBuffering hSetBuffering stderr NoBuffering-#if defined(mingw32_HOST_OS) -- On Unix, stdin will use the locale encoding. The IO library+#if defined(mingw32_HOST_OS) -- doesn't do this on Windows (yet), so for now we use UTF-8, -- for consistency with GHC 6.10 and to make the tests work. hSetEncoding stdin utf8@@ -460,7 +514,6 @@ default_editor <- liftIO $ findEditor - names <- GHC.getRdrNamesInScope startGHCi (runGHCi srcs maybe_exprs) GHCiState{ progname = default_progname, GhciMonad.args = default_args,@@ -482,7 +535,7 @@ short_help = shortHelpText config, long_help = fullHelpText config, mod_infos = M.empty,- rdrNamesInScope = names+ rdrNamesInScope = [] } return ()@@ -569,6 +622,10 @@ -- reset line number getGHCiState >>= \st -> setGHCiState st{line_number=1} + -- Get the names in scope+ names <- GHC.getRdrNamesInScope+ modifyGHCiState (\s -> s { rdrNamesInScope = names })+ case maybe_exprs of Nothing -> do@@ -867,7 +924,7 @@ -> InputT GHCi (Maybe String) checkInputForLayout stmt getStmt = do dflags' <- lift $ getDynFlags- let dflags = xopt_set dflags' Opt_AlternativeLayoutRule+ let dflags = xopt_set dflags' compat_AlternativeLayoutRule st0 <- lift $ getGHCiState let buf' = stringToStringBuffer stmt loc = mkRealSrcLoc (fsLit (progname st0)) (line_number st0) 1@@ -1536,20 +1593,32 @@ setGHCContextFromGHCiState +-- keepPackageImports :: [InteractiveImport] -> GHCi [InteractiveImport]+-- keepPackageImports = filterM is_pkg_import+-- where+-- is_pkg_import :: InteractiveImport -> GHCi Bool+-- is_pkg_import (IIModule _) = return False+-- is_pkg_import (IIDecl d)+-- = do e <- gtry $ GHC.findModule mod_name (ideclPkgQual d)+-- case e :: Either SomeException Module of+-- Left _ -> return False+-- Right m -> return (not (isHomeModule m))+-- where+-- mod_name = unLoc (ideclName d)+ keepPackageImports :: [InteractiveImport] -> GHCi [InteractiveImport] keepPackageImports = filterM is_pkg_import where is_pkg_import :: InteractiveImport -> GHCi Bool is_pkg_import (IIModule _) = return False is_pkg_import (IIDecl d)- = do e <- gtry $ GHC.findModule mod_name (ideclPkgQual d)+ = do e <- gtry $ GHC.findModule mod_name (fmap sl_fs $ ideclPkgQual d) case e :: Either SomeException Module of Left _ -> return False Right m -> return (not (isHomeModule m)) where mod_name = unLoc (ideclName d) - modulesLoadedMsg :: SuccessFlag -> [Module] -> InputT GHCi () modulesLoadedMsg ok mods = do dflags <- getDynFlags@@ -1873,13 +1942,26 @@ -- Guess which module the user wants to browse. Pick -- modules that are interpreted first. The most -- recently-added module occurs last, it seems.+-- guessCurrentModule cmd+-- = do imports <- GHC.getContext+-- when (null imports) $ throwGhcException $+-- CmdLineError (':' : cmd ++ ": no current module")+-- case (head imports) of+-- IIModule m -> GHC.findModule m Nothing+-- IIDecl d -> GHC.findModule (unLoc (ideclName d)) (ideclPkgQual d)+++-- Guess which module the user wants to browse. Pick+-- modules that are interpreted first. The most+-- recently-added module occurs last, it seems. guessCurrentModule cmd = do imports <- GHC.getContext when (null imports) $ throwGhcException $ CmdLineError (':' : cmd ++ ": no current module") case (head imports) of IIModule m -> GHC.findModule m Nothing- IIDecl d -> GHC.findModule (unLoc (ideclName d)) (ideclPkgQual d)+ IIDecl d -> GHC.findModule (unLoc (ideclName d))+ (fmap sl_fs $ ideclPkgQual d) -- without bang, show items in context of their parents and omit children -- with bang, show class methods and data constructors separately, and@@ -2065,6 +2147,22 @@ -- Validate a module that we want to add to the context checkAdd :: InteractiveImport -> GHCi ()+-- checkAdd ii = do+-- dflags <- getDynFlags+-- let safe = safeLanguageOn dflags+-- case ii of+-- IIModule modname+-- | safe -> throwGhcException $ CmdLineError "can't use * imports with Safe Haskell"+-- | otherwise -> wantInterpretedModuleName modname >> return ()++-- IIDecl d -> do+-- let modname = unLoc (ideclName d)+-- pkgqual = ideclPkgQual d+-- m <- GHC.lookupModule modname pkgqual+-- when safe $ do+-- t <- GHC.isModuleTrusted m+-- when (not t) $ throwGhcException $ ProgramError $ ""+ checkAdd ii = do dflags <- getDynFlags let safe = safeLanguageOn dflags@@ -2076,7 +2174,7 @@ IIDecl d -> do let modname = unLoc (ideclName d) pkgqual = ideclPkgQual d- m <- GHC.lookupModule modname pkgqual+ m <- GHC.lookupModule modname (fmap sl_fs pkgqual) when safe $ do t <- GHC.isModuleTrusted m when (not t) $ throwGhcException $ ProgramError $ ""@@ -2108,7 +2206,7 @@ iidecls <- filterM (tryBool.checkAdd) (transient_ctx st ++ remembered_ctx st) dflags <- GHC.getSessionDynFlags GHC.setContext $- if xopt Opt_ImplicitPrelude dflags && not (any isPreludeImport iidecls)+ if xopt compat_ImplicitPrelude dflags && not (any isPreludeImport iidecls) then iidecls ++ [implicitPreludeImport] else iidecls -- XXX put prel at the end, so that guessCurrentModule doesn't pick it up.@@ -2251,7 +2349,7 @@ nest 2 (vcat (map (setting gopt) others)) putStrLn $ showSDoc dflags $ text "warning settings:" $$- nest 2 (vcat (map (setting wopt) DynFlags.fWarningFlags))+ nest 2 (vcat (map (setting wopt) compat_warningFlags)) where #if __GLASGOW_HASKELL__ < 709 setting test (str, f, _)@@ -2282,6 +2380,11 @@ , Opt_BreakOnError , Opt_PrintEvldWithShow ]+#if __GLASGOW_HASKELL__ < 800+ compat_warningFlags = DynFlags.fWarningFlags+#else+ compat_warningFlags = DynFlags.wWarningFlags+#endif setArgs, setOptions :: [String] -> GHCi () setProg, setEditor, setStop :: String -> GHCi ()@@ -2380,7 +2483,12 @@ "package flags have changed, resetting and loading new packages..." GHC.setTargets [] _ <- GHC.load LoadAllTargets- liftIO $ linkPackages dflags2 new_pkgs+#if __GLASGOW_HASKELL__ < 800+ linkinfo <- return dflags2+#else+ linkinfo <- GHC.getSession+#endif+ liftIO $ linkPackages linkinfo new_pkgs -- package flags changed, we can't re-use any of the old context setContextAfterLoad False [] -- and copy the package state to the interactive DynFlags@@ -2509,7 +2617,7 @@ prel_imp | any isPreludeImport (rem_ctx ++ trans_ctx) = []- | not (xopt Opt_ImplicitPrelude dflags) = []+ | not (xopt compat_ImplicitPrelude dflags) = [] | otherwise = ["import Prelude -- implicit"] trans_comment s = s ++ " -- added automatically"@@ -2585,16 +2693,24 @@ -- This flag now has more info about module renaming. -- @see -- https://downloads.haskell.org/~ghc/latest/docs/html/libraries/ghc-7.10.1/DynFlags.html#v:ExposePackage+#if __GLASGOW_HASKELL__ >= 800+ showFlag (ExposePackage _str arg _mr) = text $ " -package " ++ show arg+#else showFlag (ExposePackage arg mr) = text $ " -package " ++ show arg ++ " " ++ show mr #endif+#endif showFlag (HidePackage p) = text $ " -hide-package " ++ p+#if __GLASGOW_HASKELL__ < 800 showFlag (IgnorePackage p) = text $ " -ignore-package " ++ p+#endif #if __GLASGOW_HASKELL__ < 709 -- This flag just isn't in the 7.10 API showFlag (ExposePackageId p) = text $ " -package-id " ++ p #endif+#if __GLASGOW_HASKELL__ < 800 showFlag (TrustPackage p) = text $ " -trust " ++ p showFlag (DistrustPackage p) = text $ " -distrust " ++ p+#endif showPaths :: GHCi () showPaths = do@@ -2763,11 +2879,11 @@ completeSetOptions = wrapCompleter flagWordBreakChars $ \w -> do return (filter (w `isPrefixOf`) opts) where opts = "args":"prog":"prompt":"prompt2":"editor":"stop":flagList- flagList = map head $ group $ sort allFlags+ flagList = map head $ group $ sort compat_allFlags completeSeti = wrapCompleter flagWordBreakChars $ \w -> do return (filter (w `isPrefixOf`) flagList)- where flagList = map head $ group $ sort allFlags+ where flagList = map head $ group $ sort compat_allFlags completeShowOptions = wrapCompleter flagWordBreakChars $ \w -> do return (filter (w `isPrefixOf`) opts)@@ -2945,7 +3061,11 @@ backCmd :: String -> GHCi () backCmd = noArgs $ withSandboxOnly ":back" $ do+#if __GLASGOW_HASKELL__ < 800 (names, _, pan) <- GHC.back+#else+ (names, _, pan, _) <- GHC.back 1+#endif printForUser $ ptext (sLit "Logged breakpoint at") <+> ppr pan printTypeOfNames names -- run the command set with ":set stop <cmd>"@@ -2954,7 +3074,11 @@ forwardCmd :: String -> GHCi () forwardCmd = noArgs $ withSandboxOnly ":forward" $ do+#if __GLASGOW_HASKELL__ >= 800+ (names, ix, pan, _ ) <- GHC.forward 1+#else (names, ix, pan) <- GHC.forward+#endif printForUser $ (if (ix == 0) then ptext (sLit "Stopped at") else ptext (sLit "Logged breakpoint at")) <+> ppr pan@@ -3023,7 +3147,7 @@ case lookupTickTree tickArray of Nothing -> liftIO $ putStrLn $ "No breakpoints found at that location." Just (tick, pan) -> do- success <- liftIO $ setBreakFlag dflags True breakArray tick+ success <- setBreakFlag dflags True breakArray tick if success then do (alreadySet, nm) <-@@ -3308,9 +3432,13 @@ turnOffBreak loc = do dflags <- getDynFlags (arr, _) <- getModBreak (breakModule loc)- liftIO $ setBreakFlag dflags False arr (breakTick loc)+ setBreakFlag dflags False arr (breakTick loc) -getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan)+#if __GLASGOW_HASKELL__ >= 800+getModBreak :: Module -> GHCi (ForeignRef BreakArray, Array Int SrcSpan)+#else+getModBreak :: GHC.GhcMonad m => Module -> m (GHC.BreakArray, Array BreakIndex SrcSpan)+#endif getModBreak m = do Just mod_info <- GHC.getModuleInfo m let modBreaks = GHC.modInfoModBreaks mod_info@@ -3318,10 +3446,18 @@ let ticks = GHC.modBreaks_locs modBreaks return (arr, ticks) -setBreakFlag :: DynFlags -> Bool -> GHC.BreakArray -> Int -> IO Bool+#if __GLASGOW_HASKELL__ >= 800+setBreakFlag :: DynFlags -> Bool -> ForeignRef BreakArray -> Int -> GHCi Bool+setBreakFlag _ toggle arr i = do+ hsc_env <- GHC.getSession+ liftIO $ enableBreakpoint hsc_env arr i toggle+ return True+#else+setBreakFlag :: DynFlags -> Bool -> GHC.BreakArray -> Int -> GHCi Bool setBreakFlag dflags toggle arr i- | toggle = GHC.setBreakOn dflags arr i- | otherwise = GHC.setBreakOff dflags arr i+ | toggle = liftIO $ GHC.setBreakOn dflags arr i+ | otherwise = liftIO $ GHC.setBreakOff dflags arr i+#endif -- ---------------------------------------------------------------------------@@ -3350,7 +3486,7 @@ -- omit the location for CmdLineError: Just (CmdLineError s) -> putException s -- ditto:- Just ph@(PhaseFailed {}) -> putException (showGhcException ph "")+ -- Just ph@(PhaseFailed {}) -> putException (showGhcException ph "") Just other_ghc_ex -> putException (show other_ghc_ex) Nothing -> case fromException se of@@ -3392,7 +3528,9 @@ lookupModuleName mName = GHC.lookupModule mName Nothing isHomeModule :: Module -> Bool-#if __GLASGOW_HASKELL__ < 709+#if __GLASGOW_HASKELL__ >= 800+isHomeModule m = modulePackage m == mainUnitId+#elif __GLASGOW_HASKELL__ < 709 isHomeModule m = modulePackage m == mainPackageId #else isHomeModule m = modulePackage m == mainPackageKey@@ -3448,3 +3586,16 @@ then noCanDo n $ text "module " <> ppr modl <> text " is not interpreted" else and_then n++#if __GLASGOW_HASKELL__ < 800+sl_fs :: a -> a+sl_fs = id+#endif+++compat_allFlags :: [String]+#if __GLASGOW_HASKELL__ < 800+compat_allFlags = allFlags+#else+compat_allFlags = allNonDeprecatedFlags+#endif
src/Main.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE CPP #-}-{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}+{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE -fno-warn-warnings-deprecations #-} {-# LANGUAGE ForeignFunctionInterface #-} -----------------------------------------------------------------------------@@ -661,7 +661,7 @@ haskellish (f,Nothing) = looksLikeModuleName f || isHaskellUserSrcFilename f || '.' `notElem` f haskellish (_,Just phase) =- phase `notElem` [as True, Cc, Cobjc, Cobjcpp, CmmCpp, Cmm, StopLn]+ phase `notElem` [as True, Cc, Cobjc, CmmCpp, Cmm, StopLn] hsc_env <- GHC.getSession @@ -853,7 +853,7 @@ where oneError f = "unrecognised flag: " ++ f ++ "\n" ++- (case fuzzyMatch f (nub allFlags) of+ (case fuzzyMatch f (nub compat_allFlags) of [] -> "" suggs -> "did you mean one of:\n" ++ unlines (map (" " ++) suggs)) @@ -886,4 +886,11 @@ as = As #else as _ = As+#endif++compat_allFlags :: [String]+#if __GLASGOW_HASKELL__ < 800+compat_allFlags = allFlags+#else+compat_allFlags = allNonDeprecatedFlags #endif
src/test/Main.hs view
@@ -10,6 +10,7 @@ import System.IO.Temp import System.Process import Test.Hspec+import Text.Regex -- | Main entry point. main :: IO ()@@ -29,6 +30,7 @@ use definition bytecode+ completion -- | Argument parsing should be user-friendly. argsparser :: Spec@@ -49,9 +51,13 @@ basics :: Spec basics = describe "Basics"- (do it ":t 1" (eval ":t 1" "1 :: Num a => a\n")+ (do it ":t 1" (eval ":t 1 :: Num a => a" "1 :: Num a => a :: Num a => a\n") it ":i Nothing"- (eval ":i Nothing" "data Maybe a = Nothing | ... \t-- Defined in ‘GHC.Base’\n")+ (do reply <-+ withIntero []+ (\_ repl -> repl ":i Nothing")+ shouldBe (subRegex (mkRegex "Data.Maybe") reply "GHC.Base")+ "data Maybe a = Nothing | ... \t-- Defined in ‘GHC.Base’\n") it ":k Just" (eval ":k Maybe" "Maybe :: * -> *\n")) -- | Loading files and seeing the results.@@ -73,9 +79,11 @@ (do result <- withIntero [] (\_ repl -> repl (":l NonExistent.hs"))- shouldBe result (unlines ["Failed, modules loaded: none."- ,""- ,"<no location info>: can't find file: NonExistent.hs"])))+ shouldBe (stripError result)+ (unlines ["Failed, modules loaded: none."+ ,""+ ,"<no location info>: can't find file: NonExistent.hs"])))+ where stripError = \i -> subRegex (mkRegex "error: ") i "" -- | Check things when in -fbyte-code mode. bytecode :: Spec@@ -175,20 +183,24 @@ (do it ":uses X.hs 1 1 1 1 x -- from definition site" (uses "x = 'a' : x" (1,1,1,1,"x")+ id (unlines ["X.hs:(1,1)-(1,2)" ,"X.hs:(1,1)-(1,2)" ,"X.hs:(1,11)-(1,12)"])) it ":uses X.hs 1 11 1 12 x -- from use site" (uses "x = 'a' : x" (1,11,1,12,"x")+ id (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 "x = id" (1,5,1,6,"id")- (unlines ["base-4.8.2.0:GHC.Base"]))+ (\i -> subRegex (mkRegex "-[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+") i "")+ (unlines ["base:GHC.Base"])) it ":uses X.hs 1 5 1 6 id -- shadowed package definition" (uses "x = id where id = ()" (1,5,1,7,"id")+ id (unlines ["X.hs:(1,14)-(1,16)" ,"X.hs:(1,14)-(1,16)" ,"X.hs:(1,5)-(1,7)"])))@@ -214,6 +226,18 @@ (1,20,1,21,"x") (unlines ["X.hs:(1,9)-(1,10)"]))) +-- | Test interactive completions.+completion :: Spec+completion =+ describe "Complete basic Prelude identifiers"+ (issue ":complete repl \"put\""+ "https://github.com/chrisdone/intero/issues/34"+ (eval ":complete repl \"put\""+ (unlines ["3 3 \"\""+ ,"\"putChar\""+ ,"\"putStr\""+ ,"\"putStrLn\""])))+ -------------------------------------------------------------------------------- -- Combinators for running and interacting with intero @@ -235,8 +259,8 @@ -- | Find use-sites for the given place. uses- :: String -> (Int,Int,Int,Int,String) -> String -> Expectation-uses file (line,col,line',col',name) expected =+ :: String -> (Int,Int,Int,Int,String) -> (String -> String) -> String -> Expectation+uses file (line,col,line',col',name) preprocess expected = do result <- withIntero []@@ -245,7 +269,7 @@ _ <- repl (":l X.hs") repl (":uses X.hs " ++ unwords (map show [line,col,line',col']) ++ " " ++ name))- shouldBe result expected+ shouldBe (preprocess result) expected -- | Test the type at the given place. typeAt