Skip to content

Instantly share code, notes, and snippets.

@Altech

Altech/browse-function-document.el

Last active December 16, 2015 19:10
Show Gist options
  • Save Altech/5483138 to your computer and use it in GitHub Desktop.
Save Altech/5483138 to your computer and use it in GitHub Desktop.
Download ZIP
This command enable you to browse local Haskell document of the pointed function. It uses ghc-mod and hoogle-command.
Raw
browse-function-document.el
;; **requirements** :: hoogle(cabal), ghc-mod(cabal,elisp)
(defun haskell-open-doc ()
(interactive)
(let ((sym (thing-at-point 'symbol)))
(let* ((list-string (shell-command-to-string (concat "hoogle " sym)))
(list (haskell-open-doc-select-candidate (remove-if 'haskell-open-doc-filter (haskell-open-doc-parse list-string)))))
(if list
(let ((mod (nth 0 list)) (fun (nth 1 list)) (type (nth 2 list)))
(haskell-open-doc-uri-with-uri-fragment (concat (ghc-display-document-without-browse (ghc-resolve-package-name mod) mod nil) "#v:" fun)))))))
(defun haskell-open-doc-parse (str)
(let ((list (remove "" (split-string str "\n"))))
(mapcar (lambda (str)
(if (not (string-match "^\\([^ ]+\\) \\([^ ]+\\) :: \\(.+\\)" str))
nil ;(error "Unexpected hoogle output. \n%s" str)
(list (match-string 1 str) (match-string 2 str) (match-string 3 str)))) list)))
(defun haskell-open-doc-filter (list)
(not (and
(string-equal (nth 1 list) sym) ;; match the function name perfectly and
(remove-if (lambda (module) ;; prefix of the module name is included in loaded modules.
(not (and
(<= (length module) (length (nth 0 list)))
(string-equal module (substring (nth 0 list) 0 (length module)))))) ghc-loaded-module)
(not (null list)))))
(defun haskell-open-doc-select-candidate (candidate)
(if (or (eq 1 (length candidate)) (eq 0 (length candidate)))
(nth 0 candidate)
(pop-to-buffer "*WhichModule*")
(with-current-buffer "*WhichModule*"
(setq buffer-read-only nil)
(erase-buffer)
(insert "Please select the function you want to browse.\n\n")
(insert (join (mapcar (lambda (l) (format "[%s] %s %s :: %s" (char-to-string (nth 0 l)) (nth 1 l) (nth 2 l) (nth 3 l)))
(zip (string-to-list "abcdefghijklmnopqrstu") candidate)) "\n"))
(goto-char (point-min))
(setq buffer-read-only t)
(let ((position (- (read-char "Type: ") ?a)))
(other-buffer)
(if (get-buffer-window "*WhichModule*")
(delete-window (get-buffer-window "*WhichModule*")))
(kill-buffer "*WhichModule*")
(if (< position (length candidate))
(nth position candidate)
nil)))))
(defun haskell-open-doc-uri-with-uri-fragment (uri)
(let ((file-name (make-temp-file "haskell-doc-")))
(find-file file-name)
(with-current-buffer (file-name-nondirectory file-name)
(insert (concat "<html><head><script>setTimeout(function () { document.location = '" uri "' } , 0)</script></head>"))
(save-buffer)
(kill-buffer))
(run-at-time "3 sec" nil (lambda (file-name) (delete-file file-name)) file-name)
(shell-command (concat "open " file-name))))
(defun ghc-display-document-without-browse (pkg-ver mod haskell-org)
(when (and pkg-ver mod)
(let* ((mod- (ghc-replace-character mod ?. ?-))
(pkg (ghc-pkg-ver-get-pkg pkg-ver))
(ver (ghc-pkg-ver-get-ver pkg-ver))
(pkg-with-ver (format "%s-%s" pkg ver))
(path (ghc-resolve-document-path pkg-with-ver))
(local (format ghc-doc-local-format path mod-))
(remote (format ghc-doc-hackage-format pkg ver mod-))
(file (format "%s/%s.html" path mod-))
(url (if (or haskell-org (not (file-exists-p file))) remote local)))
url)))
(define-key haskell-mode-map (kbd "C-c h") 'haskell-open-doc)
;; if you use popwin.el
(add-to-list 'popwin:special-display-config '("*WhichModule*"))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment