C-M-d now can display functions and types in a browser.

elisp/ghc-doc.el

@@ -8,17 +8,28 @@
 
 (require 'ghc-func)
 (require 'ghc-comp)
+(require 'ghc-info)
 
 ;;; Code:
 
 (defun ghc-browse-document (&optional haskell-org)
   (interactive "P")
-  (let* ((mod0 (ghc-extract-module))
-	 (mod (ghc-read-module-name mod0))
-	 (pkg (ghc-resolve-package-name mod)))
-    (if (and pkg mod)
-	(ghc-display-document pkg mod haskell-org)
-      (message "No document found"))))
+  (let ((mod0 (ghc-extract-module))
+	(expr (ghc-things-at-point)))
+    (cond
+     ((and (not mod0) expr)
+      (let* ((info (ghc-get-info expr))
+	     (mod (ghc-extact-module-from-info info))
+	     (pkg (ghc-resolve-package-name mod)))
+	(if (and pkg mod)
+	    (ghc-display-document pkg mod haskell-org expr)
+	  (message "No document found"))))
+     (t
+      (let* ((mod (ghc-read-module-name mod0))
+	     (pkg (ghc-resolve-package-name mod)))
+	(if (and pkg mod)
+	    (ghc-display-document pkg mod haskell-org)
+	  (message "No document found")))))))
 
 (defun ghc-resolve-package-name (mod)
   (with-temp-buffer
@@ -44,7 +55,7 @@
 
 (ghc-defstruct pkg-ver pkg ver)
 
-(defun ghc-display-document (pkg-ver mod haskell-org)
+(defun ghc-display-document (pkg-ver mod haskell-org &optional symbol)
   (when (and pkg-ver mod)
     (let* ((mod- (ghc-replace-character mod ?. ?-))
 	   (pkg (ghc-pkg-ver-get-pkg pkg-ver))
@@ -54,9 +65,32 @@
 	   (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)))
+           (url0 (if (or haskell-org (not (file-exists-p file))) remote local))
+	   (url (if symbol (ghc-add-anchor url0 symbol) url0)))
+      ;; Mac's "open" removes the anchor from "file://", sigh.
       (browse-url url))))
 
+(defun ghc-add-anchor (url symbol)
+  (let ((case-fold-search nil))
+    (if (string-match "^[A-Z]" symbol)
+	(concat url "#t:" symbol)
+      (if (string-match "^[a-z]" symbol)
+	  (concat url "#v:" symbol)
+	(concat url "#v:" (ghc-url-encode symbol))))))
+
+(defun ghc-url-encode (symbol)
+  (let ((len (length symbol))
+	(i 0)
+	acc)
+    (while (< i len)
+      (setq acc (cons (format "-%d-" (aref symbol i)) acc))
+      (setq i (1+ i)))
+    (apply 'concat (nreverse acc))))
+
+(defun ghc-extact-module-from-info (info)
+  (when (string-match "\`\\([^']+\\)'" info)
+    (match-string 1 info)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defvar ghc-input-map nil)

elisp/ghc-flymake.el

@@ -78,7 +78,7 @@
 	  (errs (ghc-flymake-err-list)))
       (ghc-display
        nil
-       (lambda (&rest ignore)
+       (lambda ()
 	 (insert title "\n\n")
 	 (mapc (lambda (x) (insert x "\n")) errs))))))
 

elisp/ghc-func.el

@@ -147,11 +147,10 @@
 (defconst ghc-error-buffer-name "*GHC Info*")
 
 (defun ghc-display (fontify ins-func)
-  (let ((cdir default-directory)
-	(buf (get-buffer-create ghc-error-buffer-name)))
+  (let ((buf (get-buffer-create ghc-error-buffer-name)))
     (with-current-buffer buf
       (erase-buffer)
-      (funcall ins-func cdir)
+      (funcall ins-func)
       (ghc-replace-character-buffer ghc-null ghc-newline)
       (goto-char (point-min))
       (if (not fontify)
@@ -160,4 +159,19 @@
 	(turn-on-haskell-font-lock)))
     (display-buffer buf)))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun ghc-run-ghc-mod (cmds)
+  (cond
+   ((executable-find ghc-module-command)
+    (let ((cdir default-directory))
+      (with-temp-buffer
+	(cd cdir)
+	(apply 'call-process ghc-module-command nil t nil
+	       (append (ghc-make-ghc-options) cmds))
+	(buffer-substring (point-min) (1- (point-max))))))
+   (t
+    (message "%s not found" ghc-module-command)
+    nil)))
+
 (provide 'ghc-func)

elisp/ghc-info.el

@@ -12,12 +12,19 @@
 
 (defun ghc-show-info (&optional ask)
   (interactive "P")
-  (let* ((modname (or (ghc-find-module-name) "Main"))
-	 (expr0 (ghc-things-at-point))
+  (let* ((expr0 (ghc-things-at-point))
 	 (expr (if (or ask (not expr0)) (ghc-read-expression expr0) expr0))
+	 (info (ghc-get-info expr)))
+    (when info
+      (ghc-display
+       nil
+       (lambda () (insert info))))))
+
+(defun ghc-get-info (expr)
+  (let* ((modname (or (ghc-find-module-name) "Main"))
 	 (file (buffer-file-name))
 	 (cmds (list "info" file modname expr)))
-    (ghc-display-information cmds nil)))
+    (ghc-run-ghc-mod cmds)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -124,27 +131,12 @@
 (defun ghc-expand-th ()
   (interactive)
   (let* ((file (buffer-file-name))
-	 (cmds (list "expand" file)))
-    (ghc-display-information cmds t)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; Display
-;;;
-
-(defun ghc-display-information (cmds fontify)
-  (interactive)
-  (if (not (executable-find ghc-module-command))
-      (message "%s not found" ghc-module-command)
-    (ghc-display
-     fontify
-     (lambda (cdir)
-       (insert
-	(with-temp-buffer
-	  (cd cdir)
-	  (apply 'call-process ghc-module-command nil t nil
-		 (append (ghc-make-ghc-options) cmds))
-	  (buffer-substring (point-min) (1- (point-max)))))))))
+	 (cmds (list "expand" file))
+	 (source (ghc-run-ghc-mod cmds)))
+    (when source
+      (ghc-display
+       'fontify
+       (lambda () (insert source))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;