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
|
;;; haskell-utils.el --- General utility functions used by haskell-mode modules -*- lexical-binding: t -*-
;; Copyright © 2013 Herbert Valerio Riedel
;; 2016 Arthur Fayzrakhmanov
;; Author: Herbert Valerio Riedel <hvr@gnu.org>
;; This file is not part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3 of the License, or
;; (at your option) any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This module's purpose is to provide a place for helper functions
;; which are general enough to be usable by multiple modules and/or
;; to alleviate circular module dependency problems.
;;
;; When possible, functions in this module shall be accompanied by
;; ERT-based unit tests.
;;
;; See also `haskell-str.el' for string utility functions.
;;
;; All symbols in this module have a `haskell-utils-' prefix.
;;; Code:
;; =============================================================================
;; NOTE:
;; THIS MODULE IS SUPPOSED TO BE A LEAF-MODULE AND SHALL NOT REQUIRE/DEPEND-ON
;; ANY OTHER HASKELL-MODE MODULES IN ORDER TO STAY AT THE BOTTOM OF THE MODULE
;; DEPENDENCY GRAPH.
;; =============================================================================
(eval-when-compile (require 'cl-lib))
(defvar-local haskell-utils-async-post-command-flag nil
"Non-nil means some commands were triggered during async function execution.")
(defvar haskell-mode-interactive-prompt-state nil
"Special variable indicating a state of user input waiting.")
(defun haskell-utils-read-directory-name (prompt default)
"Read directory name and normalize to true absolute path.
Refer to `read-directory-name' for the meaning of PROMPT and
DEFAULT. If `haskell-process-load-or-reload-prompt' is nil,
accept `default'."
(let ((filename (file-truename (read-directory-name prompt default default))))
(concat (replace-regexp-in-string "/$" "" filename) "/")))
(defun haskell-utils-parse-import-statement-at-point ()
"Return imported module name if on import statement or nil otherwise.
This currently assumes that the \"import\" keyword and the module
name are on the same line.
This function supports the SafeHaskell and PackageImports syntax extensions.
Note: doesn't detect if in {--}-style comment."
(save-excursion
(goto-char (line-beginning-position))
(if (looking-at (concat "[\t ]*import[\t ]+"
"\\(?:safe[\t ]+\\)?" ;; SafeHaskell
"\\(?:qualified[\t ]+\\)?"
"\\(?:\"[^\"]*\"[\t ]+\\)?" ;; PackageImports
"\\([[:digit:][:upper:][:lower:]_.]+\\)"))
(match-string-no-properties 1))))
(defun haskell-utils-async-update-post-command-flag ()
"A special hook which collects triggered commands during async execution.
This hook pushes value of variable `this-command' to flag variable
`haskell-utils-async-post-command-flag'."
(let* ((cmd this-command)
(updated-flag (cons cmd haskell-utils-async-post-command-flag)))
(setq haskell-utils-async-post-command-flag updated-flag)))
(defun haskell-utils-async-watch-changes ()
"Watch for triggered commands during async operation execution.
Resets flag variable
`haskell-utils-async-update-post-command-flag' to NIL. By changes it is
assumed that nothing happened, e.g. nothing was inserted in
buffer, point was not moved, etc. To collect data `post-command-hook' is used."
(setq haskell-utils-async-post-command-flag nil)
(add-hook
'post-command-hook #'haskell-utils-async-update-post-command-flag nil t))
(defun haskell-utils-async-stop-watching-changes (buffer)
"Clean up after async operation finished.
This function takes care about cleaning up things made by
`haskell-utils-async-watch-changes'. The BUFFER argument is a buffer where
`post-command-hook' should be disabled. This is neccessary, because
it is possible that user will change buffer during async function
execusion."
(with-current-buffer buffer
(setq haskell-utils-async-post-command-flag nil)
(remove-hook
'post-command-hook #'haskell-utils-async-update-post-command-flag t)))
(defun haskell-utils-reduce-string (str)
"Remove newlines and extra whitespace from string STR.
If line starts with a sequence of whitespaces, substitutes this
sequence with a single whitespace. Removes all newline
characters."
(let ((s (replace-regexp-in-string "^\s+" " " str)))
(replace-regexp-in-string "\r?\n" "" s)))
(defun haskell-utils-repl-response-error-status (response)
"Parse response REPL's RESPONSE for errors.
Returns one of the following symbols:
+ unknown-command
+ option-missing
+ interactive-error
+ no-error
*Warning*: this funciton covers only three kind of responses:
* \"unknown command …\"
REPL missing requested command
* \"<interactive>:3:5: …\"
interactive REPL error
* \"Couldn't guess that module name. Does it exist?\"
(:type-at and maybe some other commands error)
* *all other reposnses* are treated as success reposneses and
'no-error is returned."
(if response
(let ((first-line (car (split-string response "\n" t))))
(cond
((null first-line) 'no-error)
((string-match-p "^unknown command" first-line)
'unknown-command)
((string-match-p
"^Couldn't guess that module name. Does it exist?"
first-line)
'option-missing)
((string-match-p "^<interactive>:" first-line)
'interactive-error)
(t 'no-error)))
;; in case of nil-ish reponse it's not clear is it error response or not
'no-error))
(defun haskell-utils-compose-type-at-command (pos)
"Prepare :type-at command to be send to haskell process.
POS is a cons cell containing min and max positions, i.e. target
expression bounds."
(save-excursion
(let ((start-p (car pos))
(end-p (cdr pos))
start-l
start-c
end-l
end-c
value)
(goto-char start-p)
(setq start-l (line-number-at-pos))
(setq start-c (1+ (current-column)))
(goto-char end-p)
(setq end-l (line-number-at-pos))
(setq end-c (1+ (current-column)))
(setq value (buffer-substring-no-properties start-p end-p))
;; supress multiline expressions
(let ((lines (split-string value "\n" t)))
(when (and (cdr lines)
(stringp (car lines)))
(setq value (format "[ %s … ]" (car lines)))))
(replace-regexp-in-string
"\n$"
""
(format ":type-at %s %d %d %d %d %s"
(buffer-file-name)
start-l
start-c
end-l
end-c
value)))))
(defun haskell-mode-toggle-interactive-prompt-state (&optional disabled)
"Set `haskell-mode-interactive-prompt-state' to t.
If given DISABLED argument sets variable value to nil, otherwise to t."
(setq haskell-mode-interactive-prompt-state (not disabled)))
(provide 'haskell-utils)
;;; haskell-utils.el ends here
|
