Skip to content

Commit

Permalink
Merge pull request #646 from geraldus/move-and-rename-utils
Browse files Browse the repository at this point in the history 
Rename prefix `hs-utils/` to `haskell-utils-`
  • Loading branch information
@gracjan
gracjan committed May 13, 2015
2 parents c0855b4 + 19a0d17 commit 60da3c4
Show file tree
Hide file tree
Showing 2 changed files with 42 additions and 46 deletions.
85 changes: 42 additions & 43 deletions haskell-commands.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,12 @@
(require 'haskell-session)
(require 'highlight-uses-mode)


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


;;;###autoload
(defun haskell-process-restart ()
"Restart the inferior Haskell process."
Expand Down Expand Up @@ -604,10 +610,6 @@ Query PROCESS to `:cd` to directory DIR."
(string-match "^<interactive>" response))
(haskell-mode-message-line response)))))))

(defvar hs-utils/async-post-command-flag nil
"Non-nil means some commands were triggered during async function execution.")
(make-variable-buffer-local 'hs-utils/async-post-command-flag)

;;;###autoload
(defun haskell-mode-show-type-at (&optional insert-value)
"Show type of the thing at point or within active region asynchronously.
Expand All @@ -624,8 +626,8 @@ Optional argument INSERT-VALUE indicates that
recieved type signature should be inserted (but only if nothing
happened since function invocation)."
(interactive "P")
(let* ((pos (hs-utils/capture-expr-bounds))
(req (hs-utils/compose-type-at-command pos))
(let* ((pos (haskell-utils-capture-expr-bounds))
(req (haskell-utils-compose-type-at-command pos))
(process (haskell-interactive-process))
(buf (current-buffer))
(pos-reg (cons pos (region-active-p))))
Expand All @@ -637,7 +639,7 @@ happened since function invocation)."
(lambda (state)
(let* ((prc (car state))
(req (nth 1 state)))
(hs-utils/async-watch-changes)
(haskell-utils-async-watch-changes)
(haskell-process-send-string prc req)))
:complete
(lambda (state response)
Expand All @@ -647,8 +649,8 @@ happened since function invocation)."
(wrap (cdr pos-reg))
(min-pos (caar pos-reg))
(max-pos (cdar pos-reg))
(sig (hs-utils/reduce-string response))
(res-type (hs-utils/parse-repl-response sig)))
(sig (haskell-utils-reduce-string response))
(res-type (haskell-utils-parse-repl-response sig)))

(cl-case res-type
;; neither popup presentation buffer
Expand All @@ -669,7 +671,7 @@ happened since function invocation)."
(otherwise
(if insert-value
;; Only insert type signature and do not present it
(if (= (length hs-utils/async-post-command-flag) 1)
(if (= (length haskell-utils-async-post-command-flag) 1)
(if wrap
;; Handle region case
(progn
Expand All @@ -679,9 +681,9 @@ happened since function invocation)."
(goto-char min-pos)
(insert (concat "(" sig ")"))))
;; Non-region cases
(hs-utils/insert-type-signature sig))
(haskell-utils-insert-type-signature sig))
;; Some commands registered, prevent insertion
(let* ((rev (reverse hs-utils/async-post-command-flag))
(let* ((rev (reverse haskell-utils-async-post-command-flag))
(cs (format "%s" (cdr rev))))
(message
(concat
Expand All @@ -692,9 +694,9 @@ happened since function invocation)."
;; insert result
(let* ((expr (car (split-string sig "\\W::\\W" t)))
(buf-name (concat ":type " expr)))
(hs-utils/echo-or-present response buf-name))))
(haskell-utils-echo-or-present response buf-name))))

(hs-utils/async-stop-watching-changes init-buffer))))))))
(haskell-utils-async-stop-watching-changes init-buffer))))))))

;;;###autoload
(defun haskell-process-generate-tags (&optional and-then-find-this-tag)
Expand Down Expand Up @@ -912,7 +914,7 @@ Requires the :uses command from GHCi."
(error (propertize "No reply. Is :uses supported?"
'face 'compilation-error)))))))

(defun hs-utils/capture-expr-bounds ()
(defun haskell-utils-capture-expr-bounds ()
"Capture position bounds of expression at point.
If there is an active region then it returns region
bounds. Otherwise it uses `haskell-spanable-pos-at-point` to
Expand All @@ -925,7 +927,7 @@ to point."
(haskell-spanable-pos-at-point)
(cons (point) (point))))

