Klimi's new dotfiles with stow.
25개 이상의 토픽을 선택하실 수 없습니다. Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

193 lines
7.4 KiB

  1. ;;; haskell-utils.el --- General utility functions used by haskell-mode modules -*- lexical-binding: t -*-
  2. ;; Copyright © 2013 Herbert Valerio Riedel
  3. ;; 2016 Arthur Fayzrakhmanov
  4. ;; Author: Herbert Valerio Riedel <hvr@gnu.org>
  5. ;; This file is not part of GNU Emacs.
  6. ;; This file is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 3 of the License, or
  9. ;; (at your option) any later version.
  10. ;; This file is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. ;; GNU General Public License for more details.
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  16. ;;; Commentary:
  17. ;; This module's purpose is to provide a place for helper functions
  18. ;; which are general enough to be usable by multiple modules and/or
  19. ;; to alleviate circular module dependency problems.
  20. ;;
  21. ;; When possible, functions in this module shall be accompanied by
  22. ;; ERT-based unit tests.
  23. ;;
  24. ;; See also `haskell-str.el' for string utility functions.
  25. ;;
  26. ;; All symbols in this module have a `haskell-utils-' prefix.
  27. ;;; Code:
  28. ;; =============================================================================
  29. ;; NOTE:
  30. ;; THIS MODULE IS SUPPOSED TO BE A LEAF-MODULE AND SHALL NOT REQUIRE/DEPEND-ON
  31. ;; ANY OTHER HASKELL-MODE MODULES IN ORDER TO STAY AT THE BOTTOM OF THE MODULE
  32. ;; DEPENDENCY GRAPH.
  33. ;; =============================================================================
  34. (eval-when-compile (require 'cl-lib))
  35. (defvar-local haskell-utils-async-post-command-flag nil
  36. "Non-nil means some commands were triggered during async function execution.")
  37. (defvar haskell-mode-interactive-prompt-state nil
  38. "Special variable indicating a state of user input waiting.")
  39. (defun haskell-utils-read-directory-name (prompt default)
  40. "Read directory name and normalize to true absolute path.
  41. Refer to `read-directory-name' for the meaning of PROMPT and
  42. DEFAULT. If `haskell-process-load-or-reload-prompt' is nil,
  43. accept `default'."
  44. (let ((filename (file-truename (read-directory-name prompt default default))))
  45. (concat (replace-regexp-in-string "/$" "" filename) "/")))
  46. (defun haskell-utils-parse-import-statement-at-point ()
  47. "Return imported module name if on import statement or nil otherwise.
  48. This currently assumes that the \"import\" keyword and the module
  49. name are on the same line.
  50. This function supports the SafeHaskell and PackageImports syntax extensions.
  51. Note: doesn't detect if in {--}-style comment."
  52. (save-excursion
  53. (goto-char (line-beginning-position))
  54. (if (looking-at (concat "[\t ]*import[\t ]+"
  55. "\\(?:safe[\t ]+\\)?" ;; SafeHaskell
  56. "\\(?:qualified[\t ]+\\)?"
  57. "\\(?:\"[^\"]*\"[\t ]+\\)?" ;; PackageImports
  58. "\\([[:digit:][:upper:][:lower:]_.]+\\)"))
  59. (match-string-no-properties 1))))
  60. (defun haskell-utils-async-update-post-command-flag ()
  61. "A special hook which collects triggered commands during async execution.
  62. This hook pushes value of variable `this-command' to flag variable
  63. `haskell-utils-async-post-command-flag'."
  64. (let* ((cmd this-command)
  65. (updated-flag (cons cmd haskell-utils-async-post-command-flag)))
  66. (setq haskell-utils-async-post-command-flag updated-flag)))
  67. (defun haskell-utils-async-watch-changes ()
  68. "Watch for triggered commands during async operation execution.
  69. Resets flag variable
  70. `haskell-utils-async-update-post-command-flag' to NIL. By changes it is
  71. assumed that nothing happened, e.g. nothing was inserted in
  72. buffer, point was not moved, etc. To collect data `post-command-hook' is used."
  73. (setq haskell-utils-async-post-command-flag nil)
  74. (add-hook
  75. 'post-command-hook #'haskell-utils-async-update-post-command-flag nil t))
  76. (defun haskell-utils-async-stop-watching-changes (buffer)
  77. "Clean up after async operation finished.
  78. This function takes care about cleaning up things made by
  79. `haskell-utils-async-watch-changes'. The BUFFER argument is a buffer where
  80. `post-command-hook' should be disabled. This is neccessary, because
  81. it is possible that user will change buffer during async function
  82. execusion."
  83. (with-current-buffer buffer
  84. (setq haskell-utils-async-post-command-flag nil)
  85. (remove-hook
  86. 'post-command-hook #'haskell-utils-async-update-post-command-flag t)))
  87. (defun haskell-utils-reduce-string (str)
  88. "Remove newlines and extra whitespace from string STR.
  89. If line starts with a sequence of whitespaces, substitutes this
  90. sequence with a single whitespace. Removes all newline
  91. characters."
  92. (let ((s (replace-regexp-in-string "^\s+" " " str)))
  93. (replace-regexp-in-string "\r?\n" "" s)))
  94. (defun haskell-utils-repl-response-error-status (response)
  95. "Parse response REPL's RESPONSE for errors.
  96. Returns one of the following symbols:
  97. + unknown-command
  98. + option-missing
  99. + interactive-error
  100. + no-error
  101. *Warning*: this funciton covers only three kind of responses:
  102. * \"unknown command \"
  103. REPL missing requested command
  104. * \"<interactive>:3:5: \"
  105. interactive REPL error
  106. * \"Couldn't guess that module name. Does it exist?\"
  107. (:type-at and maybe some other commands error)
  108. * *all other reposnses* are treated as success reposneses and
  109. 'no-error is returned."
  110. (if response
  111. (let ((first-line (car (split-string response "\n" t))))
  112. (cond
  113. ((null first-line) 'no-error)
  114. ((string-match-p "^unknown command" first-line)
  115. 'unknown-command)
  116. ((string-match-p
  117. "^Couldn't guess that module name. Does it exist?"
  118. first-line)
  119. 'option-missing)
  120. ((string-match-p "^<interactive>:" first-line)
  121. 'interactive-error)
  122. (t 'no-error)))
  123. ;; in case of nil-ish reponse it's not clear is it error response or not
  124. 'no-error))
  125. (defun haskell-utils-compose-type-at-command (pos)
  126. "Prepare :type-at command to be send to haskell process.
  127. POS is a cons cell containing min and max positions, i.e. target
  128. expression bounds."
  129. (save-excursion
  130. (let ((start-p (car pos))
  131. (end-p (cdr pos))
  132. start-l
  133. start-c
  134. end-l
  135. end-c
  136. value)
  137. (goto-char start-p)
  138. (setq start-l (line-number-at-pos))
  139. (setq start-c (1+ (current-column)))
  140. (goto-char end-p)
  141. (setq end-l (line-number-at-pos))
  142. (setq end-c (1+ (current-column)))
  143. (setq value (buffer-substring-no-properties start-p end-p))
  144. ;; supress multiline expressions
  145. (let ((lines (split-string value "\n" t)))
  146. (when (and (cdr lines)
  147. (stringp (car lines)))
  148. (setq value (format "[ %s … ]" (car lines)))))
  149. (replace-regexp-in-string
  150. "\n$"
  151. ""
  152. (format ":type-at %s %d %d %d %d %s"
  153. (buffer-file-name)
  154. start-l
  155. start-c
  156. end-l
  157. end-c
  158. value)))))
  159. (defun haskell-mode-toggle-interactive-prompt-state (&optional disabled)
  160. "Set `haskell-mode-interactive-prompt-state' to t.
  161. If given DISABLED argument sets variable value to nil, otherwise to t."
  162. (setq haskell-mode-interactive-prompt-state (not disabled)))
  163. (provide 'haskell-utils)
  164. ;;; haskell-utils.el ends here