From 17ee0e400bef47c371afcae76037f9ea6a44ad13 Mon Sep 17 00:00:00 2001
From: William Carroll <wpcarro@gmail.com>
Date: Mon, 10 Sep 2018 14:51:14 -0400
Subject: Support Vim, Tmux, Emacs with Stow

After moving off of Meta, Dotfiles has a greater responsibility to
manage configs. Vim, Tmux, and Emacs are now within Stow's purview.
---
 .../haskell-mode-20180601.143/haskell-debug.el     | 757 +++++++++++++++++++++
 1 file changed, 757 insertions(+)
 create mode 100644 configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180601.143/haskell-debug.el

(limited to 'configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180601.143/haskell-debug.el')

diff --git a/configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180601.143/haskell-debug.el b/configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180601.143/haskell-debug.el
new file mode 100644
index 000000000000..38a6859bbd2f
--- /dev/null
+++ b/configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180601.143/haskell-debug.el
@@ -0,0 +1,757 @@
+;;; haskell-debug.el --- Debugging mode via GHCi -*- lexical-binding: t -*-
+
+;; Copyright © 2014 Chris Done. All rights reserved.
+;;             2016 Arthur Fayzrakhmanov
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'haskell-session)
+(require 'haskell-process)
+(require 'haskell-interactive-mode)
+(require 'haskell-font-lock)
+(require 'haskell-utils)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Configuration
+
+;;;###autoload
+(defgroup haskell-debug nil
+  "Settings for debugging support."
+  :link '(custom-manual "(haskell-mode)haskell-debug")
+  :group 'haskell)
+
+;;;###autoload
+(defface haskell-debug-warning-face
+  '((t :inherit 'compilation-warning))
+  "Face for warnings."
+  :group 'haskell-debug)
+
+;;;###autoload
+(defface haskell-debug-trace-number-face
+  '((t :weight bold :background "#f5f5f5"))
+  "Face for numbers in backtrace."
+  :group 'haskell-debug)
+
+;;;###autoload
+(defface haskell-debug-newline-face
+  '((t :weight bold :background "#f0f0f0"))
+  "Face for newlines in trace steps."
+  :group 'haskell-debug)
+
+;;;###autoload
+(defface haskell-debug-keybinding-face
+  '((t :inherit 'font-lock-type-face :weight bold))
+  "Face for keybindings."
+  :group 'haskell-debug)
+
+;;;###autoload
+(defface haskell-debug-heading-face
+  '((t :inherit 'font-lock-keyword-face))
+  "Face for headings."
+  :group 'haskell-debug)
+
+;;;###autoload
+(defface haskell-debug-muted-face
+  '((t :foreground "#999"))
+  "Face for muteds."
+  :group 'haskell-debug)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Mode
+
+(defvar haskell-debug-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "g") 'haskell-debug/refresh)
+    (define-key map (kbd "s") 'haskell-debug/step)
+    (define-key map (kbd "t") 'haskell-debug/trace)
+    (define-key map (kbd "d") 'haskell-debug/delete)
+    (define-key map (kbd "b") 'haskell-debug/break-on-function)
+    (define-key map (kbd "a") 'haskell-debug/abandon)
+    (define-key map (kbd "c") 'haskell-debug/continue)
+    (define-key map (kbd "p") 'haskell-debug/previous)
+    (define-key map (kbd "n") 'haskell-debug/next)
+    (define-key map (kbd "RET") 'haskell-debug/select)
+    map)
+  "Keymap for `haskell-debug-mode'.")
+
+(define-derived-mode haskell-debug-mode
+  text-mode "Debug"
+  "Major mode for debugging Haskell via GHCi.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Globals
+
+(defvar haskell-debug-history-cache nil
+  "Cache of the tracing history.")
+
+(defvar haskell-debug-bindings-cache nil
+  "Cache of the current step's bindings.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Macros
+
+(defmacro haskell-debug-with-breakpoints (&rest body)
+  "Breakpoints need to exist to start stepping."
+  `(if (haskell-debug-get-breakpoints)
+       ,@body
+     (error "No breakpoints to step into!")))
+
+(defmacro haskell-debug-with-modules (&rest body)
+  "Modules need to exist to do debugging stuff."
+  `(if (haskell-debug-get-modules)
+       ,@body
+     (error "No modules loaded!")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Interactive functions
+
+(defun haskell-debug/select ()
+  "Select whatever is at point."
+  (interactive)
+  (cond
+   ((get-text-property (point) 'break)
+    (let ((break (get-text-property (point) 'break)))
+      (haskell-debug-highlight (plist-get break :path)
+                               (plist-get break :span))))
+   ((get-text-property (point) 'module)
+    (let ((break (get-text-property (point) 'module)))
+      (haskell-debug-highlight (plist-get break :path))))))
+
+(defun haskell-debug/abandon ()
+  "Abandon the current computation."
+  (interactive)
+  (haskell-debug-with-breakpoints
+   (haskell-process-queue-sync-request (haskell-debug-process) ":abandon")
+   (message "Computation abandoned.")
+   (setq haskell-debug-history-cache nil)
+   (setq haskell-debug-bindings-cache nil)
+   (haskell-debug/refresh)))
+
+(defun haskell-debug/continue ()
+  "Continue the current computation."
+  (interactive)
+  (haskell-debug-with-breakpoints
+   (haskell-process-queue-sync-request (haskell-debug-process) ":continue")
+   (message "Computation continued.")
+   (setq haskell-debug-history-cache nil)
+   (setq haskell-debug-bindings-cache nil)
+   (haskell-debug/refresh)))
+
+(defun haskell-debug/break-on-function ()
+  "Break on function IDENT."
+  (interactive)
+  (haskell-debug-with-modules
+   (let ((ident (read-from-minibuffer "Function: "
+                                      (haskell-ident-at-point))))
+     (haskell-process-queue-sync-request
+      (haskell-debug-process)
+      (concat ":break "
+              ident))
+     (message "Breaking on function: %s" ident)
+     (haskell-debug/refresh))))
+
+(defun haskell-debug/start-step (expr)
+  "Start stepping EXPR."
+  (interactive (list (read-from-minibuffer "Expression to step through: ")))
+  (haskell-debug/step expr))
+
+(defun haskell-debug/breakpoint-numbers ()
+  "List breakpoint numbers."
+  (interactive)
+  (let ((breakpoints (mapcar (lambda (breakpoint)
+                               (number-to-string (plist-get breakpoint :number)))
+                             (haskell-debug-get-breakpoints))))
+    (if (null breakpoints)
+        (message "No breakpoints.")
+      (message "Breakpoint(s): %s"
+               (mapconcat #'identity
+                          breakpoints
+                          ", ")))))
+
+(defun haskell-debug/next ()
+  "Go to next step to inspect bindings."
+  (interactive)
+  (haskell-debug-with-breakpoints
+   (haskell-debug-navigate "forward")))
+
+(defun haskell-debug/previous ()
+  "Go to previous step to inspect the bindings."
+  (interactive)
+  (haskell-debug-with-breakpoints
+   (haskell-debug-navigate "back")))
+
+(defun haskell-debug/refresh ()
+  "Refresh the debugger buffer."
+  (interactive)
+  (with-current-buffer (haskell-debug-buffer-name (haskell-debug-session))
+    (cd (haskell-session-current-dir (haskell-debug-session)))
+    (let ((inhibit-read-only t)
+          (p (point)))
+      (erase-buffer)
+      (insert (propertize (concat "Debugging "
+                                  (haskell-session-name (haskell-debug-session))
+                                  "\n\n")
+                          'face `((:weight bold))))
+      (let ((modules (haskell-debug-get-modules))
+            (breakpoints (haskell-debug-get-breakpoints))
+            (context (haskell-debug-get-context))
+            (history (haskell-debug-get-history)))
+        (unless modules
+          (insert (propertize "You have to load a module to start debugging."
+                              'face
+                              'haskell-debug-warning-face)
+                  "\n\n"))
+        (haskell-debug-insert-bindings modules breakpoints context)
+        (when modules
+          (haskell-debug-insert-current-context context history)
+          (haskell-debug-insert-breakpoints breakpoints))
+        (haskell-debug-insert-modules modules))
+      (insert "\n")
+      (goto-char (min (point-max) p)))))
+
+(defun haskell-debug/delete ()
+  "Delete whatever's at the point."
+  (interactive)
+  (cond
+   ((get-text-property (point) 'break)
+    (let ((break (get-text-property (point) 'break)))
+      (haskell-mode-toggle-interactive-prompt-state)
+      (unwind-protect
+          (when (y-or-n-p (format "Delete breakpoint #%d?"
+                                  (plist-get break :number)))
+            (haskell-process-queue-sync-request
+             (haskell-debug-process)
+             (format ":delete %d"
+                     (plist-get break :number)))
+            (haskell-debug/refresh))
+        (haskell-mode-toggle-interactive-prompt-state t))))))
+
+(defun haskell-debug/trace ()
+  "Trace the expression."
+  (interactive)
+  (haskell-debug-with-modules
+   (haskell-debug-with-breakpoints
+    (let ((expr (read-from-minibuffer "Expression to trace: "
+                                      (haskell-ident-at-point))))
+      (haskell-process-queue-sync-request
+       (haskell-debug-process)
+       (concat ":trace " expr))
+      (message "Tracing expression: %s" expr)
+      (haskell-debug/refresh)))))
+
+(defun haskell-debug/step (&optional expr)
+  "Step into the next function."
+  (interactive)
+  (haskell-debug-with-breakpoints
+   (let* ((breakpoints (haskell-debug-get-breakpoints))
+          (context (haskell-debug-get-context))
+          (string
+           (haskell-process-queue-sync-request
+            (haskell-debug-process)
+            (if expr
+                (concat ":step " expr)
+              ":step"))))
+     (cond
+      ((string= string "not stopped at a breakpoint\n")
+       (if haskell-debug-bindings-cache
+           (progn (setq haskell-debug-bindings-cache nil)
+                  (haskell-debug/refresh))
+         (call-interactively 'haskell-debug/start-step)))
+      (t (let ((maybe-stopped-at (haskell-debug-parse-stopped-at string)))
+           (cond
+            (maybe-stopped-at
+             (setq haskell-debug-bindings-cache
+                   maybe-stopped-at)
+             (message "Computation paused.")
+             (haskell-debug/refresh))
+            (t
+             (if context
+                 (message "Computation finished.")
+               (progn
+                 (haskell-mode-toggle-interactive-prompt-state)
+                 (unwind-protect
+                     (when (y-or-n-p "Computation completed without breaking. Reload the module and retry?")
+                       (message "Reloading and resetting breakpoints...")
+                       (haskell-interactive-mode-reset-error (haskell-debug-session))
+                       (cl-loop for break in breakpoints
+                                do (haskell-process-queue-sync-request
+                                    (haskell-debug-process)
+                                    (concat ":load " (plist-get break :path))))
+                       (cl-loop for break in breakpoints
+                                do (haskell-debug-break break))
+                       (haskell-debug/step expr))
+                   (haskell-mode-toggle-interactive-prompt-state t))))))))))
+   (haskell-debug/refresh)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Internal functions
+
+(defun haskell-debug-session ()
+  "Get the Haskell session."
+  (or (haskell-session-maybe)
+      (error "No Haskell session associated with this debug
+      buffer. Please just close the buffer and start again.")))
+
+(defun haskell-debug-process ()
+  "Get the Haskell session."
+  (or (haskell-session-process (haskell-session-maybe))
+      (error "No Haskell session associated with this debug
+      buffer. Please just close the buffer and start again.")))
+
+(defun haskell-debug-buffer-name (session)
+  "The debug buffer name for the current session."
+  (format "*debug:%s*"
+          (haskell-session-name session)))
+
+(defun haskell-debug-get-breakpoints ()
+  "Get the list of breakpoints currently set."
+  (let ((string (haskell-process-queue-sync-request
+                 (haskell-debug-process)
+                 ":show breaks")))
+    (if (string= string "No active breakpoints.\n")
+        (list)
+      (mapcar #'haskell-debug-parse-break-point
+              (haskell-debug-split-string string)))))
+
+(defun haskell-debug-get-modules ()
+  "Get the list of modules currently set."
+  (let ((string (haskell-process-queue-sync-request
+                 (haskell-debug-process)
+                 ":show modules")))
+    (if (string= string "")
+        (list)
+      (mapcar #'haskell-debug-parse-module
+              (haskell-debug-split-string string)))))
+
+(defun haskell-debug-get-context ()
+  "Get the current context."
+  (let ((string (haskell-process-queue-sync-request
+                 (haskell-debug-process)
+                 ":show context")))
+    (if (string= string "")
+        nil
+      (haskell-debug-parse-context string))))
+
+(defun haskell-debug-get-history ()
+  "Get the step history."
+  (let ((string (haskell-process-queue-sync-request
+                 (haskell-debug-process)
+                 ":history")))
+    (if (or (string= string "")
+            (string= string "Not stopped at a breakpoint\n"))
+        nil
+      (if (string= string "Empty history. Perhaps you forgot to use :trace?\n")
+          nil
+        (let ((entries (mapcar #'haskell-debug-parse-history-entry
+                               (cl-remove-if (lambda (line) (or (string= "<end of history>" line)
+                                                                (string= "..." line)))
+                                             (haskell-debug-split-string string)))))
+          (setq haskell-debug-history-cache
+                entries)
+          entries)))))
+
+(defun haskell-debug-insert-bindings (modules breakpoints context)
+  "Insert a list of bindings."
+  (if breakpoints
+      (progn (haskell-debug-insert-binding "t" "trace an expression")
+             (haskell-debug-insert-binding "s" "step into an expression")
+             (haskell-debug-insert-binding "b" "breakpoint" t))
+    (progn
+      (when modules
+        (haskell-debug-insert-binding "b" "breakpoint"))
+      (when breakpoints
+        (haskell-debug-insert-binding "s" "step into an expression" t))))
+  (when breakpoints
+    (haskell-debug-insert-binding "d" "delete breakpoint"))
+  (when context
+    (haskell-debug-insert-binding "a" "abandon context")
+    (haskell-debug-insert-binding "c" "continue" t))
+  (when context
+    (haskell-debug-insert-binding "p" "previous step")
+    (haskell-debug-insert-binding "n" "next step" t))
+  (haskell-debug-insert-binding "g" "refresh" t)
+  (insert "\n"))
+
+(defun haskell-debug-insert-current-context (context history)
+  "Insert the current context."
+  (haskell-debug-insert-header "Context")
+  (if context
+      (haskell-debug-insert-context context history)
+    (haskell-debug-insert-debug-finished))
+  (insert "\n"))
+
+(defun haskell-debug-insert-breakpoints (breakpoints)
+  "insert the list of breakpoints."
+  (haskell-debug-insert-header "Breakpoints")
+  (if (null breakpoints)
+      (haskell-debug-insert-muted "No active breakpoints.")
+    (cl-loop for break in breakpoints
+             do (insert (propertize (format "%d"
+                                            (plist-get break :number))
+                                    'face `((:weight bold))
+                                    'break break)
+                        (haskell-debug-muted " - ")
+                        (propertize (plist-get break :module)
+                                    'break break
+                                    'break break)
+                        (haskell-debug-muted
+                         (format " (%d:%d)"
+                                 (plist-get (plist-get break :span) :start-line)
+                                 (plist-get (plist-get break :span) :start-col)))
+                        "\n")))
+  (insert "\n"))
+
+(defun haskell-debug-insert-modules (modules)
+  "Insert the list of modules."
+  (haskell-debug-insert-header "Modules")
+  (if (null modules)
+      (haskell-debug-insert-muted "No loaded modules.")
+    (progn (cl-loop for module in modules
+                    do (insert (propertize (plist-get module :module)
+                                           'module module
+                                           'face `((:weight bold)))
+                               (haskell-debug-muted " - ")
+                               (propertize (file-name-nondirectory (plist-get module :path))
+                                           'module module))
+                    do (insert "\n")))))
+
+(defun haskell-debug-split-string (string)
+  "Split GHCi's line-based output, stripping the trailing newline."
+  (split-string string "\n" t))
+
+(defun haskell-debug-parse-context (string)
+  "Parse the context."
+  (cond
+   ((string-match "^--> \\(.+\\)\n  \\(.+\\)" string)
+    (let ((name (match-string 1 string))
+          (stopped (haskell-debug-parse-stopped-at (match-string 2 string))))
+      (list :name name
+            :path (plist-get stopped :path)
+            :span (plist-get stopped :span))))))
+
+(defun haskell-debug-insert-binding (binding desc &optional end)
+  "Insert a helpful keybinding."
+  (insert (propertize binding 'face 'haskell-debug-keybinding-face)
+          (haskell-debug-muted " - ")
+          desc
+          (if end
+              "\n"
+            (haskell-debug-muted ", "))))
+
+(defun haskell-debug-insert-header (title)
+  "Insert a header title."
+  (insert (propertize title
+                      'face 'haskell-debug-heading-face)
+          "\n\n"))
+
+(defun haskell-debug-insert-context (context history)
+  "Insert the context and history."
+  (when context
+    (insert (propertize (plist-get context :name) 'face `((:weight bold)))
+            (haskell-debug-muted " - ")
+            (file-name-nondirectory (plist-get context :path))
+            (haskell-debug-muted " (stopped)")
+            "\n"))
+  (when haskell-debug-bindings-cache
+    (insert "\n")
+    (let ((bindings haskell-debug-bindings-cache))
+      (insert
+       (haskell-debug-get-span-string
+        (plist-get bindings :path)
+        (plist-get bindings :span)))
+      (insert "\n\n")
+      (cl-loop for binding in (plist-get bindings :types)
+               do (insert (haskell-fontify-as-mode binding 'haskell-mode)
+                          "\n"))))
+  (let ((history (or history
+                     (list (haskell-debug-make-fake-history context)))))
+    (when history
+      (insert "\n")
+      (haskell-debug-insert-history history))))
+
+(defun haskell-debug-insert-debug-finished ()
+  "Insert message that no debugging is happening, but if there is
+some old history, then display that."
+  (if haskell-debug-history-cache
+      (progn (haskell-debug-insert-muted "Finished debugging.")
+             (insert "\n")
+             (haskell-debug-insert-history haskell-debug-history-cache))
+    (haskell-debug-insert-muted "Not debugging right now.")))
+
+(defun haskell-debug-insert-muted (text)
+  "Insert some muted text."
+  (insert (haskell-debug-muted text)
+          "\n"))
+
+(defun haskell-debug-muted (text)
+  "Make some muted text."
+  (propertize text 'face 'haskell-debug-muted-face))
+
+(defun haskell-debug-parse-logged (string)
+  "Parse the logged breakpoint."
+  (cond
+   ((string= "no more logged breakpoints\n" string)
+    nil)
+   ((string= "already at the beginning of the history\n" string)
+    nil)
+   (t
+    (with-temp-buffer
+      (insert string)
+      (goto-char (point-min))
+      (list :path (progn (search-forward " at ")
+                         (buffer-substring-no-properties
+                          (point)
+                          (1- (search-forward ":"))))
+            :span (haskell-debug-parse-span
+                   (buffer-substring-no-properties
+                    (point)
+                    (line-end-position)))
+            :types (progn (forward-line)
+                          (haskell-debug-split-string
+                           (buffer-substring-no-properties
+                            (point)
+                            (point-max)))))))))
+
+(defun haskell-debug-parse-stopped-at (string)
+  "Parse the location stopped at from the given string.
+
+For example:
+
+Stopped at /home/foo/project/src/x.hs:6:25-36
+
+"
+  (let ((index (string-match "Stopped at \\([^:]+\\):\\(.+\\)\n?"
+                             string)))
+    (when index
+      (list :path (match-string 1 string)
+            :span (haskell-debug-parse-span (match-string 2 string))
+            :types (cdr (haskell-debug-split-string (substring string index)))))))
+
+(defun haskell-debug-get-span-string (path span)
+  "Get the string from the PATH and the SPAN."
+  (save-window-excursion
+    (find-file path)
+    (buffer-substring
+     (save-excursion
+       (goto-char (point-min))
+       (forward-line (1- (plist-get span :start-line)))
+       (forward-char (1- (plist-get span :start-col)))
+       (point))
+     (save-excursion
+       (goto-char (point-min))
+       (forward-line (1- (plist-get span :end-line)))
+       (forward-char (plist-get span :end-col))
+       (point)))))
+
+(defun haskell-debug-make-fake-history (context)
+  "Make a fake history item."
+  (list :index -1
+        :path (plist-get context :path)
+        :span (plist-get context :span)))
+
+(defun haskell-debug-insert-history (history)
+  "Insert tracing HISTORY."
+  (let ((i (length history)))
+    (cl-loop for span in history
+             do (let ((string (haskell-debug-get-span-string
+                               (plist-get span :path)
+                               (plist-get span :span))))
+                  (insert (propertize (format "%4d" i)
+                                      'face 'haskell-debug-trace-number-face)
+                          " "
+                          (haskell-debug-preview-span
+                           (plist-get span :span)
+                           string
+                           t)
+                          "\n")
+                  (setq i (1- i))))))
+
+(defun haskell-debug-parse-span (string)
+  "Parse a source span from a string.
+
+Examples:
+
+  (5,1)-(6,37)
+  6:25-36
+  5:20
+
+People like to make other people's lives interesting by making
+variances in source span notation."
+  (cond
+   ((string-match "\\([0-9]+\\):\\([0-9]+\\)-\\([0-9]+\\)"
+                  string)
+    (list :start-line (string-to-number (match-string 1 string))
+          :start-col (string-to-number (match-string 2 string))
+          :end-line (string-to-number (match-string 1 string))
+          :end-col (string-to-number (match-string 3 string))))
+   ((string-match "\\([0-9]+\\):\\([0-9]+\\)"
+                  string)
+    (list :start-line (string-to-number (match-string 1 string))
+          :start-col (string-to-number (match-string 2 string))
+          :end-line (string-to-number (match-string 1 string))
+          :end-col (string-to-number (match-string 2 string))))
+   ((string-match "(\\([0-9]+\\),\\([0-9]+\\))-(\\([0-9]+\\),\\([0-9]+\\))"
+                  string)
+    (list :start-line (string-to-number (match-string 1 string))
+          :start-col (string-to-number (match-string 2 string))
+          :end-line (string-to-number (match-string 3 string))
+          :end-col (string-to-number (match-string 4 string))))
+   (t (error "Unable to parse source span from string: %s"
+             string))))
+
+(defun haskell-debug-preview-span (span string &optional collapsed)
+  "Make a one-line preview of the given expression."
+  (with-temp-buffer
+    (haskell-mode)
+    (insert string)
+    (when (/= 0 (plist-get span :start-col))
+      (indent-rigidly (point-min)
+                      (point-max)
+                      1))
+    (if (fboundp 'font-lock-ensure)
+        (font-lock-ensure)
+      (with-no-warnings (font-lock-fontify-buffer)))
+    (when (/= 0 (plist-get span :start-col))
+      (indent-rigidly (point-min)
+                      (point-max)
+                      -1))
+    (goto-char (point-min))
+    (if collapsed
+        (replace-regexp-in-string
+         "\n[ ]*"
+         (propertize " " 'face 'haskell-debug-newline-face)
+         (buffer-substring (point-min)
+                           (point-max)))
+      (buffer-string))))
+
+(defun haskell-debug-start (session)
+  "Start the debug mode."
+  (setq buffer-read-only t)
+  (haskell-session-assign session)
+  (haskell-debug/refresh))
+
+(defun haskell-debug ()
+  "Start the debugger for the current Haskell (GHCi) session."
+  (interactive)
+  (let ((session (haskell-debug-session)))
+    (switch-to-buffer-other-window (haskell-debug-buffer-name session))
+    (unless (eq major-mode 'haskell-debug-mode)
+      (haskell-debug-mode)
+      (haskell-debug-start session))))
+
+(defun haskell-debug-break (break)
+  "Set BREAK breakpoint in module at line/col."
+  (haskell-process-queue-without-filters
+   (haskell-debug-process)
+   (format ":break %s %s %d"
+           (plist-get break :module)
+           (plist-get (plist-get break :span) :start-line)
+           (plist-get (plist-get break :span) :start-col))))
+
+(defun haskell-debug-navigate (direction)
+  "Navigate in DIRECTION \"back\" or \"forward\"."
+  (let ((string (haskell-process-queue-sync-request
+                 (haskell-debug-process)
+                 (concat ":" direction))))
+    (let ((bindings (haskell-debug-parse-logged string)))
+      (setq haskell-debug-bindings-cache
+            bindings)
+      (when (not bindings)
+        (message "No more %s results!" direction)))
+    (haskell-debug/refresh)))
+
+(defun haskell-debug-session-debugging-p (session)
+  "Does the session have a debugging buffer open?"
+  (not (not (get-buffer (haskell-debug-buffer-name session)))))
+
+(defun haskell-debug-highlight (path &optional span)
+  "Highlight the file at span."
+  (let ((p (make-overlay
+            (line-beginning-position)
+            (line-end-position))))
+    (overlay-put p 'face `((:background "#eee")))
+    (with-current-buffer
+        (if span
+            (save-window-excursion
+              (find-file path)
+              (current-buffer))
+          (find-file path)
+          (current-buffer))
+      (let ((o (when span
+                 (make-overlay
+                  (save-excursion
+                    (goto-char (point-min))
+                    (forward-line (1- (plist-get span :start-line)))
+                    (forward-char (1- (plist-get span :start-col)))
+                    (point))
+                  (save-excursion
+                    (goto-char (point-min))
+                    (forward-line (1- (plist-get span :end-line)))
+                    (forward-char (plist-get span :end-col))
+                    (point))))))
+        (when o
+          (overlay-put o 'face `((:background "#eee"))))
+        (sit-for 0.5)
+        (when o
+          (delete-overlay o))
+        (delete-overlay p)))))
+
+(defun haskell-debug-parse-history-entry (string)
+  "Parse a history entry."
+  (if (string-match "^\\([-0-9]+\\)[ ]+:[ ]+\\([A-Za-z0-9_':]+\\)[ ]+(\\([^:]+\\):\\(.+?\\))$"
+                    string)
+      (list :index (string-to-number (match-string 1 string))
+            :name (match-string 2 string)
+            :path (match-string 3 string)
+            :span (haskell-debug-parse-span (match-string 4 string)))
+    (error "Unable to parse history entry: %s" string)))
+
+(defun haskell-debug-parse-module (string)
+  "Parse a module and path.
+
+For example:
+
+X                ( /home/foo/X.hs, interpreted )
+Main             ( /home/foo/X.hs, /home/foo/X.o )
+"
+  (if (string-match "\\([^ ]+\\)[ ]+( \\([^ ]+?\\), [/a-zA-Z0-9\.]+ )$"
+                    string)
+      (list :module (match-string 1 string)
+            :path (match-string 2 string))
+    (error "Unable to parse module from string: %s"
+           string)))
+
+(defun haskell-debug-parse-break-point (string)
+  "Parse a breakpoint number, module and location from a string.
+
+For example:
+
+[13] Main /home/foo/src/x.hs:(5,1)-(6,37)
+
+"
+  (if (string-match "^\\[\\([0-9]+\\)\\] \\([^ ]+\\) \\([^:]+\\):\\(.+\\)$"
+                    string)
+      (list :number (string-to-number (match-string 1 string))
+            :module (match-string 2 string)
+            :path (match-string 3 string)
+            :span (haskell-debug-parse-span (match-string 4 string)))
+    (error "Unable to parse breakpoint from string: %s"
+           string)))
+
+(provide 'haskell-debug)
+
+;;; haskell-debug.el ends here
-- 
cgit 1.4.1