ghc-mod/elisp/ghc-ins-mod.el

80 lines
2.1 KiB
EmacsLisp
Raw Normal View History

2011-12-27 07:28:02 +00:00
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; ghc-ins-mod.el
;;;
;; Author: Kazu Yamamoto <Kazu@Mew.org>
;; Created: Dec 27, 2011
2014-03-25 05:58:20 +00:00
(require 'ghc-process)
2011-12-27 07:28:02 +00:00
;;; Code:
(defun ghc-insert-module ()
(interactive)
2014-03-25 05:29:18 +00:00
(let* ((expr0 (ghc-things-at-point))
(expr (ghc-read-expression expr0)))
2014-03-25 05:58:20 +00:00
(ghc-ins-mod expr)))
2014-03-31 07:04:44 +00:00
(defvar ghc-preferred-modules '("Control.Applicative"
"Data.ByteString"
"Data.Text"
2014-04-07 13:05:59 +00:00
"Text.Parsec"
"System.FilePath"
"System.Directory"))
2014-03-31 07:04:44 +00:00
(defun ghc-reorder-modules (mods)
(catch 'loop
(dolist (pmod ghc-preferred-modules)
(if (member pmod mods)
(throw 'loop (cons pmod (delete pmod mods)))))
mods))
2014-03-25 05:58:20 +00:00
(defun ghc-ins-mod (expr)
2014-03-26 02:32:08 +00:00
(let (prefix fun mods)
(if (not (string-match "^\\([^.]+\\)\\\.\\([^.]+\\)$" expr))
(setq fun expr)
(setq prefix (match-string 1 expr))
(setq fun (match-string 2 expr)))
2014-03-31 07:04:44 +00:00
(setq mods (ghc-reorder-modules (ghc-function-to-modules fun)))
2014-03-25 05:58:20 +00:00
(if (null mods)
(message "No module guessed")
2014-03-31 06:55:15 +00:00
(let* ((key (or prefix fun))
(fmt (concat "Module name for \"" key "\" (%s): "))
2014-03-31 05:15:05 +00:00
(mod (ghc-completing-read fmt mods)))
2014-03-25 05:58:20 +00:00
(save-excursion
(ghc-goto-module-position)
2014-03-26 02:32:08 +00:00
(if prefix
2014-03-31 06:44:50 +00:00
(insert-before-markers "import qualified " mod " as " prefix "\n")
(insert-before-markers "import " mod " (" (ghc-enclose expr) ")\n")))))))
2014-03-25 05:29:18 +00:00
(defun ghc-completing-read (fmt lst)
(let* ((def (car lst))
(prompt (format fmt def))
(inp (completing-read prompt lst)))
(if (string= inp "") def inp)))
2011-12-27 07:28:02 +00:00
(defun ghc-goto-module-position ()
(goto-char (point-max))
2015-08-27 01:42:28 +00:00
(if (re-search-backward "^import +" nil t)
2012-01-23 06:12:24 +00:00
(ghc-goto-empty-line)
2014-03-31 06:44:50 +00:00
(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))))))
2011-12-27 07:28:02 +00:00
2012-01-23 06:12:24 +00:00
(defun ghc-goto-empty-line ()
(unless (re-search-forward "^$" nil t)
(forward-line)))
2014-03-25 05:29:18 +00:00
(defun ghc-function-to-modules (fun)
2014-04-19 11:48:26 +00:00
(let ((cmd (format "find %s\n" fun)))
(ghc-sync-process cmd)))
2011-12-27 07:28:02 +00:00
(provide 'ghc-ins-mod)