diff --git a/haskell-process.el b/haskell-process.el index 402de0a98..1387166cc 100644 --- a/haskell-process.el +++ b/haskell-process.el @@ -28,6 +28,10 @@ ;;; Code: (require 'cl-lib) +;; For lexical-let. TODO: Remove when converting to lexical bindings +(eval-when-compile (require 'cl)) +(require 'json) +(require 'url-util) (require 'haskell-complete-module) (require 'haskell-mode) (require 'haskell-session) @@ -139,6 +143,18 @@ See `haskell-process-do-cabal' for more details." :type 'boolean :group 'haskell-interactive) +(defcustom haskell-process-suggest-hayoo-imports + nil + "Suggest to add import statements using Hayoo as a backend." + :type 'boolean + :group 'haskell-interactive) + +(defcustom haskell-process-hayoo-query-url + "http://hayoo.fh-wedel.de/json/?query=%s" + "Query url for json hayoo results." + :type 'string + :group 'haskell-interactive) + (defcustom haskell-process-suggest-haskell-docs-imports nil "Suggest to add import statements using haskell-docs as a backend." @@ -838,10 +854,19 @@ from `module-buffer'." (when haskell-process-suggest-overloaded-strings (haskell-process-suggest-pragma session "LANGUAGE" "OverloadedStrings" file))) ((string-match "^Not in scope: .*[‘`‛]\\(.+\\)['’]$" msg) - (when haskell-process-suggest-hoogle-imports - (haskell-process-suggest-hoogle-imports session msg file)) - (when haskell-process-suggest-haskell-docs-imports - (haskell-process-suggest-haskell-docs-imports session msg file))) + (let* ((match1 (match-string 1 msg)) + (ident (if (string-match "^[A-Za-z0-9_'.]+\\.\\(.+\\)$" match1) + ;; Skip qualification. + (match-string 1 match1) + match1))) + (when haskell-process-suggest-hoogle-imports + (let ((modules (haskell-process-hoogle-ident ident))) + (haskell-process-suggest-imports session file modules ident))) + (when haskell-process-suggest-hayoo-imports + (haskell-process-hayoo-ident session file ident #'haskell-process-suggest-imports)) + (when haskell-process-suggest-haskell-docs-imports + (let ((modules (haskell-process-haskell-docs-ident ident))) + (haskell-process-suggest-imports session file modules ident))))) ((string-match "^[ ]+It is a member of the hidden package [‘`‛]\\(.+\\)['’].$" msg) (when haskell-process-suggest-add-package (haskell-process-suggest-add-package session msg))))) @@ -860,68 +885,25 @@ from `module-buffer'." cabal-file)) (haskell-cabal-add-dependency package-name version nil t)))) -(defun haskell-process-suggest-hoogle-imports (session msg file) - "Given an out of scope identifier, Hoogle for that identifier, -and if a result comes back, suggest to import that identifier -now." +(defun haskell-process-suggest-imports (session file modules ident) + "Given a list of MODULES, suggest adding them to the import section." + (cl-assert session) + (cl-assert file) + (cl-assert ident) (let* ((process (haskell-session-process session)) (suggested-already (haskell-process-suggested-imports process)) - (ident (let ((i (match-string 1 msg))) - ;; Skip qualification. - (if (string-match "^[A-Za-z0-9_'.]+\\.\\(.+\\)$" i) - (match-string 1 i) - i))) - (modules (haskell-process-hoogle-ident ident)) - (module - (cond - ((> (length modules) 1) - (when (y-or-n-p (format "Identifier `%s' not in scope, choose module to import?" - ident)) - (haskell-complete-module-read "Module: " modules))) - ((= (length modules) 1) - (let ((module (car modules))) - (unless (member module suggested-already) - (haskell-process-set-suggested-imports process (cons module suggested-already)) - (when (y-or-n-p (format "Identifier `%s' not in scope, import `%s'?" - ident - module)) - module))))))) - (when module - (haskell-process-find-file session file) - (save-excursion - (goto-char (point-max)) - (haskell-navigate-imports) - (insert (read-from-minibuffer "Import line: " (concat "import " module)) - "\n") - (haskell-sort-imports) - (haskell-align-imports))))) - -(defun haskell-process-suggest-haskell-docs-imports (session msg file) - "Given an out of scope identifier, haskell-docs search for that identifier, -and if a result comes back, suggest to import that identifier -now." - (let* ((process (haskell-session-process session)) - (suggested-already (haskell-process-suggested-imports process)) - (ident (let ((i (match-string 1 msg))) - ;; Skip qualification. - (if (string-match "^[A-Za-z0-9_'.]+\\.\\(.+\\)$" i) - (match-string 1 i) - i))) - (modules (haskell-process-haskell-docs-ident ident)) - (module - (cond - ((> (length modules) 1) - (when (y-or-n-p (format "Identifier `%s' not in scope, choose module to import?" - ident)) - (haskell-complete-module-read "Module: " modules))) - ((= (length modules) 1) - (let ((module (car modules))) - (unless (member module suggested-already) - (haskell-process-set-suggested-imports process (cons module suggested-already)) - (when (y-or-n-p (format "Identifier `%s' not in scope, import `%s'?" - ident - module)) - module))))))) + (module (cond ((> (length modules) 1) + (when (y-or-n-p (format "Identifier `%s' not in scope, choose module to import?" + ident)) + (haskell-complete-module-read "Module: " modules))) + ((= (length modules) 1) + (let ((module (car modules))) + (unless (member module suggested-already) + (haskell-process-set-suggested-imports process (cons module suggested-already)) + (when (y-or-n-p (format "Identifier `%s' not in scope, import `%s'?" + ident + module)) + module))))))) (when module (haskell-process-find-file session file) (save-excursion @@ -952,6 +934,33 @@ now." (split-string (buffer-string) "\n")))))) +(defun haskell-process-hayoo-ident (session file ident callback) + "Hayoo for IDENT, returns a list of modules asyncronously through CALLBACK." + ;; We need a real/simulated closure, because otherwise these + ;; variables will be unbound when the url-retrieve callback is + ;; called. + ;; TODO: Remove when this code is converted to lexical bindings by + ;; default (Emacs 24.1+) + (lexical-let ((session session) + (file file) + (ident ident) + (callback callback)) + (url-retrieve + (format haskell-process-hayoo-query-url (url-hexify-string ident)) + (lambda (status) + (message "Hayoo server returned a result") + (re-search-forward "\r?\n\r?\n") + (let* ((res (json-read-object)) + (results (assoc-default 'result res)) + ;; TODO: gather packages as well, and when we choose a + ;; given import, check that we have the package in the + ;; cabal file as well. + (modules (cl-mapcan (lambda (r) + ;; append converts from vector -> list + (append (assoc-default 'resultModules r) nil)) + results))) + (funcall callback session file modules ident)))))) + (defun haskell-process-suggest-remove-import (session file import line) "Suggest removing or commenting out IMPORT on LINE." (let ((continue t)