Mirrored from codeberg

git clone https://codeberg.org/pranshu/haskell-ts-mode.git

Jump to: .dir-locals.el README.org haskell-ts-mode.el

.dir-locals.el

1;;; Directory Local Variables            -*- no-byte-compile: t -*-
2;;; For more information see (info "(emacs) Directory Variables")
3
4((nil . ((indent-tabs-mode . nil))))

README.org

1
2*NOTICE:* Indentation has temporarily been disabled by default. SEE
3THE [[p:indent][INDENTATION]] SECTION for why this was needed and what the plan is.  TLDR
4indentation is going through a full rewrite.
5
6* Contributing
7
8Please contribute ideas on how the new indentation system would work.
9See [[p:rewrite][rewriting the indentation]] section.
10
11* Haskell mode based on treesitter
12
13A [[https://www.haskell.org/][Haskell]] mode that uses [[https://tree-sitter.github.io/tree-sitter/][Tree-sitter]].
14
15#+caption: Image
16[[./ss.png]]
17
18The above screenshot is indented and coloured using =haskell-ts-mode=,
19with =prettify-symbols-mode= enabled.
20
21* Usage
22
23- =C-c C-r= Open REPL
24- =C-c C-c= Send code to REPL
25- =M-q= Indent the function
26
27* Features
28
29Overview of features:
30
31- Syntax highlighting
32- Structural navigation
33- Indentation (now disabled)
34- Imenu support
35- REPL (=C-c C-r= in the mode to run)
36- Prettify Symbols mode support
37
38* Comparison with =haskell-mode=
39
40The more interesting features are:
41
42- Logical syntax highlighting:
43  - Only arguments that can be used in functions are highlighted, e.g.,
44    in =f (_:(a:[]))= only =a= is highlighted, as it is the only
45    variable that is captured, and that can be used in the body of the
46    function.
47  - The return type of a function is highlighted.
48  - All new variabels are (or should be) highlighted, this includes
49    generators, lambda arguments.
50  - Highlighting the === operator in guarded matches correctly, this
51    would be stupidly hard in regexp based syntax.
52- More performant, this is especially seen in longer files.
53- Much, much less code, =haskell-mode= has accumlated 30,000 lines of
54  code and features to do with all things Haskell related.
55  =haskell-ts-mode= just keeps the scope to basic major mode stuff, and
56  leaves other stuff to external packages.
57
58* Motivation
59:PROPERTIES:
60:CUSTOM_ID: motivation
61:END:
62=haskell-mode= contains nearly 30k lines of code, and is about 30 years
63old. A lot of features implemented by =haskell-mode= are now also
64available in standard Emacs, and have thus become obsolete.
65
66In 2018, a mode called
67[[https://elpa.nongnu.org/nongnu/haskell-tng-mode.html][=haskell-tng-mode=]]
68was made to solve some of these problems. However, because of Haskell's
69syntax, it too became very complex and required a web of dependencies.
70
71Both these modes ended up practically parsing Haskell's syntax to
72implement indentation, so I thought why not use Tree-sitter?
73
74* Structural navigation
75:PROPERTIES:
76:CUSTOM_ID: structural-navigation
77:END:
78This mode provides strucural navigation, for Emacs 30+.
79
80#+begin_src haskell
81combs (x:xs) = map (x:) c ++ c
82  where c = combs xs
83#+end_src
84
85In the above code, if the pointer is right in front of the function
86definition =combs=, and you press =C-M-f= (=forward-sexp=), it will take
87you to the end of the second line.
88
89* Installation
90:PROPERTIES:
91:CUSTOM_ID: installation
92:END:
93Add this into your init.el:
94
95#+begin_src emacs-lisp
96(use-package haskell-ts-mode
97  :ensure t
98  :custom
99  (haskell-ts-font-lock-level 4)
100  (haskell-ts-use-indent t)
101  (haskell-ts-ghci "ghci")
102  (haskell-ts-use-indent t)
103  :config
104  (add-to-list 'treesit-language-source-alist
105   '(haskell . ("https://github.com/tree-sitter/tree-sitter-haskell" "v0.23.1")))
106  (unless (treesit-grammar-location 'haskell)
107   (treesit-install-language-grammar 'haskell)))
108#+end_src
109
110That is all. This will install the grammars if not already installed.
111However, you might need to update the grammar version in the future.
112
113** Other recommended packages
114
115Unlike =haskell-mode=, this mode has a limited scope to just worrying
116about haskell. There are other packages that I find help a lot with
117development:
118- [[https://codeberg.org/rahguzar/consult-hoogle][consult-hoogle]] great interface for =hoogle=.
119- [[https://github.com/jyp/dante][dante]]
120- [[https://github.com/radian-software/apheleia][apheleia]] I suggest using this with [[https://github.com/vyorkin/ormolu.el][ormolu]] to provide formatting for haskell.
121- [[https://github.com/emacsmirror/hcel][hcel]] Codebase navigator, if you want a lighter alternaitve to a full blown LSP.
122  
123* Customization
124
125** Indentation <<p:indent>>
126
127*Indentation has been disabled by default*.  To enable it, use the following code.
128
129#+begin_src emacs-lisp
130(setq haskell-ts-use-indent t)
131#+end_src
132
133*** Why indentation has been disabled temporarily
134
135Simply because the indention code became a monstrosity.  Don't belive
136me? check the =haskell-ts-indent-rules= variable.  Bugs are rampent,
137fixing one bug created another.  Its a torturous game of wack-a-mole
138with no end in sight.
139
140*** Indentation rewrite <<p:rewrite>>
141
142Check out the =newindent= branch to see the repo to see the progress.
143
144There are some options to rewriting indentation:
145
1461. Do the same approach of having strict indentation that doesn't
147   modify the syntax tree, just impliment it better, potentilly using
148   a style guide, [[https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md][like this one]].
1492. Rely on a external package like [[https://github.com/nilcons/hi2][hi2]] or [[https://github.com/iquiw/hyai][hyai]], at the compromise they don't
150   use treesitter, so just end up inefficialty reparsing haskell.
1513. My prefered: try to impliment haskell-mode type indentation. I have
152   no idea how we would do this, since each indentation attempt could
153   change the parse tree, changing the treesitter concrete syntax
154   tree.
1554. Adaptive indentation: Like =python-mode=, we can try memorise the
156   user's indentation prefrences.
157
158** Pretify Symbols mode
159
160=prettify-symbols-mode= can be used to replace common symbols with
161unicode alternatives.
162
163Turning on =prettify-symbols-mode= does stuff like turn =->= to =→=. If
164you want to prettify words, set =haskell-ts-prettify-words= to non-nil.
165This will do stuff like prettify =forall= into =∀= and =elem= to =∈=.
166
167#+begin_src emacs-lisp
168(add-hook 'haskell-ts-mode 'prettify-symbols-mode)
169#+end_src
170
171** Adjusting font lock level
172
173Set =haskell-ts-font-lock-level= accordingly. The default and highest
174value is 4. You are against vibrancy, you can lower it to match your
175dreariness.
176
177** Language server
178
179=haskell-ts-mode= works with =lsp-mode= and, since Emacs 30, with =eglot=.
180
181To add =eglot= support on Emacs 29 and earlier, add the following code
182to your =init.el=:
183
184#+begin_example
185(with-eval-after-load 'eglot
186  (defvar eglot-server-programs)
187  (add-to-list 'eglot-server-programs
188               '(haskell-ts-mode . ("haskell-language-server-wrapper" "--lsp"))))
189#+end_example
190
191* TODO list
192
193- Support for M-x align, so that calling it will align all the ‘=’ signs
194  in a region.
195- Imenu support for functions with multiple definitions.
196- Merge the indent branch

haskell-ts-mode.el

1;;; haskell-ts-mode.el --- A treesit based major mode for haskell -*- lexical-binding:t -*-
2
3;; Copyright (C) 2024, 2025 Pranshu Sharma
4
5;; Author: Pranshu Sharma <pranshu@bauherren.ovh>
6;; URL: https://codeberg.org/pranshu/haskell-ts-mode
7;; Package-Requires: ((emacs "29.3"))
8;; Version: 1.3.5
9;; Keywords: languages, haskell
10
11;; This program is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; This program is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;; This is a major mode that uses treesitter to provide all the basic
27;; major mode stuff, like indentation, font lock, etc...
28;; It uses the grammer at: https://github.com/tree-sitter/tree-sitter-haskell
29
30;;; Code:
31
32(require 'comint)
33(require 'treesit)
34
35(declare-function treesit-parser-create "treesit.c")
36(declare-function treesit-node-start "treesit.c")
37(declare-function treesit-node-parent "treesit.c")
38(declare-function treesit-node-prev-sibling "treesit.c")
39(declare-function treesit-node-next-sibling "treesit.c")
40(declare-function treesit-node-end "treesit.c")
41(declare-function treesit-node-child "treesit.c")
42(declare-function treesit-node-type "treesit.c")
43
44(defgroup haskell-ts-mode nil
45  "Group that contains haskell-ts-mode variables"
46  :group 'langs)
47
48(defcustom haskell-ts-ghci "ghci"
49  "The name or path program to be called to run the ghci repl.  Any
50arguments to be passed should be added `haskell-ts-ghci-switches`."
51  :type 'string)
52
53(defcustom haskell-ts-ghci-switches nil
54  "Arguments to be passed to `haskell-ts-ghci'."
55  :type '(repeat string))
56
57(defcustom haskell-ts-ghci-buffer-name "*Inferior Haskell*"
58  "Buffer name for the ghci prcoess."
59  :type 'string)
60
61(defcustom haskell-ts-use-indent nil
62  "Set to non-nil to use the indentation provided by haskell-ts-mode"
63  :type 'boolean)
64
65(defcustom haskell-ts-font-lock-level 4
66  "Level of font lock, 1 for minimum highlghting and 4 for maximum."
67  :type '(choice (const :tag "Minimal Highlighting" 1)
68                 (const :tag "Low Highlighting" 2)
69                 (const :tag "High Highlighting" 3)
70                 (const :tag "Maximum Highlighting" 4)))
71
72(defcustom haskell-ts-prettify-symbols nil
73  "Prettify some symbol combinations to unicode symbols.
74This will concat `haskell-ts-prettify-symbols-alist' to
75`prettify-symbols-alist' in `haskell-ts-mode'."
76  :type 'boolean)
77
78(defcustom haskell-ts-prettify-words nil
79  "Prettify some words to unicode symbols.
80This will concat `haskell-ts-prettify-words-alist' to
81`prettify-symbols-alist' in `haskell-ts-mode'."
82  :type 'boolean)
83
84(defface haskell-constructor-face
85  '((t :inherit font-lock-type-face))
86  "Face used to highlight Haskell constructors."
87  :group 'haskell-appearance)
88
89(defvar haskell-ts-font-lock-feature-list
90  `((comment str pragma parens)
91    (type definition function args module import operator)
92    (match keyword constructors)
93    (otherwise signature type-sig)))
94
95(defvar haskell-ts-prettify-symbols-alist
96  '(("\\" . "λ")
97    ("/=" . "≠")
98    ("->" . "→")
99    ("=>" . "⇒")
100    ("<-" . "←")
101    ("<=" . "≤")
102    (">=" . "≥")
103    ("/<" . "≮")
104    ("/>" . "≯")
105    ("==" . "≡"))
106  "`prettify-symbols-alist' for `haskell-ts-mode'.
107This variable contains all the symbol for `haskell-ts-mode' to unicode
108character.  See `haskell-ts-prettify-words-alist' for mappign words to
109alternative unicode character.")
110
111(defvar haskell-ts-prettify-words-alist
112  '(("forall"           . "∀")
113    ("exists"           . "∃")
114    ("elem"             . "∈")
115    ("notElem"          . "∉")
116    ("member"           . "∈")
117    ("notMember"        . "∉")
118    ("union"            . "∪")
119    ("intersection"     . "∩")
120    ("isSubsetOf"       . "⊆")
121    ("isProperSubsetOf" . "⊂")
122    ("mempty"           . "∅")
123    ("&&" . "∧")
124    ("||" . "∨"))
125  "Additional symbols to prettify for `haskell-ts-mode'.
126This is added to `prettify-symbols-alist' for `haskell-ts-mode' buffers
127when `haskell-ts-prettify-words' is non-nil.")
128
129(defvar haskell-ts-font-lock
130  (treesit-font-lock-rules
131   :language 'haskell
132   :feature 'keyword
133   `(["module" "import" "data" "let" "where" "case" "type" "family"
134      "if" "then" "else" "of" "do" "in" "instance" "class" "newtype"]
135     @font-lock-keyword-face)
136   :language 'haskell
137   :feature 'otherwise
138   :override t
139   `(((match (guards guard: (boolean (variable) @font-lock-keyword-face)))
140      (:match "otherwise" @font-lock-keyword-face)))
141   
142   :language 'haskell
143   :feature 'type
144   :override t
145   '((type) @font-lock-type-face)
146
147   :language 'haskell
148   :override t
149   :feature 'signature
150   '((signature (function) @haskell-ts--fontify-type)
151     (context (function) @haskell-ts--fontify-type)
152     (signature "::" @font-lock-operator-face))
153
154   :language 'haskell
155   :feature 'module
156   '((module (module_id) @font-lock-type-face))
157
158   :language 'haskell
159   :feature 'import
160   '((import ["qualified" "as" "hiding"] @font-lock-keyword-face))
161
162   :language 'haskell
163   :feature 'type-sig
164   '((signature (binding_list (variable) @font-lock-doc-markup-face))
165     (signature (variable) @font-lock-doc-markup-face))
166
167   :language 'haskell
168   :feature 'args
169   :override 'keep
170   '((function (infix left_operand: (_) @haskell-ts--fontify-arg))
171     (function (infix right_operand: (_) @haskell-ts--fontify-arg))
172     (generator :anchor (_) @haskell-ts--fontify-arg)
173     (patterns) @haskell-ts--fontify-arg)
174
175   :language 'haskell
176   :feature 'constructors
177   :override t
178   '((constructor) @haskell-constructor-face
179     (data_constructor
180      (prefix field: (_) @haskell-ts--fontify-arg))
181     (type_params (_) @font-lock-variable-name-face)
182     (type_synomym (name) @font-lock-type-face)
183     (data_type name: (name) @font-lock-type-face)
184     (newtype name: (name) @font-lock-type-face)
185     (deriving "deriving" @font-lock-keyword-face
186               classes: (_) @haskell-constructor-face)
187     (deriving_instance "deriving" @font-lock-keyword-face
188                        name: (_) @haskell-constructor-face))
189
190   :language 'haskell
191   :feature 'match
192   `((match ("|" @font-lock-doc-face) ("=" @font-lock-doc-face))
193     (list_comprehension ("|" @font-lock-doc-face
194                          (qualifiers (generator "<-" @font-lock-doc-face))))
195     (match ("->" @font-lock-doc-face)))
196
197   :language 'haskell
198   :override t
199   :feature 'comment
200   `(((comment) @font-lock-comment-face)
201     ((haddock) @font-lock-doc-face))
202
203   :language 'haskell
204   :feature 'pragma
205   `((pragma) @font-lock-preprocessor-face
206     (cpp) @font-lock-preprocessor-face)
207
208   :language 'haskell
209   :feature 'str
210   :override t
211   `((char) @font-lock-string-face
212     (string) @font-lock-string-face
213     (quasiquote (quoter) @font-lock-type-face)
214     (quasiquote (quasiquote_body) @font-lock-preprocessor-face))
215
216   :language 'haskell
217   :feature 'parens
218   :override t
219   `(["(" ")" "[" "]"] @font-lock-bracket-face
220     (infix operator: (_) @font-lock-operator-face))
221
222   :language 'haskell
223   :feature 'function
224   :override t
225   '((function name: (variable) @font-lock-function-name-face)
226     (function (infix (operator)  @font-lock-function-name-face))
227     (function (infix (infix_id (variable) @font-lock-function-name-face)))
228     (bind :anchor (_) @haskell-ts--fontify-params)
229     (function arrow: _ @font-lock-operator-face))
230
231   :language 'haskell
232   :feature 'operator
233   :override t
234   `((operator) @font-lock-operator-face
235     ["=" "," "=>"] @font-lock-operator-face))
236  "The treesitter font lock settings for haskell.")
237
238(defun haskell-ts--stand-alone-parent (_ parent _ &optional last_non_paren first)
239  (save-excursion
240    (goto-char (treesit-node-start parent))
241    (let* ((type (treesit-node-type parent))
242           (res (if (or (and first
243                             (member
244                              type
245                              '("when" "do" "let_in" "local_binds" "function")))
246                        (looking-back "^[ \t]*" (line-beginning-position)))
247                    (treesit-node-start (if (and (string= "parens" type) last_non_paren)
248                                            last_non_paren
249                                          parent))
250                  (haskell-ts--stand-alone-parent 1
251                                                  (treesit-node-parent parent)
252                                                  nil
253                                                  (if (string= "parens" type)
254                                                      last_non_paren
255                                                    parent)
256                                                  t))))
257      ;; This is an astronomically huge hack.  The kind where if you
258      ;; took it you wouldn't be able to walk for several days after,
259      ;; no homo
260      (let ((adjustments '(("conditional" . 2)
261                           ("local_binds" . 1))))
262        (if-let* ((offset (assoc-string type adjustments)))
263            (+ (cdr offset) res)
264          res)
265        ))))
266
267(defvar haskell-ts--ignore-types
268  (regexp-opt '("comment" "cpp" "haddock" ";"))
269  "Node types that will be ignored by indentation.")
270
271(defvar haskell-ts-indent-rules
272  (let* ((p-sib
273          (lambda (node &optional arg)
274            (let* ((func (if arg
275                             #'treesit-node-prev-sibling
276                           #'treesit-node-next-sibling))
277                   (n (funcall func node)))
278              (while (and n (string-match haskell-ts--ignore-types
279                                          (treesit-node-type n)))
280                (setq n (funcall func n)))
281              n)))
282         (p-prev-sib
283          (lambda (node &optional _ _) (treesit-node-start (funcall p-sib node t))))
284         (p-n-prev (lambda (node) (funcall p-sib node t)))
285         (parent-first-child (lambda (_ parent _)
286                               (treesit-node-start (treesit-node-child parent 0)))))
287    `((haskell
288       ((node-is "^cpp$") column-0 0)
289       ((parent-is "^comment$") column-0 0)
290       ((parent-is "^haddock$") column-0 0)
291       ((parent-is "^imports$") column-0 0)
292       ;; Infix
293       ((n-p-gp nil "infix" "infix")
294        (lambda (_ node _)
295          (let ((first-inf nil))
296            (while (string= "infix"
297                            (treesit-node-type
298                             (setq node (treesit-node-parent node))))
299              (setq first-inf node))
300            (funcall ,parent-first-child nil first-inf nil)))
301        2)
302       ((parent-is "^infix$") parent 2)
303       ((node-is "^infix$") standalone-parent 2)
304
305       ;; Lambda
306       ((parent-is "^lambda$") haskell-ts--stand-alone-parent 2)
307
308       ((parent-is "^class_declarations$") prev-sibling 0)
309
310       ((node-is "^where$") parent 2)
311
312       ;; in
313       ((node-is "^in$") parent 1)
314
315       ((parent-is "qualifiers") parent 0)
316
317       ;; list
318       ((node-is "^]$") parent 0)
319       ((parent-is "^list$") standalone-parent 2)
320
321       ;; Parens
322       ((node-is "^)$") parent 0)
323
324       ;; Structs
325       ((parent-is "^field$") standalone-parent 2)
326       ((node-is "^}$")
327        (lambda (_ parent bol)
328          (let ((sib (treesit-node-child parent 0)))
329            (while (and sib (not (string= (treesit-node-type sib)
330                                          "{"))) ; } Srry for ocd
331              (setq sib (treesit-node-next-sibling sib)))
332            (if sib
333                (treesit-node-start sib)
334              bol)))
335        0)
336
337       ((parent-is "^apply$") haskell-ts--stand-alone-parent 2)
338       ((node-is "^quasiquote$") grand-parent 2)
339       ((parent-is "^quasiquote_body$") (lambda (_ _ c) c) 0)
340       ((lambda (node parent bol)
341          (when-let ((n (treesit-node-prev-sibling node)))
342            (while (string= "comment" (treesit-node-type n))
343              (setq n (treesit-node-prev-sibling n)))
344            (string= "do" (treesit-node-type n))))
345        haskell-ts--stand-alone-parent
346        2)
347       ((parent-is "^do$") ,p-prev-sib 0)
348
349       ((parent-is "^alternatives$") ,p-prev-sib 0)
350
351       ;; prev-adaptive-prefix is broken sometimes
352       (no-node
353        (lambda (_ _ _)
354          (save-excursion
355            (goto-char (line-beginning-position 0))
356            (back-to-indentation)
357            (if (looking-at "\n")
358                0
359              (point))))
360        0)
361
362       ((node-is "^data_constructors$") parent 4)
363       ((node-is "^data_constructor$") parent 0)
364       ((n-p-gp "^\|$" "^data_constructors$" nil) parent -2)
365
366       ;; where
367       ((node-is "local_binds") ,p-prev-sib 2)
368       
369       ((parent-is "local_binds\\|instance_declarations") ,p-prev-sib 0)
370
371       ;; Conditionals This builds up on the hackiness of what happens
372       ;; in haskell-ts--stand-alone-parent
373       ((node-is "^then$") parent 2)
374       ((node-is "^else$") parent 2)
375       ((parent-is "^conditional$") parent 4)
376
377       ;; let.  It is important this one is in the bottom.
378       ((lambda (_ p _)
379          (let ((gp "let_in"))
380            (or (string= gp (treesit-node-type p))
381                (string= gp (treesit-node-type (treesit-node-parent p))))))
382        haskell-ts--stand-alone-parent 2)
383
384       
385       ;; Match
386       ((lambda (node _ _)
387          (and (string= "match" (treesit-node-type node))
388               (string-match (regexp-opt '("patterns" "variable"))
389                             (treesit-node-type (funcall ,p-n-prev node)))))
390        parent 2)
391
392       ((node-is "^match$") ,p-prev-sib 0)
393       ((parent-is "^match$") haskell-ts--stand-alone-parent 2)
394
395       ((parent-is "^haskell$") column-0 0)
396       ((parent-is "^declarations$") column-0 0)
397
398       ((parent-is "^record$") standalone-parent 2)
399
400       ((parent-is "^exports$")
401        (lambda (_ b _) (treesit-node-start (treesit-node-prev-sibling b)))
402        0)
403       ((n-p-gp nil "signature" "foreign_import") grand-parent 3)
404       ((parent-is "^\\(lambda_\\)?case$") haskell-ts--stand-alone-parent 2)
405       ((node-is "^alternatives$")
406        (lambda (_ b _)
407          (treesit-node-start (treesit-node-child b 0)))
408        2)
409       ((node-is "^comment$")
410        (lambda (node parent _)
411          (pcase node
412            ;; (relevent means type not it haskell-ts--ignore-types)
413            ;; 1. next relevent sibling if exists
414            ((app ,p-sib (and (pred (not null)) n))
415             (treesit-node-start n))
416            ;; 2. previous relevent sibling if exists
417            ((app ,p-prev-sib (and (pred (not null)) n))
418             n)
419            ;; 3. parent
420            (_ (treesit-node-start parent))))
421        0)
422
423       ;; TODO: I reckon this needs a variable
424       ((node-is "^|$") parent 0)
425
426       ;; Signature
427       ((n-p-gp nil "function" "function\\|signature") parent 0)
428
429       ;; Backup
430       (catch-all parent 2))))
431  "\"Simple\" treesit indentation rules for haskell.")
432
433(defvar haskell-ts-mode-syntax-table
434  (eval-when-compile
435    (let ((table (make-syntax-table))
436          (syntax-list
437           `((" " " \t\n\r\f\v")
438             ("_" "!#$%&*+./<=>?\\^|-~:")
439             ("w" ?_ ?\')
440             ("." ",:@")
441             ("\"" ?\")
442             ("()" ?\()
443             (")(" ?\))
444             ("(]" ?\[)
445             (")[" ?\])
446             ("$`" ?\`)
447             ("(}1nb" ?\{ )
448             ("){4nb" ?\} )
449             ("_ 123" ?- )
450             (">" "\r\n\f\v"))))
451      (dolist (ls syntax-list table)
452        (dolist (char (if (stringp (cadr ls))
453                          (string-to-list (cadr ls))
454                        (cdr ls)))
455          (modify-syntax-entry char (car ls) table)))))
456  "The syntax table for haskell.")
457
458(defun haskell-ts-sexp (node)
459  "Returns non-nil on a sexp node."
460  (let ((node-text (treesit-node-text node 1)))
461    (and
462     (not (member node-text '( "{" "}" "[" "]" "(" ")" ";")))
463     (not (and (string= "operator" (treesit-node-field-name node))
464               (= 1 (length node-text)))))))
465
466(defvar haskell-ts-thing-settings
467  `((haskell
468     (sexp haskell-ts-sexp)
469     (sentence "match")
470     (string "string")
471     (text "string")))
472  "`treesit-thing-settings' for `haskell-ts-mode'.")
473
474;; TODO make into a currying function
475(defmacro haskell-ts-imenu-name-function (check-func)
476  `(lambda (node)
477     (let ((nn (treesit-node-child node 0 node)))
478       (if (funcall ,check-func node)
479           (if (string= (treesit-node-type nn) "infix")
480               (treesit-node-text (treesit-node-child nn 1))
481             (haskell-ts-defun-name node))
482         nil))))
483
484(defvar-keymap  haskell-ts-mode-map
485  :doc "Keymap for haskell-ts-mode."
486  "C-c C-c" #'haskell-ts-compile-region-and-go
487  "C-c C-r" #'run-haskell)
488
489;;;###autoload
490(define-derived-mode haskell-ts-mode prog-mode "haskell ts mode"
491  "Major mode for Haskell files using tree-sitter."
492  :table haskell-ts-mode-syntax-table
493  (unless (treesit-ready-p 'haskell)
494    (error "Tree-sitter for Haskell is not available"))
495  (setq treesit-primary-parser (treesit-parser-create 'haskell))
496  (setq treesit-language-at-point-function
497        (lambda (&rest _) 'haskell))
498  (setq-local treesit-defun-type-regexp "\\(?:\\(?:function\\|struct\\)_definition\\)")
499  ;; Indent
500  (when haskell-ts-use-indent
501    (setq-local treesit-simple-indent-rules haskell-ts-indent-rules)
502    (setq-local indent-tabs-mode nil))
503  (setq-local electric-indent-functions '(haskell-ts-indent-after-newline))
504  ;; Comment
505  (setq-local comment-start "-- ")
506  (setq-local comment-use-syntax t)
507  (setq-local comment-start-skip "\\(?: \\|^\\)--+")
508  ;; Electric
509  (setq-local electric-pair-pairs
510              '((?` . ?`) (?\( . ?\)) (?{ . ?}) (?\" . ?\") (?\[ . ?\])))
511  ;; Navigation
512  (setq-local treesit-defun-name-function 'haskell-ts-defun-name)
513  (setq-local treesit-thing-settings haskell-ts-thing-settings)
514  (setq-local treesit-defun-type-regexp
515              ;; Since haskell is strict functional, any 2nd level
516              ;; entity is defintion
517              (cons ".+"
518                    (lambda (node)
519                      (and (not (string-match haskell-ts--ignore-types (treesit-node-type node)))
520                           (string= "declarations" (treesit-node-type (treesit-node-parent node)))))))
521  (setq-local prettify-symbols-alist
522              (append (and haskell-ts-prettify-symbols
523                           haskell-ts-prettify-symbols-alist)
524                      (and haskell-ts-prettify-words
525                           haskell-ts-prettify-words-alist)))
526
527  ;; Imenu
528  (setq-local treesit-simple-imenu-settings
529              `((nil haskell-ts-imenu-func-node-p nil
530                     ,(haskell-ts-imenu-name-function #'haskell-ts-imenu-func-node-p))
531                ("Signatures.." haskell-ts-imenu-sig-node-p nil
532                 ,(haskell-ts-imenu-name-function #'haskell-ts-imenu-sig-node-p))
533                (nil haskell-ts-imenu-data-type-p nil
534                     (lambda (node)
535                       (treesit-node-text (treesit-node-child node 1) t)))
536                (nil haskell-ts-imenu-typealias-type-p nil
537                     (lambda (node)
538                       (treesit-node-text (treesit-node-child node 1) t)))))
539  ;; font-lock
540  (setq-local treesit-font-lock-level haskell-ts-font-lock-level)
541  (setq-local treesit-font-lock-settings haskell-ts-font-lock)
542  (setq-local treesit-font-lock-feature-list
543              haskell-ts-font-lock-feature-list)
544  (treesit-major-mode-setup))
545
546(defun haskell-ts-indent-after-newline (c)
547  (when (eq c ?\n)
548    (let ((previous-line-width
549           (save-excursion
550             (goto-char (line-end-position 0))
551             (current-column))))
552      (insert (make-string previous-line-width ?\s))))
553  nil)
554
555(defun haskell-ts--fontify-func (node face)
556  (if (string= "variable" (treesit-node-type node))
557      (put-text-property
558       (treesit-node-start node)
559       (treesit-node-end node)
560       'face face)
561    (mapc (lambda (n) (haskell-ts--fontify-func n face))
562          (treesit-node-children node))))
563
564(defun haskell-ts--fontify-arg (node &optional _ _ _)
565  (haskell-ts--fontify-func node 'font-lock-variable-name-face))
566
567(defun haskell-ts--fontify-params (node &optional _ _ _)
568  (haskell-ts--fontify-func node 'font-lock-function-name-face))
569
570(defun haskell-ts--fontify-type (node &optional _ _ _)
571  (let ((last-child (treesit-node-child node -1)))
572    (if (string= (treesit-node-type last-child) "function")
573        (haskell-ts--fontify-type last-child)
574      (put-text-property
575       (treesit-node-start last-child)
576       (treesit-node-end last-child)
577       'face 'font-lock-variable-name-face))))
578
579(defun haskell-ts-imenu-node-p (regex node)
580  (and (string-match-p regex (treesit-node-type node))
581       (string= (treesit-node-type (treesit-node-parent node)) "declarations")))
582
583(defun haskell-ts-imenu-func-node-p (node)
584  (haskell-ts-imenu-node-p "function\\|bind" node))
585
586(defun haskell-ts-imenu-sig-node-p (node)
587  (haskell-ts-imenu-node-p "signature" node))
588
589(defun haskell-ts-imenu-data-type-p (node)
590  (haskell-ts-imenu-node-p "data_type\\|newtype" node))
591
592(defun haskell-ts-imenu-typealias-type-p (node)
593  (haskell-ts-imenu-node-p "type_synomym" node))
594
595(defun haskell-ts-defun-name (node)
596  (treesit-node-text (treesit-node-child node 0)))
597
598(defun haskell-ts-compile-region-and-go (start end)
599  "Compile the text from START to END in the haskell proc.
600If region is not active, reload the whole file."
601  (interactive (if (region-active-p)
602                   (list (region-beginning) (region-end))
603                 (list (point-min) (point-max))))
604  (let ((hs (haskell-ts-haskell-session)))
605    (if (region-active-p)
606        (let ((str (buffer-substring-no-properties start end)))
607          (comint-send-string hs ":{\n")
608          (comint-send-string
609           hs
610           ;; Things that may cause problem to ghci need to be
611           ;; escaped.  TODO examine if other lines that start with
612           ;; colons might cause problems
613           (replace-regexp-in-string "^:\\}" "\\:}" str nil t))
614          (comint-send-string hs "\n:}\n"))
615      (comint-send-string hs ":r\n"))))
616
617(defun haskell-ts-current-function-bound ()
618  "Get start and end point of current funciton."
619  (let (start end)
620    (save-excursion
621      (mark-defun)
622      (setq start (region-beginning))
623      (setq end (region-end))
624      (deactivate-mark))
625    (list start end)))
626
627;;;###autoload
628(defun run-haskell ()
629  "Run an inferior Haskell process."
630  (interactive)
631  (let ((buffer (get-buffer-create haskell-ts-ghci-buffer-name))
632        (ghci haskell-ts-ghci)
633        (switches haskell-ts-ghci-switches))
634    (pop-to-buffer-same-window
635     (if (comint-check-proc buffer)
636         buffer
637       (with-current-buffer buffer
638         (apply 'make-comint-in-buffer
639                "Haskell"
640                buffer
641                ghci
642                nil
643                switches))))))
644
645(defun haskell-ts-haskell-session ()
646  (get-buffer-process haskell-ts-ghci-buffer-name))
647
648(when (treesit-ready-p 'haskell)
649  (add-to-list 'auto-mode-alist '("\\.hs\\'" . haskell-ts-mode)))
650
651(provide 'haskell-ts-mode)
652
653;; derive from `haskell-mode' on emacs v30+
654(when (functionp 'derived-mode-add-parents)
655  (derived-mode-add-parents 'haskell-ts-mode '(haskell-mode)))
656
657;;; haskell-ts-mode.el ends here