Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Rename prefix hs-utils/ to haskell-utils- #646

Merged
merged 1 commit into from
May 13, 2015
Merged

Rename prefix hs-utils/ to haskell-utils- #646

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
85 changes: 42 additions & 43 deletions haskell-commands.el
View file
Open in desktop
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
Open in desktop
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