Skip to content

Commit 508d163

Browse files
gracjangracjan
committed
Merge pull request #752 from ankhers/debt/move_and_rename_functions
Move and rename haskell-utils-* functions
2 parents d3bed4f + ee42e87 commit 508d163

File tree

2 files changed

+111
-114
lines changed

2 files changed

+111
-114
lines changed

‎haskell-commands.el

Lines changed: 16 additions & 114 deletions
Original file line numberDiff line numberDiff line change
@@ -31,14 +31,9 @@
3131
(require 'haskell-interactive-mode)
3232
(require 'haskell-session)
3333
(require 'haskell-presentation-mode)
34+
(require 'haskell-utils)
3435
(require 'highlight-uses-mode)
3536

36-
37-
(defvar haskell-utils-async-post-command-flag nil
38-
"Non-nil means some commands were triggered during async function execution.")
39-
(make-variable-buffer-local 'haskell-utils-async-post-command-flag)
40-
41-
4237
;;;###autoload
4338
(defun haskell-process-restart ()
4439
"Restart the inferior Haskell process."
@@ -627,7 +622,7 @@ Optional argument INSERT-VALUE indicates that
627622
recieved type signature should be inserted (but only if nothing
628623
happened since function invocation)."
629624
(interactive "P")
630-
(let* ((pos (haskell-utils-capture-expr-bounds))
625+
(let* ((pos (haskell-command-capture-expr-bounds))
631626
(req (haskell-utils-compose-type-at-command pos))
632627
(process (haskell-interactive-process))
633628
(buf (current-buffer))
@@ -682,7 +677,7 @@ happened since function invocation)."
682677
(goto-char min-pos)
683678
(insert (concat "(" sig ")"))))
684679
;; Non-region cases
685-
(haskell-utils-insert-type-signature sig))
680+
(haskell-command-insert-type-signature sig))
686681
;; Some commands registered, prevent insertion
687682
(let* ((rev (reverse haskell-utils-async-post-command-flag))
688683
(cs (format "%s" (cdr rev))))
@@ -693,7 +688,7 @@ happened since function invocation)."
693688
cs))))
694689
;; Present the result only when response is valid and not asked
695690
;; to insert result
696-
(haskell-utils-echo-or-present response)))
691+
(haskell-command-echo-or-present response)))
697692

698693
(haskell-utils-async-stop-watching-changes init-buffer))))))))
699694

@@ -913,7 +908,17 @@ Requires the :uses command from GHCi."
913908
(error (propertize "No reply. Is :uses supported?"
914909
'face 'compilation-error)))))))
915910