(defun hs-utils/compose-type-at-command (pos)
(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."
Expand All @@ -943,14 +945,7 @@ expression bounds."
(buffer-substring-no-properties (car pos)
(cdr pos)))))

(defun hs-utils/reduce-string (s)
"Remove newlines ans extra whitespace from S.
Removes all extra whitespace at the beginning of each line leaving
only single one. Then removes all newlines."
(let ((s_ (replace-regexp-in-string "^\s+" " " s)))
(replace-regexp-in-string "\n" "" s_)))

(defun hs-utils/insert-type-signature (signature)
(defun haskell-utils-insert-type-signature (signature)
"Insert type signature.
In case of active region is present, wrap it by parentheses and
append SIGNATURE to original expression. Otherwise tries to
Expand All @@ -959,14 +954,14 @@ newlines and extra whitespace in signature before insertion."
(let* ((ident-pos (or (haskell-ident-pos-at-point)
(cons (point) (point))))
(min-pos (car ident-pos))
(sig (hs-utils/reduce-string signature)))
(sig (haskell-utils-reduce-string signature)))
(save-excursion
(goto-char min-pos)
(let ((col (current-column)))
(insert sig "\n")
(indent-to col)))))

(defun hs-utils/echo-or-present (msg &optional name)
(defun haskell-utils-echo-or-present (msg &optional name)
"Present message in some manner depending on configuration.
If variable `haskell-process-use-presentation-mode' is NIL it will output
modified message MSG to echo area.
Expand All @@ -975,40 +970,47 @@ Optinal NAME will be used as presentation mode buffer name."
(let ((bufname (or name "*Haskell Presentation*"))
(session (haskell-process-session (haskell-interactive-process))))
(haskell-present bufname session msg))
(let (m (hs-utils/reduce-string msg))
(let (m (haskell-utils-reduce-string msg))
(message m))))

(defun hs-utils/async-update-post-command-flag ()
(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
`hs-utils/async-post-command-flag'."
`haskell-utils-async-post-command-flag'."
(let* ((cmd this-command)
(updated-flag (cons cmd hs-utils/async-post-command-flag)))
(setq hs-utils/async-post-command-flag updated-flag)))
(updated-flag (cons cmd haskell-utils-async-post-command-flag)))
(setq haskell-utils-async-post-command-flag updated-flag)))

(defun hs-utils/async-watch-changes ()
(defun haskell-utils-async-watch-changes ()
"Watch for triggered commands during async operation execution.
Resets flag variable
`hs-utils/async-update-post-command-flag' to NIL. By chanhges it is
`haskell-utils-async-update-post-command-flag' to NIL. By chanhges 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 hs-utils/async-post-command-flag nil)
(setq haskell-utils-async-post-command-flag nil)
(add-hook
'post-command-hook #'hs-utils/async-update-post-command-flag nil t))
'post-command-hook #'haskell-utils-async-update-post-command-flag nil t))

(defun hs-utils/async-stop-watching-changes (buffer)
(defun haskell-utils-async-stop-watching-changes (buffer)
"Clean up after async operation finished.
This function takes care about cleaning up things made by
`hs-utils/async-watch-changes'. The BUFFER argument is a buffer where
`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 hs-utils/async-post-command-flag nil)
(setq haskell-utils-async-post-command-flag nil)
(remove-hook
'post-command-hook #'hs-utils/async-update-post-command-flag t)))
'post-command-hook #'haskell-utils-async-update-post-command-flag t)))

(defun haskell-utils-reduce-string (s)
"Remove newlines ans extra whitespace from S.
Removes all extra whitespace at the beginning of each line leaving
only single one. Then removes all newlines."
(let ((s_ (replace-regexp-in-string "^\s+" " " s)))
(replace-regexp-in-string "\n" "" s_)))

(defun hs-utils/parse-repl-response (r)
(defun haskell-utils-parse-repl-response (r)
"Parse response R from REPL and return special kind of result.
The result is response string itself with speacial property
response-type added.
Expand All @@ -1028,8 +1030,5 @@ This property could be of the following:
((string-match-p "^<interactive>:" first-line) 'interactive-error)
(t 'success))))




(provide 'haskell-commands)
;;; haskell-commands.el ends here
3 changes: 0 additions & 3 deletions haskell-utils.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,6 @@ 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
Expand All @@ -68,7 +67,5 @@ Note: doesn't detect if in {--}-style comment."
"\\([[:digit:][:upper:][:lower:]_.]+\\)"))
(match-string-no-properties 1))))


(provide 'haskell-utils)

;;; haskell-utils.el ends here

0 comments on commit 60da3c4

Please sign in to comment.