/usr/share/emacs/site-lisp/ghc-mod/ghc-doc.el is in ghc-mod-el 5.4.0.0-1build1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; ghc.el
;;;
;; Author: Kazu Yamamoto <Kazu@Mew.org>
;; Created: Sep 25, 2009
(require 'ghc-func)
(require 'ghc-comp)
(require 'ghc-info)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Customize Variables
;;;
(defcustom ghc-doc-browser-function #'browse-url
"Function used to browse documentation."
:type '(radio (function-item browse-url)
(function-item ghc-browse-url-safari))
:group 'ghc-mod)
;;; Code:
(defun ghc-browse-document (&optional haskell-org)
(interactive "P")
(let ((mod0 (ghc-extract-module))
(expr0 (ghc-things-at-point))
pkg-ver-path mod expr info)
(if (or mod0 (not expr0))
(setq mod (ghc-read-module-name mod0))
(setq expr (ghc-read-expression expr0))
(setq info (ghc-get-info expr0))
(setq mod (ghc-extact-module-from-info info)))
(setq pkg-ver-path (and mod (ghc-resolve-document-path mod)))
(if pkg-ver-path
(ghc-display-document pkg-ver-path mod haskell-org expr)
(message "No documentation found"))))
(ghc-defstruct pkg-ver-path pkg ver path)
(defun ghc-resolve-document-path (mod)
(let ((root ghc-process-root))
(with-temp-buffer
(let ((default-directory root))
(ghc-call-process ghc-module-command nil t nil "doc" mod))
(goto-char (point-min))
(when (looking-at "^\\([^ ]+\\)-\\([0-9]*\\(\\.[0-9]+\\)*\\) \\(.*\\)$")
(ghc-make-pkg-ver-path
:pkg (match-string-no-properties 1)
:ver (match-string-no-properties 2)
:path (match-string-no-properties 4))))))
(defconst ghc-doc-local-format "file://%s/%s.html")
(defconst ghc-doc-hackage-format
"http://hackage.haskell.org/packages/archive/%s/%s/doc/html/%s.html")
(defun ghc-browse-url-safari (uri &rest _args)
"Open a URI in Safari using AppleScript. This preserves anchors."
(let ((script (format "
tell application \"Safari\"
open location \"%s\"
activate
end tell" uri)))
(do-applescript script)))
(defun ghc-display-document (pkg-ver-path mod haskell-org &optional symbol)
(let* ((pkg (ghc-pkg-ver-path-get-pkg pkg-ver-path))
(mod- (ghc-replace-character mod ?. ?-))
(ver (ghc-pkg-ver-path-get-ver pkg-ver-path))
(path (ghc-pkg-ver-path-get-path pkg-ver-path))
(local (format ghc-doc-local-format path mod-))
(remote (format ghc-doc-hackage-format pkg ver mod-))
(file (format "%s/%s.html" path mod-))
(url0 (if (or haskell-org (not (file-exists-p file))) remote local))
(url (if symbol (ghc-add-anchor url0 symbol) url0)))
(funcall ghc-doc-browser-function 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)
(ghc-add acc (format "-%d-" (aref symbol i)))
(setq i (1+ i)))
(apply 'concat (nreverse acc))))
(defun ghc-extact-module-from-info (info)
(when (string-match "[`\u2018]\\([^'\u2019]+\\)['\u2019]" info)
(match-string 1 info)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar ghc-input-map nil)
(unless ghc-input-map
(setq ghc-input-map
(if (boundp 'minibuffer-local-map)
(copy-keymap minibuffer-local-map)
(make-sparse-keymap)))
(define-key ghc-input-map "\t" 'ghc-complete))
(defun ghc-read-module-name (def)
(read-from-minibuffer "Module name: " def ghc-input-map))
(defun ghc-read-expression (def)
(read-from-minibuffer "Identifier: " def ghc-input-map))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ghc-extract-module ()
(interactive)
(save-excursion
(beginning-of-line)
(if (looking-at "^\\(import\\|module\\) +\\(qualified +\\)?\\([^ (\n]+\\)")
(match-string-no-properties 3))))
(provide 'ghc-doc)
|