{"action":"opened","issue":{"url":"https://api.github.com/repos/haskell/haskell-mode/issues/1590","repository_url":"https://api.github.com/repos/haskell/haskell-mode","labels_url":"https://api.github.com/repos/haskell/haskell-mode/issues/1590/labels{/name}","comments_url":"https://api.github.com/repos/haskell/haskell-mode/issues/1590/comments","events_url":"https://api.github.com/repos/haskell/haskell-mode/issues/1590/events","html_url":"https://github.com/haskell/haskell-mode/issues/1590","id":314653807,"number":1590,"title":"Gud debugger support","user":{"login":"fakedrake","id":408231,"avatar_url":"https://avatars3.githubusercontent.com/u/408231?v=4","gravatar_id":"","url":"https://api.github.com/users/fakedrake","html_url":"https://github.com/fakedrake","followers_url":"https://api.github.com/users/fakedrake/followers","following_url":"https://api.github.com/users/fakedrake/following{/other_user}","gists_url":"https://api.github.com/users/fakedrake/gists{/gist_id}","starred_url":"https://api.github.com/users/fakedrake/starred{/owner}{/repo}","subscriptions_url":"https://api.github.com/users/fakedrake/subscriptions","organizations_url":"https://api.github.com/users/fakedrake/orgs","repos_url":"https://api.github.com/users/fakedrake/repos","events_url":"https://api.github.com/users/fakedrake/events{/privacy}","received_events_url":"https://api.github.com/users/fakedrake/received_events","type":"User","site_admin":false},"labels":[],"state":"open","locked":false,"assignee":null,"assignees":[],"milestone":null,"comments":0,"created_at":"2018-04-16T13:35:17Z","updated_at":"2018-04-16T13:35:17Z","closed_at":null,"author_association":"NONE","body":"I see that there is some support for the debugger but I haven't been able to make it work in the context of a life-size project. Would a GUD backend be interesting to the haskell-mode community?\r\n\r\nIf anyone is interested to work on this I append an attempt I made at it. It may be useful as a starting point. It has a few problems, for example it runs in a separate instance of `ghci` and it overrieds a bunch of `gud` functions. I will work on it more at some point but I wanted to see if there is interest by others.\r\n\r\n``` elisp\r\n\r\n;; GUD\r\n;;\r\n;; M-x gud-ghci<RET>stack ghci\r\n\r\n(defun gud-display-frame ()\r\n  \"Find and obey the last filename-and-line marker from the debugger.\r\nObeying it means displaying in another window the specified file and line.\"\r\n  (interactive)\r\n  (flet ((col-pos (col) (save-excursion (beginning-of-line) (+ col (point)))))\r\n    (when gud-last-frame\r\n      (gud-set-buffer)\r\n      ;; gud-last-frame => (file . line)\r\n      (cond\r\n       ((not (listp (cdr gud-last-frame)))\r\n        (gud-display-line (car gud-last-frame) (cdr gud-last-frame)))\r\n       ;; gud-last-frame => (file line begin-column end-column)\r\n       ((and\r\n         (= 4 (length gud-last-frame))\r\n         (every #'numberp (cdr gud-last-frame)))\r\n        (let* ((file (car gud-last-frame))\r\n               (file-buf (find-file-noselect file t))\r\n               (line (cadr gud-last-frame))\r\n               (expr-begin-col (caddr gud-last-frame))\r\n               (expr-end-col (cadddr gud-last-frame)))\r\n          (gud-display-line file line)\r\n          (with-current-buffer file-buf\r\n            (let ((expr-begin (col-pos expr-begin-col))\r\n                  (expr-end  (col-pos expr-end-col))\r\n                  (pulse-delay .30))\r\n              (message (concat \"Expr \" (buffer-substring expr-begin expr-end)))\r\n              (pulse-momentary-highlight-region expr-begin expr-end)))))\r\n       ;; TODO: gud-last-frame =>\r\n       ;; (file (begin-line . begin-column) (end-line . end-column))\r\n       ;; Anything else\r\n       (t (error \"Unknown gud-last-frame format.\")))\r\n      (setq gud-last-last-frame gud-last-frame\r\n\t    gud-last-frame nil))))\r\n\r\n(defun gud-ghci-marker-filter (string)\r\n  (setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string) string))\r\n\r\n  (let (start)\r\n    ;; Process all complete markers in this chunk.\r\n    (while (string-match\r\n\t    \"\\\\(Logged breakpoint at\\\\|Stopped in [^ \\t\\r\\n]+,\\\\) \\\\(?1:[^ \\t\\r\\n]+?\\\\):\\\\(?2:[0-9]+\\\\):\\\\(?3:[0-9]+\\\\)\\\\(?:-\\\\(?4:[0-9]+\\\\)\\\\|\\\\)\"\r\n\t    gud-marker-acc start)\r\n      (setq gud-last-frame\r\n\t    (list (match-string 1 gud-marker-acc)\r\n\t\t  (string-to-number (match-string 2 gud-marker-acc))\r\n                  (string-to-number (match-string 3 gud-marker-acc))\r\n                  (string-to-number (match-string 4 gud-marker-acc)))\r\n\t    start (match-end 0)))\r\n\r\n    ;; Search for the last incomplete line in this chunk\r\n    (while (string-match \"\\n\" gud-marker-acc start)\r\n      (setq start (match-end 0)))\r\n\r\n    ;; If the incomplete line APPEARS to begin with another marker, keep it\r\n    ;; in the accumulator.  Otherwise, clear the accumulator to avoid an\r\n    ;; unnecessary concat during the next call.\r\n    (setq gud-marker-acc (substring gud-marker-acc (match-beginning 0))))\r\n  string)\r\n\r\n(defun gud-ghci (command-line)\r\n  (interactive (list (gud-query-cmdline 'gud-ghci)))\r\n  (require 'gud)\r\n  (when (and gud-comint-buffer\r\n\t     (buffer-name gud-comint-buffer)\r\n\t     (get-buffer-process gud-comint-buffer)\r\n\t     (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'ghci)))\r\n    (gdb-restore-windows)\r\n    (error\r\n     \"Multiple debugging requires restarting in text command mode\"))\r\n\r\n  (gud-common-init command-line nil 'gud-ghci-marker-filter)\r\n  (setq-local gud-minor-mode 'ghci)\r\n  (setq paragraph-start comint-prompt-regexp)\r\n  (comint-send-string (get-buffer-process (current-buffer))\r\n                      \":set prompt \\\"> \\\"\\n:print '\\\\n'\\n\")\r\n  (setq comint-prompt-regexp \"^> \")\r\n\r\n  (gud-def gud-break  \":break %m %l %y\" \"\\C-b\" \"Set breakpoint at current line.\")\r\n  ;; TODO: put _result=... line to minibuffer.\r\n  (gud-def gud-stepi  \":step\"           \"\\C-s\" \"Step one source line with display.\")\r\n  (gud-def gud-step   \":stepmodule\"     \"\\C-n\" \"Step in the module.\")\r\n  (gud-def gud-next   \":steplocal\"      \"n\" \"Step in the local scope.\")\r\n  (gud-def gud-cont   \":continue\"       \"\\C-r\" \"Continue with display.\")\r\n  (gud-def gud-up     \":back\"           \"<\" \"Up one stack frame.\")\r\n  (gud-def gud-down   \":forward\"        \">\" \"Down one stack frame.\")\r\n  (gud-def gud-run    \":trace %e\"       \"t\" \"Trace expression.\")\r\n  (gud-def gud-print  \":print %e\"       \"\\C-p\" \"Evaluate Guile expression at point.\")\r\n  (run-hooks 'gud-ghci-mode-hook))\r\n\r\n(defvar gud-ghci-command-name \"stack repl\")\r\n(require 'gud)\r\n(defun gud-format-command (str arg)\r\n  (let ((insource (not (eq (current-buffer) gud-comint-buffer)))\r\n\t(frame (or gud-last-frame gud-last-last-frame))\r\n\t(buffer-file-name-localized\r\n         (and (buffer-file-name)\r\n              (or (file-remote-p (buffer-file-name) 'localname)\r\n                  (buffer-file-name))))\r\n\tresult)\r\n    (while (and str\r\n\t\t(let ((case-fold-search nil))\r\n\t\t  (string-match \"\\\\([^%]*\\\\)%\\\\([adefFlpcmy]\\\\)\" str)))\r\n      (let ((key (string-to-char (match-string 2 str)))\r\n\t    subst)\r\n\t(cond\r\n\t ((eq key ?f)\r\n\t  (setq subst (file-name-nondirectory (if insource\r\n\t\t\t\t\t\t  buffer-file-name-localized\r\n\t\t\t\t\t\t(car frame)))))\r\n\t ((eq key ?F)\r\n\t  (setq subst (file-name-base (if insource\r\n                                          buffer-file-name-localized\r\n                                        (car frame)))))\r\n\t ((eq key ?d)\r\n\t  (setq subst (file-name-directory (if insource\r\n\t\t\t\t\t       buffer-file-name-localized\r\n\t\t\t\t\t     (car frame)))))\r\n\t ((eq key ?l)\r\n\t  (setq subst (int-to-string\r\n\t\t       (if insource\r\n\t\t\t   (save-restriction\r\n\t\t\t     (widen)\r\n\t\t\t     (+ (count-lines (point-min) (point))\r\n\t\t\t\t(if (bolp) 1 0)))\r\n\t\t\t (cdr frame)))))\r\n\t ((eq key ?e)\r\n\t  (setq subst (gud-find-expr)))\r\n\t ((eq key ?a)\r\n\t  (setq subst (gud-read-address)))\r\n\t ((eq key ?c)\r\n\t  (setq subst\r\n                (gud-find-class\r\n                 (if insource\r\n                     (buffer-file-name)\r\n                   (car frame))\r\n                 (if insource\r\n                     (save-restriction\r\n                       (widen)\r\n                       (+ (count-lines (point-min) (point))\r\n                          (if (bolp) 1 0)))\r\n                   (cdr frame)))))\r\n\t ((eq key ?p)\r\n\t  (setq subst (if arg (int-to-string arg))))\r\n\r\n         ;; My additions here\r\n         ((eq key ?m)\r\n          (setq subst\r\n                (gud-find-module\r\n                 (if insource\r\n                     (buffer-file-name)\r\n                   (car frame))\r\n                 (if insource\r\n                     (save-restriction\r\n                       (widen)\r\n                       (+ (count-lines (point-min) (point))\r\n                          (if (bolp) 1 0)))\r\n                   (cdr frame)))))\r\n\r\n         ((eq key ?y)\r\n          (setq subst\r\n                (int-to-string\r\n\t         (if insource\r\n\t             (save-restriction (widen) (current-column))\r\n\t           (cdr frame))))))\r\n\r\n\t(setq result (concat result (match-string 1 str) subst)))\r\n      (setq str (substring str (match-end 2))))\r\n    ;; There might be text left in STR when the loop ends.\r\n    (concat result str)))\r\n\r\n(defun gud-find-module (f _line)\r\n  (save-excursion\r\n    (save-restriction\r\n      (save-match-data\r\n        (with-current-buffer (get-file-buffer f)\r\n          (goto-char (point-min))\r\n          (if (re-search-forward \"^module[[:space:]]+\\\\([^[:space:](]+\\\\)\" nil t nil)\r\n              (match-string-no-properties 1)\r\n            \"\"))))))\r\n```"}}
{"actor":{"display_login":"fakedrake"}}