File: ghc-ins-mod.el

package info (click to toggle)
ghc-mod 5.6.0.0-2
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 1,216 kB
  • ctags: 240
  • sloc: haskell: 8,323; lisp: 1,557; makefile: 40; sh: 34
file content (79 lines) | stat: -rw-r--r-- 2,177 bytes parent folder | download | duplicates (3)
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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; ghc-ins-mod.el
;;;

;; Author:  Kazu Yamamoto <Kazu@Mew.org>
;; Created: Dec 27, 2011

(require 'ghc-process)

;;; Code:

(defun ghc-insert-module ()
  (interactive)
  (let* ((expr0 (ghc-things-at-point))
	 (expr (ghc-read-expression expr0)))
    (ghc-ins-mod expr)))

(defvar ghc-preferred-modules '("Control.Applicative"
				"Data.ByteString"
				"Data.Text"
				"Text.Parsec"
				"System.FilePath"
				"System.Directory"))

(defun ghc-reorder-modules (mods)
  (catch 'loop
    (dolist (pmod ghc-preferred-modules)
      (if (member pmod mods)
	  (throw 'loop (cons pmod (delete pmod mods)))))
    mods))

(defun ghc-ins-mod (expr)
  (let (prefix fun mods)
    (if (not (string-match "^\\([^.]+\\)\\\.\\([^.]+\\)$" expr))
	(setq fun expr)
      (setq prefix (match-string 1 expr))
      (setq fun (match-string 2 expr)))
    (setq mods (ghc-reorder-modules (ghc-function-to-modules fun)))
    (if (null mods)
	(message "No module guessed")
      (let* ((key (or prefix fun))
	     (fmt (concat "Module name for \"" key "\" (%s): "))
	     (mod (ghc-completing-read fmt mods)))
	(save-excursion
	  (ghc-goto-module-position)
	  (if prefix
	      (insert-before-markers "import qualified " mod " as " prefix "\n")
	    (insert-before-markers "import " mod " (" (ghc-enclose expr) ")\n")))))))

(defun ghc-completing-read (fmt lst)
  (let* ((def (car lst))
	 (prompt (format fmt def))
	 (inp (completing-read prompt lst)))
    (if (string= inp "") def inp)))

(defun ghc-goto-module-position ()
  (goto-char (point-max))
  (if (re-search-backward "^import +" nil t)
      (ghc-goto-empty-line)
    (if (not (re-search-backward "^module" nil t))
	(goto-char (point-min))
      (ghc-goto-empty-line)
      (forward-line)
      (unless (eolp)
	;; save-excursion is not proper due to insert-before-markers.
	(let ((beg (point)))
	  (insert-before-markers "\n")
	  (goto-char beg))))))

(defun ghc-goto-empty-line ()
  (unless (re-search-forward "^$" nil t)
    (forward-line)))

(defun ghc-function-to-modules (fun)
  (let ((cmd (format "find %s\n" fun)))
    (ghc-sync-process cmd)))

(provide 'ghc-ins-mod)