Skip to content

Add hayoo backend for suggesting imports. #358

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 9 commits into from
Closed

Add hayoo backend for suggesting imports. #358

Changes from all commits
Commits
Show all changes
9 commits
Select commit Hold shift + click to select a range
feeb964
Add hayoo backend for suggesting imports.
alexanderkjeldaas Oct 14, 2014
fa7762c
Fixed typo and moved suggested-already.
alexanderkjeldaas Oct 14, 2014
070cb97
Add dummy defvars.
alexanderkjeldaas Oct 14, 2014
c69ab36
require json
alexanderkjeldaas Oct 14, 2014
40b42c2
Simplify and fixes.
alexanderkjeldaas Oct 15, 2014
6024018
Removed debug setqs.
alexanderkjeldaas Oct 15, 2014
06ba365
Use lexical-let.
alexanderkjeldaas Oct 15, 2014
f08177d
Require 'cl during compilation for lexical-let.
alexanderkjeldaas Oct 16, 2014
4059f7a
Merge remote-tracking branch 'origin/master' into add-hayoo-ident
alexanderkjeldaas Oct 16, 2014
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
137 changes: 73 additions & 64 deletions haskell-process.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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."
Expand Down Expand Up @@ -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)))))
Expand All @@ -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
Expand Down Expand Up @@ -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)
Expand Down