Klimi's new dotfiles with stow.
Non puoi selezionare più di 25 argomenti Gli argomenti devono iniziare con una lettera o un numero, possono includere trattini ('-') e possono essere lunghi fino a 35 caratteri.

757 righe
27 KiB

  1. ;;; haskell-debug.el --- Debugging mode via GHCi -*- lexical-binding: t -*-
  2. ;; Copyright © 2014 Chris Done. All rights reserved.
  3. ;; 2016 Arthur Fayzrakhmanov
  4. ;; This file is free software; you can redistribute it and/or modify
  5. ;; it under the terms of the GNU General Public License as published by
  6. ;; the Free Software Foundation; either version 3, or (at your option)
  7. ;; any later version.
  8. ;; This file is distributed in the hope that it will be useful,
  9. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. ;; GNU General Public License for more details.
  12. ;; You should have received a copy of the GNU General Public License
  13. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  14. ;;; Code:
  15. (require 'cl-lib)
  16. (require 'haskell-session)
  17. (require 'haskell-process)
  18. (require 'haskell-interactive-mode)
  19. (require 'haskell-font-lock)
  20. (require 'haskell-utils)
  21. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22. ;; Configuration
  23. ;;;###autoload
  24. (defgroup haskell-debug nil
  25. "Settings for debugging support."
  26. :link '(custom-manual "(haskell-mode)haskell-debug")
  27. :group 'haskell)
  28. ;;;###autoload
  29. (defface haskell-debug-warning-face
  30. '((t :inherit 'compilation-warning))
  31. "Face for warnings."
  32. :group 'haskell-debug)
  33. ;;;###autoload
  34. (defface haskell-debug-trace-number-face
  35. '((t :weight bold :background "#f5f5f5"))
  36. "Face for numbers in backtrace."
  37. :group 'haskell-debug)
  38. ;;;###autoload
  39. (defface haskell-debug-newline-face
  40. '((t :weight bold :background "#f0f0f0"))
  41. "Face for newlines in trace steps."
  42. :group 'haskell-debug)
  43. ;;;###autoload
  44. (defface haskell-debug-keybinding-face
  45. '((t :inherit 'font-lock-type-face :weight bold))
  46. "Face for keybindings."
  47. :group 'haskell-debug)
  48. ;;;###autoload
  49. (defface haskell-debug-heading-face
  50. '((t :inherit 'font-lock-keyword-face))
  51. "Face for headings."
  52. :group 'haskell-debug)
  53. ;;;###autoload
  54. (defface haskell-debug-muted-face
  55. '((t :foreground "#999"))
  56. "Face for muteds."
  57. :group 'haskell-debug)
  58. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  59. ;; Mode
  60. (defvar haskell-debug-mode-map
  61. (let ((map (make-sparse-keymap)))
  62. (define-key map (kbd "g") 'haskell-debug/refresh)
  63. (define-key map (kbd "s") 'haskell-debug/step)
  64. (define-key map (kbd "t") 'haskell-debug/trace)
  65. (define-key map (kbd "d") 'haskell-debug/delete)
  66. (define-key map (kbd "b") 'haskell-debug/break-on-function)
  67. (define-key map (kbd "a") 'haskell-debug/abandon)
  68. (define-key map (kbd "c") 'haskell-debug/continue)
  69. (define-key map (kbd "p") 'haskell-debug/previous)
  70. (define-key map (kbd "n") 'haskell-debug/next)
  71. (define-key map (kbd "RET") 'haskell-debug/select)
  72. map)
  73. "Keymap for `haskell-debug-mode'.")
  74. (define-derived-mode haskell-debug-mode
  75. text-mode "Debug"
  76. "Major mode for debugging Haskell via GHCi.")
  77. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  78. ;; Globals
  79. (defvar haskell-debug-history-cache nil
  80. "Cache of the tracing history.")
  81. (defvar haskell-debug-bindings-cache nil
  82. "Cache of the current step's bindings.")
  83. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  84. ;; Macros
  85. (defmacro haskell-debug-with-breakpoints (&rest body)
  86. "Breakpoints need to exist to start stepping."
  87. `(if (haskell-debug-get-breakpoints)
  88. ,@body
  89. (error "No breakpoints to step into!")))
  90. (defmacro haskell-debug-with-modules (&rest body)
  91. "Modules need to exist to do debugging stuff."
  92. `(if (haskell-debug-get-modules)
  93. ,@body
  94. (error "No modules loaded!")))
  95. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  96. ;; Interactive functions
  97. (defun haskell-debug/select ()
  98. "Select whatever is at point."
  99. (interactive)
  100. (cond
  101. ((get-text-property (point) 'break)
  102. (let ((break (get-text-property (point) 'break)))
  103. (haskell-debug-highlight (plist-get break :path)
  104. (plist-get break :span))))
  105. ((get-text-property (point) 'module)
  106. (let ((break (get-text-property (point) 'module)))
  107. (haskell-debug-highlight (plist-get break :path))))))
  108. (defun haskell-debug/abandon ()
  109. "Abandon the current computation."
  110. (interactive)
  111. (haskell-debug-with-breakpoints
  112. (haskell-process-queue-sync-request (haskell-debug-process) ":abandon")
  113. (message "Computation abandoned.")
  114. (setq haskell-debug-history-cache nil)
  115. (setq haskell-debug-bindings-cache nil)
  116. (haskell-debug/refresh)))
  117. (defun haskell-debug/continue ()
  118. "Continue the current computation."
  119. (interactive)
  120. (haskell-debug-with-breakpoints
  121. (haskell-process-queue-sync-request (haskell-debug-process) ":continue")
  122. (message "Computation continued.")
  123. (setq haskell-debug-history-cache nil)
  124. (setq haskell-debug-bindings-cache nil)
  125. (haskell-debug/refresh)))
  126. (defun haskell-debug/break-on-function ()
  127. "Break on function IDENT."
  128. (interactive)
  129. (haskell-debug-with-modules
  130. (let ((ident (read-from-minibuffer "Function: "
  131. (haskell-ident-at-point))))
  132. (haskell-process-queue-sync-request
  133. (haskell-debug-process)
  134. (concat ":break "
  135. ident))
  136. (message "Breaking on function: %s" ident)
  137. (haskell-debug/refresh))))
  138. (defun haskell-debug/start-step (expr)
  139. "Start stepping EXPR."
  140. (interactive (list (read-from-minibuffer "Expression to step through: ")))
  141. (haskell-debug/step expr))
  142. (defun haskell-debug/breakpoint-numbers ()
  143. "List breakpoint numbers."
  144. (interactive)
  145. (let ((breakpoints (mapcar (lambda (breakpoint)
  146. (number-to-string (plist-get breakpoint :number)))
  147. (haskell-debug-get-breakpoints))))
  148. (if (null breakpoints)
  149. (message "No breakpoints.")
  150. (message "Breakpoint(s): %s"
  151. (mapconcat #'identity
  152. breakpoints
  153. ", ")))))
  154. (defun haskell-debug/next ()
  155. "Go to next step to inspect bindings."
  156. (interactive)
  157. (haskell-debug-with-breakpoints
  158. (haskell-debug-navigate "forward")))
  159. (defun haskell-debug/previous ()
  160. "Go to previous step to inspect the bindings."
  161. (interactive)
  162. (haskell-debug-with-breakpoints
  163. (haskell-debug-navigate "back")))
  164. (defun haskell-debug/refresh ()
  165. "Refresh the debugger buffer."
  166. (interactive)
  167. (with-current-buffer (haskell-debug-buffer-name (haskell-debug-session))
  168. (cd (haskell-session-current-dir (haskell-debug-session)))
  169. (let ((inhibit-read-only t)
  170. (p (point)))
  171. (erase-buffer)
  172. (insert (propertize (concat "Debugging "
  173. (haskell-session-name (haskell-debug-session))
  174. "\n\n")
  175. 'face `((:weight bold))))
  176. (let ((modules (haskell-debug-get-modules))
  177. (breakpoints (haskell-debug-get-breakpoints))
  178. (context (haskell-debug-get-context))
  179. (history (haskell-debug-get-history)))
  180. (unless modules
  181. (insert (propertize "You have to load a module to start debugging."
  182. 'face
  183. 'haskell-debug-warning-face)
  184. "\n\n"))
  185. (haskell-debug-insert-bindings modules breakpoints context)
  186. (when modules
  187. (haskell-debug-insert-current-context context history)
  188. (haskell-debug-insert-breakpoints breakpoints))
  189. (haskell-debug-insert-modules modules))
  190. (insert "\n")
  191. (goto-char (min (point-max) p)))))
  192. (defun haskell-debug/delete ()
  193. "Delete whatever's at the point."
  194. (interactive)
  195. (cond
  196. ((get-text-property (point) 'break)
  197. (let ((break (get-text-property (point) 'break)))
  198. (haskell-mode-toggle-interactive-prompt-state)
  199. (unwind-protect
  200. (when (y-or-n-p (format "Delete breakpoint #%d?"
  201. (plist-get break :number)))
  202. (haskell-process-queue-sync-request
  203. (haskell-debug-process)
  204. (format ":delete %d"
  205. (plist-get break :number)))
  206. (haskell-debug/refresh))
  207. (haskell-mode-toggle-interactive-prompt-state t))))))
  208. (defun haskell-debug/trace ()
  209. "Trace the expression."
  210. (interactive)
  211. (haskell-debug-with-modules
  212. (haskell-debug-with-breakpoints
  213. (let ((expr (read-from-minibuffer "Expression to trace: "
  214. (haskell-ident-at-point))))
  215. (haskell-process-queue-sync-request
  216. (haskell-debug-process)
  217. (concat ":trace " expr))
  218. (message "Tracing expression: %s" expr)
  219. (haskell-debug/refresh)))))
  220. (defun haskell-debug/step (&optional expr)
  221. "Step into the next function."
  222. (interactive)
  223. (haskell-debug-with-breakpoints
  224. (let* ((breakpoints (haskell-debug-get-breakpoints))
  225. (context (haskell-debug-get-context))
  226. (string
  227. (haskell-process-queue-sync-request
  228. (haskell-debug-process)
  229. (if expr
  230. (concat ":step " expr)
  231. ":step"))))
  232. (cond
  233. ((string= string "not stopped at a breakpoint\n")
  234. (if haskell-debug-bindings-cache
  235. (progn (setq haskell-debug-bindings-cache nil)
  236. (haskell-debug/refresh))
  237. (call-interactively 'haskell-debug/start-step)))
  238. (t (let ((maybe-stopped-at (haskell-debug-parse-stopped-at string)))
  239. (cond
  240. (maybe-stopped-at
  241. (setq haskell-debug-bindings-cache
  242. maybe-stopped-at)
  243. (message "Computation paused.")
  244. (haskell-debug/refresh))
  245. (t
  246. (if context
  247. (message "Computation finished.")
  248. (progn
  249. (haskell-mode-toggle-interactive-prompt-state)
  250. (unwind-protect
  251. (when (y-or-n-p "Computation completed without breaking. Reload the module and retry?")
  252. (message "Reloading and resetting breakpoints...")
  253. (haskell-interactive-mode-reset-error (haskell-debug-session))
  254. (cl-loop for break in breakpoints
  255. do (haskell-process-queue-sync-request
  256. (haskell-debug-process)
  257. (concat ":load " (plist-get break :path))))
  258. (cl-loop for break in breakpoints
  259. do (haskell-debug-break break))
  260. (haskell-debug/step expr))
  261. (haskell-mode-toggle-interactive-prompt-state t))))))))))
  262. (haskell-debug/refresh)))
  263. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  264. ;; Internal functions
  265. (defun haskell-debug-session ()
  266. "Get the Haskell session."
  267. (or (haskell-session-maybe)
  268. (error "No Haskell session associated with this debug
  269. buffer. Please just close the buffer and start again.")))
  270. (defun haskell-debug-process ()
  271. "Get the Haskell session."
  272. (or (haskell-session-process (haskell-session-maybe))
  273. (error "No Haskell session associated with this debug
  274. buffer. Please just close the buffer and start again.")))
  275. (defun haskell-debug-buffer-name (session)
  276. "The debug buffer name for the current session."
  277. (format "*debug:%s*"
  278. (haskell-session-name session)))
  279. (defun haskell-debug-get-breakpoints ()
  280. "Get the list of breakpoints currently set."
  281. (let ((string (haskell-process-queue-sync-request
  282. (haskell-debug-process)
  283. ":show breaks")))
  284. (if (string= string "No active breakpoints.\n")
  285. (list)
  286. (mapcar #'haskell-debug-parse-break-point
  287. (haskell-debug-split-string string)))))
  288. (defun haskell-debug-get-modules ()
  289. "Get the list of modules currently set."
  290. (let ((string (haskell-process-queue-sync-request
  291. (haskell-debug-process)
  292. ":show modules")))
  293. (if (string= string "")
  294. (list)
  295. (mapcar #'haskell-debug-parse-module
  296. (haskell-debug-split-string string)))))
  297. (defun haskell-debug-get-context ()
  298. "Get the current context."
  299. (let ((string (haskell-process-queue-sync-request
  300. (haskell-debug-process)
  301. ":show context")))
  302. (if (string= string "")
  303. nil
  304. (haskell-debug-parse-context string))))
  305. (defun haskell-debug-get-history ()
  306. "Get the step history."
  307. (let ((string (haskell-process-queue-sync-request
  308. (haskell-debug-process)
  309. ":history")))
  310. (if (or (string= string "")
  311. (string= string "Not stopped at a breakpoint\n"))
  312. nil
  313. (if (string= string "Empty history. Perhaps you forgot to use :trace?\n")
  314. nil
  315. (let ((entries (mapcar #'haskell-debug-parse-history-entry
  316. (cl-remove-if (lambda (line) (or (string= "<end of history>" line)
  317. (string= "..." line)))
  318. (haskell-debug-split-string string)))))
  319. (setq haskell-debug-history-cache
  320. entries)
  321. entries)))))
  322. (defun haskell-debug-insert-bindings (modules breakpoints context)
  323. "Insert a list of bindings."
  324. (if breakpoints
  325. (progn (haskell-debug-insert-binding "t" "trace an expression")
  326. (haskell-debug-insert-binding "s" "step into an expression")
  327. (haskell-debug-insert-binding "b" "breakpoint" t))
  328. (progn
  329. (when modules
  330. (haskell-debug-insert-binding "b" "breakpoint"))
  331. (when breakpoints
  332. (haskell-debug-insert-binding "s" "step into an expression" t))))
  333. (when breakpoints
  334. (haskell-debug-insert-binding "d" "delete breakpoint"))
  335. (when context
  336. (haskell-debug-insert-binding "a" "abandon context")
  337. (haskell-debug-insert-binding "c" "continue" t))
  338. (when context
  339. (haskell-debug-insert-binding "p" "previous step")
  340. (haskell-debug-insert-binding "n" "next step" t))
  341. (haskell-debug-insert-binding "g" "refresh" t)
  342. (insert "\n"))
  343. (defun haskell-debug-insert-current-context (context history)
  344. "Insert the current context."
  345. (haskell-debug-insert-header "Context")
  346. (if context
  347. (haskell-debug-insert-context context history)
  348. (haskell-debug-insert-debug-finished))
  349. (insert "\n"))
  350. (defun haskell-debug-insert-breakpoints (breakpoints)
  351. "insert the list of breakpoints."
  352. (haskell-debug-insert-header "Breakpoints")
  353. (if (null breakpoints)
  354. (haskell-debug-insert-muted "No active breakpoints.")
  355. (cl-loop for break in breakpoints
  356. do (insert (propertize (format "%d"
  357. (plist-get break :number))
  358. 'face `((:weight bold))
  359. 'break break)
  360. (haskell-debug-muted " - ")
  361. (propertize (plist-get break :module)
  362. 'break break
  363. 'break break)
  364. (haskell-debug-muted
  365. (format " (%d:%d)"
  366. (plist-get (plist-get break :span) :start-line)
  367. (plist-get (plist-get break :span) :start-col)))
  368. "\n")))
  369. (insert "\n"))
  370. (defun haskell-debug-insert-modules (modules)
  371. "Insert the list of modules."
  372. (haskell-debug-insert-header "Modules")
  373. (if (null modules)
  374. (haskell-debug-insert-muted "No loaded modules.")
  375. (progn (cl-loop for module in modules
  376. do (insert (propertize (plist-get module :module)
  377. 'module module
  378. 'face `((:weight bold)))
  379. (haskell-debug-muted " - ")
  380. (propertize (file-name-nondirectory (plist-get module :path))
  381. 'module module))
  382. do (insert "\n")))))
  383. (defun haskell-debug-split-string (string)
  384. "Split GHCi's line-based output, stripping the trailing newline."
  385. (split-string string "\n" t))
  386. (defun haskell-debug-parse-context (string)
  387. "Parse the context."
  388. (cond
  389. ((string-match "^--> \\(.+\\)\n \\(.+\\)" string)
  390. (let ((name (match-string 1 string))
  391. (stopped (haskell-debug-parse-stopped-at (match-string 2 string))))
  392. (list :name name
  393. :path (plist-get stopped :path)
  394. :span (plist-get stopped :span))))))
  395. (defun haskell-debug-insert-binding (binding desc &optional end)
  396. "Insert a helpful keybinding."
  397. (insert (propertize binding 'face 'haskell-debug-keybinding-face)
  398. (haskell-debug-muted " - ")
  399. desc
  400. (if end
  401. "\n"
  402. (haskell-debug-muted ", "))))
  403. (defun haskell-debug-insert-header (title)
  404. "Insert a header title."
  405. (insert (propertize title
  406. 'face 'haskell-debug-heading-face)
  407. "\n\n"))
  408. (defun haskell-debug-insert-context (context history)
  409. "Insert the context and history."
  410. (when context
  411. (insert (propertize (plist-get context :name) 'face `((:weight bold)))
  412. (haskell-debug-muted " - ")
  413. (file-name-nondirectory (plist-get context :path))
  414. (haskell-debug-muted " (stopped)")
  415. "\n"))
  416. (when haskell-debug-bindings-cache
  417. (insert "\n")
  418. (let ((bindings haskell-debug-bindings-cache))
  419. (insert
  420. (haskell-debug-get-span-string
  421. (plist-get bindings :path)
  422. (plist-get bindings :span)))
  423. (insert "\n\n")
  424. (cl-loop for binding in (plist-get bindings :types)
  425. do (insert (haskell-fontify-as-mode binding 'haskell-mode)
  426. "\n"))))
  427. (let ((history (or history
  428. (list (haskell-debug-make-fake-history context)))))
  429. (when history
  430. (insert "\n")
  431. (haskell-debug-insert-history history))))
  432. (defun haskell-debug-insert-debug-finished ()
  433. "Insert message that no debugging is happening, but if there is
  434. some old history, then display that."
  435. (if haskell-debug-history-cache
  436. (progn (haskell-debug-insert-muted "Finished debugging.")
  437. (insert "\n")
  438. (haskell-debug-insert-history haskell-debug-history-cache))
  439. (haskell-debug-insert-muted "Not debugging right now.")))
  440. (defun haskell-debug-insert-muted (text)
  441. "Insert some muted text."
  442. (insert (haskell-debug-muted text)
  443. "\n"))
  444. (defun haskell-debug-muted (text)
  445. "Make some muted text."
  446. (propertize text 'face 'haskell-debug-muted-face))
  447. (defun haskell-debug-parse-logged (string)
  448. "Parse the logged breakpoint."
  449. (cond
  450. ((string= "no more logged breakpoints\n" string)
  451. nil)
  452. ((string= "already at the beginning of the history\n" string)
  453. nil)
  454. (t
  455. (with-temp-buffer
  456. (insert string)
  457. (goto-char (point-min))
  458. (list :path (progn (search-forward " at ")
  459. (buffer-substring-no-properties
  460. (point)
  461. (1- (search-forward ":"))))
  462. :span (haskell-debug-parse-span
  463. (buffer-substring-no-properties
  464. (point)
  465. (line-end-position)))
  466. :types (progn (forward-line)
  467. (haskell-debug-split-string
  468. (buffer-substring-no-properties
  469. (point)
  470. (point-max)))))))))
  471. (defun haskell-debug-parse-stopped-at (string)
  472. "Parse the location stopped at from the given string.
  473. For example:
  474. Stopped at /home/foo/project/src/x.hs:6:25-36
  475. "
  476. (let ((index (string-match "Stopped at \\([^:]+\\):\\(.+\\)\n?"
  477. string)))
  478. (when index
  479. (list :path (match-string 1 string)
  480. :span (haskell-debug-parse-span (match-string 2 string))
  481. :types (cdr (haskell-debug-split-string (substring string index)))))))
  482. (defun haskell-debug-get-span-string (path span)
  483. "Get the string from the PATH and the SPAN."
  484. (save-window-excursion
  485. (find-file path)
  486. (buffer-substring
  487. (save-excursion
  488. (goto-char (point-min))
  489. (forward-line (1- (plist-get span :start-line)))
  490. (forward-char (1- (plist-get span :start-col)))
  491. (point))
  492. (save-excursion
  493. (goto-char (point-min))
  494. (forward-line (1- (plist-get span :end-line)))
  495. (forward-char (plist-get span :end-col))
  496. (point)))))
  497. (defun haskell-debug-make-fake-history (context)
  498. "Make a fake history item."
  499. (list :index -1
  500. :path (plist-get context :path)
  501. :span (plist-get context :span)))
  502. (defun haskell-debug-insert-history (history)
  503. "Insert tracing HISTORY."
  504. (let ((i (length history)))
  505. (cl-loop for span in history
  506. do (let ((string (haskell-debug-get-span-string
  507. (plist-get span :path)
  508. (plist-get span :span))))
  509. (insert (propertize (format "%4d" i)
  510. 'face 'haskell-debug-trace-number-face)
  511. " "
  512. (haskell-debug-preview-span
  513. (plist-get span :span)
  514. string
  515. t)
  516. "\n")
  517. (setq i (1- i))))))
  518. (defun haskell-debug-parse-span (string)
  519. "Parse a source span from a string.
  520. Examples:
  521. (5,1)-(6,37)
  522. 6:25-36
  523. 5:20
  524. People like to make other people's lives interesting by making
  525. variances in source span notation."
  526. (cond
  527. ((string-match "\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\)"
  528. string)
  529. (list :start-line (string-to-number (match-string 1 string))
  530. :start-col (string-to-number (match-string 2 string))
  531. :end-line (string-to-number (match-string 1 string))
  532. :end-col (string-to-number (match-string 3 string))))
  533. ((string-match "\\([0-9]+\\):\\([0-9]+\\)"
  534. string)
  535. (list :start-line (string-to-number (match-string 1 string))
  536. :start-col (string-to-number (match-string 2 string))
  537. :end-line (string-to-number (match-string 1 string))
  538. :end-col (string-to-number (match-string 2 string))))
  539. ((string-match "(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\))"
  540. string)
  541. (list :start-line (string-to-number (match-string 1 string))
  542. :start-col (string-to-number (match-string 2 string))
  543. :end-line (string-to-number (match-string 3 string))
  544. :end-col (string-to-number (match-string 4 string))))
  545. (t (error "Unable to parse source span from string: %s"
  546. string))))
  547. (defun haskell-debug-preview-span (span string &optional collapsed)
  548. "Make a one-line preview of the given expression."
  549. (with-temp-buffer
  550. (haskell-mode)
  551. (insert string)
  552. (when (/= 0 (plist-get span :start-col))
  553. (indent-rigidly (point-min)
  554. (point-max)
  555. 1))
  556. (if (fboundp 'font-lock-ensure)
  557. (font-lock-ensure)
  558. (with-no-warnings (font-lock-fontify-buffer)))
  559. (when (/= 0 (plist-get span :start-col))
  560. (indent-rigidly (point-min)
  561. (point-max)
  562. -1))
  563. (goto-char (point-min))
  564. (if collapsed
  565. (replace-regexp-in-string
  566. "\n[ ]*"
  567. (propertize " " 'face 'haskell-debug-newline-face)
  568. (buffer-substring (point-min)
  569. (point-max)))
  570. (buffer-string))))
  571. (defun haskell-debug-start (session)
  572. "Start the debug mode."
  573. (setq buffer-read-only t)
  574. (haskell-session-assign session)
  575. (haskell-debug/refresh))
  576. (defun haskell-debug ()
  577. "Start the debugger for the current Haskell (GHCi) session."
  578. (interactive)
  579. (let ((session (haskell-debug-session)))
  580. (switch-to-buffer-other-window (haskell-debug-buffer-name session))
  581. (unless (eq major-mode 'haskell-debug-mode)
  582. (haskell-debug-mode)
  583. (haskell-debug-start session))))
  584. (defun haskell-debug-break (break)
  585. "Set BREAK breakpoint in module at line/col."
  586. (haskell-process-queue-without-filters
  587. (haskell-debug-process)
  588. (format ":break %s %s %d"
  589. (plist-get break :module)
  590. (plist-get (plist-get break :span) :start-line)
  591. (plist-get (plist-get break :span) :start-col))))
  592. (defun haskell-debug-navigate (direction)
  593. "Navigate in DIRECTION \"back\" or \"forward\"."
  594. (let ((string (haskell-process-queue-sync-request
  595. (haskell-debug-process)
  596. (concat ":" direction))))
  597. (let ((bindings (haskell-debug-parse-logged string)))
  598. (setq haskell-debug-bindings-cache
  599. bindings)
  600. (when (not bindings)
  601. (message "No more %s results!" direction)))
  602. (haskell-debug/refresh)))
  603. (defun haskell-debug-session-debugging-p (session)
  604. "Does the session have a debugging buffer open?"
  605. (not (not (get-buffer (haskell-debug-buffer-name session)))))
  606. (defun haskell-debug-highlight (path &optional span)
  607. "Highlight the file at span."
  608. (let ((p (make-overlay
  609. (line-beginning-position)
  610. (line-end-position))))
  611. (overlay-put p 'face `((:background "#eee")))
  612. (with-current-buffer
  613. (if span
  614. (save-window-excursion
  615. (find-file path)
  616. (current-buffer))
  617. (find-file path)
  618. (current-buffer))
  619. (let ((o (when span
  620. (make-overlay
  621. (save-excursion
  622. (goto-char (point-min))
  623. (forward-line (1- (plist-get span :start-line)))
  624. (forward-char (1- (plist-get span :start-col)))
  625. (point))
  626. (save-excursion
  627. (goto-char (point-min))
  628. (forward-line (1- (plist-get span :end-line)))
  629. (forward-char (plist-get span :end-col))
  630. (point))))))
  631. (when o
  632. (overlay-put o 'face `((:background "#eee"))))
  633. (sit-for 0.5)
  634. (when o
  635. (delete-overlay o))
  636. (delete-overlay p)))))
  637. (defun haskell-debug-parse-history-entry (string)
  638. "Parse a history entry."
  639. (if (string-match "^\\([-0-9]+\\)[ ]+:[ ]+\\([A-Za-z0-9_':]+\\)[ ]+(\\([^:]+\\):\\(.+?\\))$"
  640. string)
  641. (list :index (string-to-number (match-string 1 string))
  642. :name (match-string 2 string)
  643. :path (match-string 3 string)
  644. :span (haskell-debug-parse-span (match-string 4 string)))
  645. (error "Unable to parse history entry: %s" string)))
  646. (defun haskell-debug-parse-module (string)
  647. "Parse a module and path.
  648. For example:
  649. X ( /home/foo/X.hs, interpreted )
  650. Main ( /home/foo/X.hs, /home/foo/X.o )
  651. "
  652. (if (string-match "\\([^ ]+\\)[ ]+( \\([^ ]+?\\), [/a-zA-Z0-9\.]+ )$"
  653. string)
  654. (list :module (match-string 1 string)
  655. :path (match-string 2 string))
  656. (error "Unable to parse module from string: %s"
  657. string)))
  658. (defun haskell-debug-parse-break-point (string)
  659. "Parse a breakpoint number, module and location from a string.
  660. For example:
  661. [13] Main /home/foo/src/x.hs:(5,1)-(6,37)
  662. "
  663. (if (string-match "^\\[\\([0-9]+\\)\\] \\([^ ]+\\) \\([^:]+\\):\\(.+\\)$"
  664. string)
  665. (list :number (string-to-number (match-string 1 string))
  666. :module (match-string 2 string)
  667. :path (match-string 3 string)
  668. :span (haskell-debug-parse-span (match-string 4 string)))
  669. (error "Unable to parse breakpoint from string: %s"
  670. string)))
  671. (provide 'haskell-debug)
  672. ;;; haskell-debug.el ends here