916-
(defun haskell-utils-capture-expr-bounds ()
911+
(defun haskell-command-echo-or-present (msg)
912+
"Present message in some manner depending on configuration.
913+
If variable `haskell-process-use-presentation-mode' is NIL it will output
914+
modified message MSG to echo area."
915+
(if haskell-process-use-presentation-mode
916+
(let ((session (haskell-process-session (haskell-interactive-process))))
917+
(haskell-presentation-present session msg))
918+
(let ((m (haskell-utils-reduce-string msg)))
919+
(message m))))
920+
921+
(defun haskell-command-capture-expr-bounds ()
917922
"Capture position bounds of expression at point.
918923
If there is an active region then it returns region
919924
bounds. Otherwise it uses `haskell-spanable-pos-at-point` to
@@ -926,43 +931,7 @@ to point."
926931
(haskell-spanable-pos-at-point)
927932
(cons (point) (point))))
928933

929-
(defun haskell-utils-compose-type-at-command (pos)
930-
"Prepare :type-at command to be send to haskell process.
931-
POS is a cons cell containing min and max positions, i.e. target
932-
expression bounds."
933-
(save-excursion
934-
(let ((start-p (car pos))
935-
(end-p (cdr pos))
936-
start-l
937-
start-c
938-
end-l
939-
end-c
940-
value)
941-
(goto-char start-p)
942-
(setq start-l (line-number-at-pos))
943-
(setq start-c (1+ (current-column)))
944-
(goto-char end-p)
945-
(setq end-l (line-number-at-pos))
946-
(setq end-c (1+ (current-column)))
947-
(setq value (buffer-substring-no-properties start-p end-p))
948-
;; supress multiline expressions
949-
(let ((lines (split-string value "\n" t)))
950-
(when (and (cdr lines)
951-
(stringp (car lines)))
952-
(setq value (format "[ %s … ]" (car lines)))))
953-
(replace-regexp-in-string
954-
"\n$"
955-
""
956-
(format ":type-at %s %d %d %d %d %s"
957-
(buffer-file-name)
958-
start-l
959-
start-c
960-
end-l
961-
end-c
962-
value)))))
963-
964-
965-
(defun haskell-utils-insert-type-signature (signature)
934+
(defun haskell-command-insert-type-signature (signature)
966935
"Insert type signature.
967936
In case of active region is present, wrap it by parentheses and
968937
append SIGNATURE to original expression. Otherwise tries to
@@ -978,72 +947,5 @@ newlines and extra whitespace in signature before insertion."
978947
(insert sig "\n")
979948
(indent-to col)))))
980949

981-
(defun haskell-utils-echo-or-present (msg)
982-
"Present message in some manner depending on configuration.
983-
If variable `haskell-process-use-presentation-mode' is NIL it will output
984-
modified message MSG to echo area."
985-
(if haskell-process-use-presentation-mode
986-
(let ((session (haskell-process-session (haskell-interactive-process))))
987-
(haskell-presentation-present session msg))
988-
(let ((m (haskell-utils-reduce-string msg)))
989-
(message m))))
990-
991-
(defun haskell-utils-async-update-post-command-flag ()
992-
"A special hook which collects triggered commands during async execution.
993-
This hook pushes value of variable `this-command' to flag variable
994-
`haskell-utils-async-post-command-flag'."
995-
(let* ((cmd this-command)
996-
(updated-flag (cons cmd haskell-utils-async-post-command-flag)))
997-
(setq haskell-utils-async-post-command-flag updated-flag)))
998-
999-
(defun haskell-utils-async-watch-changes ()
1000-
"Watch for triggered commands during async operation execution.
1001-
Resets flag variable
1002-
`haskell-utils-async-update-post-command-flag' to NIL. By chanhges it is
1003-
assumed that nothing happened, e.g. nothing was inserted in
1004-
buffer, point was not moved, etc. To collect data `post-command-hook' is used."
1005-
(setq haskell-utils-async-post-command-flag nil)
1006-
(add-hook
1007-
'post-command-hook #'haskell-utils-async-update-post-command-flag nil t))
1008-
1009-
(defun haskell-utils-async-stop-watching-changes (buffer)
1010-
"Clean up after async operation finished.
1011-
This function takes care about cleaning up things made by
1012-
`haskell-utils-async-watch-changes'. The BUFFER argument is a buffer where
1013-
`post-command-hook' should be disabled. This is neccessary, because
1014-
it is possible that user will change buffer during async function
1015-
execusion."
1016-
(with-current-buffer buffer
1017-
(setq haskell-utils-async-post-command-flag nil)
1018-
(remove-hook
1019-
'post-command-hook #'haskell-utils-async-update-post-command-flag t)))
1020-
1021-
(defun haskell-utils-reduce-string (s)
1022-
"Remove newlines ans extra whitespace from S.
1023-
Removes all extra whitespace at the beginning of each line leaving
1024-
only single one. Then removes all newlines."
1025-
(let ((s_ (replace-regexp-in-string "^\s+" " " s)))
1026-
(replace-regexp-in-string "\n" "" s_)))
1027-
1028-
(defun haskell-utils-parse-repl-response (r)
1029-
"Parse response R from REPL and return special kind of result.
1030-
The result is response string itself with speacial property
1031-
response-type added.
1032-
1033-
This property could be of the following:
1034-
1035-
+ unknown-command
1036-
+ option-missing
1037-
+ interactive-error
1038-
+ success"
1039-
(let ((first-line (car (split-string r "\n"))))
1040-
(cond
1041-
((string-match-p "^unknown command" first-line) 'unknown-command)
1042-
((string-match-p "^Couldn't guess that module name. Does it exist?"
1043-
first-line)
1044-
'option-missing)
1045-
((string-match-p "^<interactive>:" first-line) 'interactive-error)
1046-
(t 'success))))
1047-
1048950
(provide 'haskell-commands)
1049951
;;; haskell-commands.el ends here

‎haskell-utils.el

Lines changed: 95 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,9 @@
3838
;; require/depend-on any other haskell-mode modules in order to
3939
;; stay at the bottom of the module dependency graph.
4040

41+
(defvar haskell-utils-async-post-command-flag nil
42+
"Non-nil means some commands were triggered during async function execution.")
43+
(make-variable-buffer-local 'haskell-utils-async-post-command-flag)
4144

4245
(defun haskell-utils-read-directory-name (prompt default)
4346
"Read directory name and normalize to true absolute path.
@@ -67,5 +70,97 @@ Note: doesn't detect if in {--}-style comment."
6770
"\\([[:digit:][:upper:][:lower:]_.]+\\)"))
6871
(match-string-no-properties 1))))
6972

73+
(defun haskell-utils-async-update-post-command-flag ()
74+
"A special hook which collects triggered commands during async execution.
75+
This hook pushes value of variable `this-command' to flag variable
76+
`haskell-utils-async-post-command-flag'."
77+
(let* ((cmd this-command)
78+
(updated-flag (cons cmd haskell-utils-async-post-command-flag)))
79+
(setq haskell-utils-async-post-command-flag updated-flag)))
80+
81+
(defun haskell-utils-async-watch-changes ()
82+
"Watch for triggered commands during async operation execution.
83+
Resets flag variable
84+
`haskell-utils-async-update-post-command-flag' to NIL. By chanhges it is
85+
assumed that nothing happened, e.g. nothing was inserted in
86+
buffer, point was not moved, etc. To collect data `post-command-hook' is used."
87+
(setq haskell-utils-async-post-command-flag nil)
88+
(add-hook
89+
'post-command-hook #'haskell-utils-async-update-post-command-flag nil t))
90+
91+
(defun haskell-utils-async-stop-watching-changes (buffer)
92+
"Clean up after async operation finished.
93+
This function takes care about cleaning up things made by
94+
`haskell-utils-async-watch-changes'. The BUFFER argument is a buffer where
95+
`post-command-hook' should be disabled. This is neccessary, because
96+
it is possible that user will change buffer during async function
97+
execusion."
98+
(with-current-buffer buffer
99+
(setq haskell-utils-async-post-command-flag nil)
100+
(remove-hook
101+
'post-command-hook #'haskell-utils-async-update-post-command-flag t)))
102+
103+
(defun haskell-utils-reduce-string (s)
104+
"Remove newlines ans extra whitespace from S.
105+
Removes all extra whitespace at the beginning of each line leaving
106+
only single one. Then removes all newlines."
107+
(let ((s_ (replace-regexp-in-string "^\s+" " " s)))
108+
(replace-regexp-in-string "\n" "" s_)))
109+
110+
(defun haskell-utils-parse-repl-response (r)
111+
"Parse response R from REPL and return special kind of result.
112+
The result is response string itself with speacial property
113+
response-type added.
114+
115+
This property could be of the following:
116+
117+
+ unknown-command
118+
+ option-missing
119+
+ interactive-error
120+
+ success"
121+
(let ((first-line (car (split-string r "\n"))))
122+
(cond
123+
((string-match-p "^unknown command" first-line) 'unknown-command)
124+
((string-match-p "^Couldn't guess that module name. Does it exist?"
125+
first-line)
126+
'option-missing)
127+
((string-match-p "^<interactive>:" first-line) 'interactive-error)
128+
(t 'success))))
129+
130+
(defun haskell-utils-compose-type-at-command (pos)
131+
"Prepare :type-at command to be send to haskell process.
132+
POS is a cons cell containing min and max positions, i.e. target
133+
expression bounds."
134+
(save-excursion
135+
(let ((start-p (car pos))
136+
(end-p (cdr pos))
137+
start-l
138+
start-c
139+
end-l
140+
end-c
141+
value)
142+
(goto-char start-p)
143+
(setq start-l (line-number-at-pos))
144+
(setq start-c (1+ (current-column)))
145+
(goto-char end-p)
146+
(setq end-l (line-number-at-pos))
147+
(setq end-c (1+ (current-column)))
148+
(setq value (buffer-substring-no-properties start-p end-p))
149+
;; supress multiline expressions
150+
(let ((lines (split-string value "\n" t)))
151+
(when (and (cdr lines)
152+
(stringp (car lines)))
153+
(setq value (format "[ %s … ]" (car lines)))))
154+
(replace-regexp-in-string
155+
"\n$"
156+
""
157+
(format ":type-at %s %d %d %d %d %s"
158+
(buffer-file-name)
159+
start-l
160+
start-c
161+
end-l
162+
end-c
163+
value)))))
164+
70165
(provide 'haskell-utils)
71166
;;; haskell-utils.el ends here

0 commit comments

Comments
 (0)