/usr/share/emacs/site-lisp/ghc-mod/ghc-rewrite.el is in ghc-mod-el 5.8.0.0-1.
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 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; ghc-rewrite.el
;;;
;; Author: Alejandro Serrano <trupill@gmail.com>
;; Created: Jun 17, 2014
;;; Code:
(require 'ghc-func)
(require 'ghc-process)
(require 'button)
;(require 'dropdown-list)
(defvar ghc-auto-info nil)
(defvar ghc-auto-buffer nil)
;; Common code for case splitting and refinement
(defun ghc-perform-rewriting (info)
"Replace code with new string obtained from ghc-mod"
(let* ((current-line (line-number-at-pos))
(begin-line (ghc-sinfo-get-beg-line info))
(begin-line-diff (+ 1 (- begin-line current-line)))
(begin-line-pos (line-beginning-position begin-line-diff))
(begin-pos (- (+ begin-line-pos (ghc-sinfo-get-beg-column info)) 1))
(end-line (ghc-sinfo-get-end-line info))
(end-line-diff (+ 1 (- end-line current-line)))
(end-line-pos (line-beginning-position end-line-diff))
(end-pos (- (+ end-line-pos (ghc-sinfo-get-end-column info)) 1)) )
(delete-region begin-pos end-pos)
(insert (ghc-sinfo-get-info info)) )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Case splitting
;;;
(ghc-defstruct sinfo beg-line beg-column end-line end-column info)
(defun ghc-case-split ()
"Split the variable at point into its possible constructors"
(interactive)
(when (null (ghc-try-case-split))
(message "Cannot split into cases")))
(defun ghc-try-case-split ()
(let ((info (ghc-obtain-case-split)))
(if (null info)
'()
(ghc-perform-rewriting info)) ))
(defun ghc-obtain-case-split ()
(let* ((ln (int-to-string (line-number-at-pos)))
(cn (int-to-string (1+ (current-column))))
(file (buffer-file-name))
(cmd (format "split %s %s %s\n" file ln cn)))
(ghc-sync-process cmd)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Refinement
;;;
(defun ghc-refine ()
"Refine a hole using a user-specified function"
(interactive)
(when (null (ghc-try-refine))
(message "Cannot refine")))
(defun ghc-try-refine ()
(let ((info (ghc-obtain-refine (read-string "Refine with: "))))
(if (null info)
'()
(ghc-perform-rewriting info)) ))
(defun ghc-obtain-refine (expr)
(let* ((ln (int-to-string (line-number-at-pos)))
(cn (int-to-string (1+ (current-column))))
(file (buffer-file-name))
(cmd (format "refine %s %s %s %s\n" file ln cn expr)))
(ghc-sync-process cmd)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Auto
;;;
(defun ghc-perform-rewriting-auto (info msg)
"Replace code with new string obtained from ghc-mod from auto mode"
(let* ((current-line (line-number-at-pos))
(begin-line (ghc-sinfo-get-beg-line info))
(begin-line-diff (+ 1 (- begin-line current-line)))
(begin-line-pos (line-beginning-position begin-line-diff))
(begin-pos (- (+ begin-line-pos (ghc-sinfo-get-beg-column info)) 1))
(end-line (ghc-sinfo-get-end-line info))
(end-line-diff (+ 1 (- end-line current-line)))
(end-line-pos (line-beginning-position end-line-diff))
(end-pos (- (+ end-line-pos (ghc-sinfo-get-end-column info)) 1)) )
(delete-region begin-pos end-pos)
(insert msg)))
;; Option 1: using button
(defun ghc-auto-completion-window ()
(get-buffer-window ghc-error-buffer-name 0))
(defun auto-button (button)
(let ((text (buffer-substring (button-start button) (button-end button))))
(with-current-buffer ghc-auto-buffer
(ghc-perform-rewriting-auto ghc-auto-info text))
(quit-restore-window)))
(define-button-type 'auto-button
'follow-link t
'help-echo "mouse-2, RET: Insert this completion"
'action #'auto-button)
(defun ghc-show-auto-messages (info)
(let ((buf (current-buffer)))
(setq ghc-auto-info info)
(setq ghc-auto-buffer buf)
(ghc-display nil
(lambda ()
(insert "Possible completions:\n")
(mapc
(lambda (_x)
(let ((pos-begin (point))
(pos-end (point)))
(make-button pos-begin pos-end :type 'auto-button)))
(ghc-sinfo-get-info info))))
(select-window (ghc-auto-completion-window))))
;; Option 2: using dropdown-list
;; (defun ghc-show-auto-messages (info)
;; (let* ((completions (ghc-sinfo-get-info info))
;; (selected (dropdown-list completions)))
;; (when selected
;; (ghc-perform-rewriting-auto info (nth selected completions)))))
;; Option 3: using minibuffer
;; (defvar ghc-auto-completion-buffer-name "*Djinn Completions*")
;; (defun ghc-auto-completion-window ()
;; (get-buffer-window ghc-auto-completion-buffer-name 0))
;; (defun ghc-show-auto-messages (info)
;; (let* ((completions (ghc-sinfo-get-info info))
;; (buf (generate-new-buffer "djinn-completion-temp")))
;; (with-current-buffer
;; (progn
;; (with-output-to-temp-buffer ghc-auto-completion-buffer-name
;; (display-completion-list completions))
;; (select-window (ghc-auto-completion-window))
;; (buffer-string)))))
(defun ghc-auto ()
"Try to automatically fill the contents of a hole"
(interactive)
(let ((info (ghc-obtain-auto)))
(if (null info)
(message "No automatic completions found")
(if (= (length (ghc-sinfo-get-info info)) 1)
(ghc-perform-rewriting-auto info (car (ghc-sinfo-get-info info)))
(ghc-show-auto-messages info)))))
(defun ghc-obtain-auto ()
(let* ((ln (int-to-string (line-number-at-pos)))
(cn (int-to-string (1+ (current-column))))
(file (buffer-file-name))
(cmd (format "auto %s %s %s\n" file ln cn)))
(ghc-sync-process cmd)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Initial code from signature
;;;
(ghc-defstruct icsinfo sort pos fns)
(defun ghc-initial-code-from-signature ()
"Refine a hole using a user-specified function"
(interactive)
(when (null (ghc-try-initial-code-from-signature))
(message "Cannot obtain initial code")))
(defun ghc-try-initial-code-from-signature ()
"Include initial code from a function signature or instance declaration"
(interactive)
(let ((info (ghc-obtain-initial-code-from-signature)))
(if (null info)
'()
(let* ((ln-current (line-number-at-pos))
(sort (ghc-icsinfo-get-sort info))
(pos (ghc-icsinfo-get-pos info))
(ln-end (ghc-sinfo-get-end-line pos))
(ln-diff (+ 1 (- ln-end ln-current)))
(fns-to-insert (ghc-icsinfo-get-fns info)))
(goto-char (line-end-position ln-diff))
(dolist (fn-to-insert fns-to-insert)
(if (equal sort "function")
(newline)
(newline-and-indent))
(insert fn-to-insert))))))
(defun ghc-obtain-initial-code-from-signature ()
(let* ((ln (int-to-string (line-number-at-pos)))
(cn (int-to-string (1+ (current-column))))
(file (buffer-file-name))
(cmd (format "sig %s %s %s\n" file ln cn)))
(ghc-sync-process cmd)))
(provide 'ghc-rewrite)
|