intero 0.1.28 → 0.1.29
raw patch · 3 files changed
+138/−74 lines, 3 files
Files
- CHANGELOG +3/−0
- elisp/intero.el +134/−73
- intero.cabal +1/−1
CHANGELOG view
@@ -1,3 +1,6 @@+0.1.29:+ * Support GHC 8.4+ 0.1.27: * Add experimental :fill command.
elisp/intero.el view
@@ -70,7 +70,7 @@ :group 'haskell) (defcustom intero-package-version- "0.1.27"+ "0.1.28" "Package version to auto-install. This version does not necessarily have to be the latest version@@ -177,6 +177,7 @@ (add-hook 'completion-at-point-functions 'intero-completion-at-point nil t) (add-to-list (make-local-variable 'company-backends) 'intero-company) (company-mode)+ (setq-local company-minimum-prefix-length 1) (unless eldoc-documentation-function (setq-local eldoc-documentation-function #'ignore)) (add-function :before-until (local 'eldoc-documentation-function) #'intero-eldoc)@@ -803,9 +804,10 @@ line column type msg :checker checker- :buffer (when (intero-paths-for-same-file temp-file file)- buffer)- :filename (intero-buffer-file-name buffer))+ :buffer buffer+ :filename (if (intero-paths-for-same-file temp-file file)+ (intero-buffer-file-name buffer)+ file)) messages))) (forward-line -1)) (delete-dups@@ -870,6 +872,30 @@ (when completions (list beg end completions))))))) +(defun intero-repl-completion-at-point ()+ "A (blocking) function suitable for use in `completion-at-point-functions'.+Should only be used in the repl"+ (let* ((beg (save-excursion (intero-repl-beginning-of-line) (point)))+ (end (point))+ (str (buffer-substring-no-properties beg end))+ (repl-buffer (current-buffer))+ (proc (get-buffer-process (current-buffer))))+ (with-temp-buffer+ (comint-redirect-send-command-to-process+ (format ":complete repl %S" str) ;; command+ (current-buffer) ;; output buffer+ proc ;; target process+ nil ;; echo+ t) ;; no-display+ (while (not (with-current-buffer repl-buffer+ comint-redirect-completed))+ (sleep-for 0.01))+ (let* ((completions (intero-completion-response-to-list (buffer-string)))+ (first-line (car completions)))+ (when (string-match "[^ ]* [^ ]* " first-line) ;; "2 2 :load src/"+ (setq first-line (replace-match "" nil nil first-line))+ (list (+ beg (length first-line)) end (cdr completions)))))))+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Company integration (auto-completion) @@ -890,8 +916,9 @@ (unless (intero-gave-up 'backend) (or (let ((hole (intero-grab-hole))) (when hole- (goto-char (cdr hole))- (buffer-substring (car hole) (cdr hole))))+ (save-excursion+ (goto-char (cdr hole))+ (buffer-substring (car hole) (cdr hole))))) (let ((prefix-info (intero-completions-grab-prefix))) (when prefix-info (cl-destructuring-bind@@ -952,7 +979,6 @@ considered." (when (intero-completions-can-grab-prefix) (let ((prefix (cond- ((intero-completions-grab-ghci-command)) ((intero-completions-grab-pragma-prefix)) ((intero-completions-grab-identifier-prefix))))) (cond ((and minlen prefix)@@ -969,24 +995,6 @@ (backward-char) (not (looking-at-p (rx (| space line-end))))))))) -(defun intero-completions-grab-ghci-command ()- "Grab prefix for a ghci command like :set.-Returns (prefix-start-position prefix-end-position prefix-value prefix-type)"- (when (derived-mode-p 'intero-repl-mode)- (save-excursion- (let ((end (point)))- (when (save-excursion- (beginning-of-line)- (looking-at-p (rx (* " ")- ":set"- (* " "))))- (skip-syntax-backward "^ >")- (let ((start (point)))- (list start- end- (concat ":set " (buffer-substring-no-properties start end))- 'haskell-completions-repl-command)))))))- (defun intero-completions-grab-identifier-prefix () "Grab identifier prefix." (let ((pos-at-point (intero-ident-pos-at-point))@@ -1109,15 +1117,20 @@ (1+ (current-column)))) (list :buffer (current-buffer) :cont cont) (lambda (state reply)- (unless (or (string-match "^Couldn't guess" reply)- (string-match "^Unable to " reply))+ (if (or (string-match "^Couldn't guess" reply)+ (string-match "^Unable to " reply)+ (intero-parse-error reply))+ (funcall (plist-get state :cont) (list)) (with-current-buffer (plist-get state :buffer)- (let ((candidates (split-string- (replace-regexp-in-string- "\n$" ""- reply)- "[\r\n]")))- (funcall (plist-get state :cont) candidates))))))))+ (let ((candidates+ (split-string+ (replace-regexp-in-string+ "\n$" ""+ reply)+ "[\r\n]"+ t)))+ (when candidates+ (funcall (plist-get state :cont) candidates))))))))) (defun intero-grab-hole () "When user is at a hole _ or _foo, return the starting point of@@ -1125,7 +1138,7 @@ (let ((beg-end (intero-ident-pos-at-point))) (when beg-end (let ((string (buffer-substring-no-properties (car beg-end) (cdr beg-end))))- (when (string-match "^_" string)+ (when (string-match-p "^_" string) beg-end))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;@@ -1333,8 +1346,7 @@ (setq-local comint-prompt-regexp intero-prompt-regexp) (setq-local warning-suppress-types (cons '(undo discard-info) warning-suppress-types)) (setq-local comint-prompt-read-only t)- (add-hook 'completion-at-point-functions 'intero-completion-at-point nil t)- (add-to-list (make-local-variable 'company-backends) 'intero-company)+ (add-hook 'completion-at-point-functions 'intero-repl-completion-at-point nil t) (company-mode)) (defun intero-repl-mode-start (backend-buffer targets prompt-options stack-yaml)@@ -1690,8 +1702,8 @@ (intero-make-temp-file "intero" nil (concat "-TEMP." (if (buffer-file-name)- (file-name-extension (buffer-file-name))- "hs")))))+ (file-name-extension (buffer-file-name))+ "hs"))))) (puthash intero-temp-file-name (current-buffer) intero-temp-file-buffer-mapping)@@ -1705,8 +1717,8 @@ (intero-make-temp-file "intero" nil (concat "-STAGING." (if (buffer-file-name)- (file-name-extension (buffer-file-name))- "hs"))))))+ (file-name-extension (buffer-file-name))+ "hs")))))) (with-temp-file fname (insert contents)) fname)))@@ -2061,39 +2073,33 @@ (error "Intero process is not running: run M-x intero-restart to start it")))) (defun intero-network-call-sentinel (process event)- (let ((buf (process-buffer process)))- (cl-flet ((cleanup ()- (delete-process process)- (kill-buffer buf)))- (if (string= "open\n" event)- (let ((cmd- (with-current-buffer buf- (when intero-debug (message "Connected to service, sending %S" intero-async-network-cmd))- (setq intero-async-network-connected t)- (and intero-async-network-cmd- (concat intero-async-network-cmd "\n")))))- (if cmd- (process-send-string process cmd)- (cleanup)))- (with-current-buffer buf- (if intero-async-network-connected- (when intero-async-network-callback- (when intero-debug (message "Calling callback with %S" (buffer-string)))- (funcall intero-async-network-callback- intero-async-network-state- (buffer-string)))- ;; We didn't successfully connect, so let's fallback to the- ;; process pipe.+ (with-current-buffer (process-buffer process)+ (if (string= "open\n" event)+ (progn+ (when intero-debug (message "Connected to service, sending %S" intero-async-network-cmd))+ (setq intero-async-network-connected t)+ (if intero-async-network-cmd+ (process-send-string process (concat intero-async-network-cmd "\n"))+ (delete-process process)))+ (progn+ (if intero-async-network-connected (when intero-async-network-callback- (when intero-debug (message "Failed to connect, falling back ... "))- (setq intero-async-network-callback nil)- (intero-async-call- intero-async-network-worker- intero-async-network-cmd- intero-async-network-state- intero-async-network-callback))))+ (when intero-debug (message "Calling callback with %S" (buffer-string)))+ (funcall intero-async-network-callback+ intero-async-network-state+ (buffer-string)))+ ;; We didn't successfully connect, so let's fallback to the+ ;; process pipe.+ (when intero-async-network-callback+ (when intero-debug (message "Failed to connect, falling back ... "))+ (setq intero-async-network-callback nil)+ (intero-async-call+ intero-async-network-worker+ intero-async-network-cmd+ intero-async-network-state+ intero-async-network-callback))) ;; In any case we clean up the connection.- (cleanup)))))+ (delete-process process))))) (defun intero-async-call (worker cmd &optional state callback) "Send WORKER the command string CMD.@@ -2783,12 +2789,49 @@ (note nil)) ;; Messages of this format: ;;+ ;; • Constructor ‘Assert’ does not have the required strict field(s): assertName,+ ;; assertDoc, assertExpression,+ ;; assertSection+ (let ((start 0))+ (while (or+ (string-match "does not have the required strict field.*?:[\n\t\r ]" text start)+ (string-match "Fields of .*? not initialised:[\n\t\r ]" text start))+ (let* ((match-end (match-end 0))+ (fields+ (let ((reached-end nil))+ (mapcar+ (lambda (field)+ (with-temp-buffer+ (insert field)+ (goto-char (point-min))+ (intero-ident-at-point)))+ (cl-remove-if+ (lambda (field)+ (or reached-end+ (when (string-match "[\r\n]" field)+ (setq reached-end t)+ nil)))+ (split-string+ (substring text match-end)+ "[\n\t\r ]*,[\n\t\r ]*" t))))))+ (setq note t)+ (add-to-list+ 'intero-suggestions+ (list :type 'add-missing-fields+ :fields fields+ :line (flycheck-error-line msg)+ :column (flycheck-error-column msg)))+ (setq start (min (length text) (1+ match-end))))))++ ;; Messages of this format:+ ;; ;; Can't make a derived instance of ‘Functor X’: ;; You need DeriveFunctor to derive an instance for this class ;; Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension ;; In the newtype declaration for ‘X’ (let ((start 0))- (while (string-match extension-regex text start)+ (while (let ((case-fold-search nil))+ (string-match extension-regex text start)) (setq note t) (add-to-list 'intero-suggestions (list :type 'add-extension@@ -3025,6 +3068,15 @@ (plist-get suggestion :ident) (plist-get suggestion :module)) :default t))+ (add-missing-fields+ (list :key suggestion+ :default t+ :title+ (format "Add missing fields to record: %s"+ (mapconcat (lambda (ident)+ (concat "‘" ident "’"))+ (plist-get suggestion :fields)+ ", ")))) (redundant-import-item (list :key suggestion :title@@ -3157,7 +3209,16 @@ (forward-line (1- (plist-get suggestion :line))) (move-to-column (- (plist-get suggestion :column) 1)) (delete-char (length (plist-get suggestion :typo)))- (insert (plist-get suggestion :replacement))))))+ (insert (plist-get suggestion :replacement))))+ (add-missing-fields+ (save-excursion+ (goto-char (point-min))+ (forward-line (1- (plist-get suggestion :line)))+ (move-to-column (- (plist-get suggestion :column) 1))+ (search-forward "{")+ (insert (mapconcat (lambda (field) (concat field " = _"))+ (plist-get suggestion :fields)+ ", ")))))) ;; # Changes that do increase/decrease line numbers ;; ;; Remove redundant constraints
intero.cabal view
@@ -1,7 +1,7 @@ name: intero version:- 0.1.28+ 0.1.29 synopsis: Complete interactive development program for Haskell license: