Mirrored from codeberg

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

Jump to: .dir-locals.el README.md 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.md

1	
2	# haskell-ts-mode
3	
4	A [Haskell](https://www.haskell.org/) mode that uses [Tree-sitter](https://tree-sitter.github.io/tree-sitter/).
5	
6	![img](./ss.png)
7	
8	The above screenshot is indented and coloured using `haskell-ts-mode`, with
9	`prettify-symbols-mode` enabled.
10	
11	# Usage
12	
13	-   `C-c C-r` Open REPL
14	-   `C-c C-c` Send code to REPL
15	-   `M-q`   Indent the function
16	
17	# Features
18	
19	Say it with me: Indentation does not change the syntax tree. This means that the
20	indentation is a lot more predictable, but sometimes you must manually press
21	`M-i` to indent.
22	
23	Overview of features:
24	
25	-   Syntax highlighting
26	-   Structural navigation
27	-   Indentation
28	-   Imenu support
29	-   REPL (`C-c C-r` in the mode to run)
30	-   Prettify Symbols mode support
31	
32	# Comparison with `haskell-mode`
33	
34	The more interesting features are:
35	
36	-   Logical syntax highlighting:
37	    -   Only arguments that can be used in functions are highlighted, e.g., in `f
38	            (_:(a:[]))` only `a` is highlighted, as it is the only variable that is
39	        captured, and that can be used in the body of the function.
40	    -   The return type of a function is highlighted.
41	    -   All new variabels are (or should be) highlighted, this includes generators,
42	        lambda arguments.
43	    -   Highlighting the `=` operator in guarded matches correctly, this would be
44	        stupidly hard in regexp based syntax.
45	-   More performant, this is especially seen in longer files.
46	-   Much, much less code, `haskell-mode` has accumlated 30,000 lines of code and
47	    features to do with all things Haskell related. `haskell-ts-mode` just keeps
48	    the scope to basic major mode stuff, and leaves other stuff to external
49	    packages.
50	
51	# Motivation
52	
53	`haskell-mode` contains nearly 30k lines of code, and is about 30 years old. A
54	lot of features implemented by `haskell-mode` are now also available in standard
55	Emacs, and have thus become obsolete.
56	
57	In 2018, a mode called [`haskell-tng-mode`](https://elpa.nongnu.org/nongnu/haskell-tng-mode.html) was made to solve some of these
58	problems. However, because of Haskell's syntax, it too became very complex and
59	required a web of dependencies.
60	
61	Both these modes ended up practically parsing Haskell's syntax to implement
62	indentation, so I thought why not use Tree-sitter?
63	
64	# Structural navigation
65	
66	This mode provides strucural navigation, for Emacs 30+.
67	
68	    combs (x:xs) = map (x:) c ++ c
69	      where c = combs xs
70	
71	In the above code, if the pointer is right in front of the function
72	definition `combs`, and you press `C-M-f` (`forward-sexp`), it will take you to
73	the end of the second line.
74	
75	# Installation
76	
77	Add this into your init.el:
78	```lisp
79	(use-package haskell-ts-mode
80	  :ensure t
81	  :custom
82	  (haskell-ts-font-lock-level 4)
83	  (haskell-ts-use-indent t)
84	  (haskell-ts-ghci "ghci")
85	  (haskell-ts-use-indent t)
86	  :config
87	  (add-to-list 'treesit-language-source-alist
88	   '(haskell . ("https://github.com/tree-sitter/tree-sitter-haskell" "v0.23.1")))
89	  (unless (treesit-grammar-location 'haskell)
90	   (treesit-install-language-grammar 'haskell)))
91	```
92	
93	That is all.  This will install the grammars if not already installed.
94	However, you might need to update the grammar version in the future.
95	
96	## Other recommended packages
97	
98	Unlike `haskell-mode`, this mode has a limited scope to just worrying
99	about haskell.  There are other packages that I find help a lot with
100	development:
101	- [consult-hoogle](https://codeberg.org/rahguzar/consult-hoogle) great
102	  interface for `hoogle`.
103	- [dante](https://github.com/jyp/dante)
104	- [hindent](https://github.com/mihaimaruseac/hindent) If you want to
105	  outsource the indentation and formatting to another haskell package.
106	- [ormolu](https://github.com/vyorkin/ormolu.el) hindent alternative
107	- [hcel](https://github.com/emacsmirror/hcel) Codebase navigator, if
108	  you want a lighter alternaitve to a full blown LSP.
109	
110	# Customization
111	
112	## How to disable `haskell-ts-mode` indentation
113	
114	    (setq haskell-ts-use-indent nil)
115	
116	## Use a formatter (e.g. hindent, ormolu/formolu)
117	
118	`C-c C-f` in a haskell formats the current region is it is active, or
119	the current function.
120	
121	The default formater is
122	[ormolu](https://hackage.haskell.org/package/ormolu).  You can adjust
123	`haskell-ts-format-command` this to use another formatter.
124	
125	
126	## Pretify Symbols mode
127	
128	`prettify-symbols-mode` can be used to replace common symbols with
129	unicode alternatives.
130	
131	
132	Turning on `prettify-symbols-mode` does stuff like turn `->` to
133	`→`. If you want to prettify words, set `haskell-ts-prettify-words` to
134	non-nil.  This will do stuff like prettify `forall` into `∀` and
135	`elem` to `∈`.
136	
137	    (add-hook 'haskell-ts-mode 'prettify-symbols-mode)
138	
139	## Adjusting font lock level
140	
141	Set `haskell-ts-font-lock-level` accordingly.  The default and most
142	highest value is 4.  You are against vibrancy, you can lower it to
143	match your dreariness.
144	
145	## Language server
146	
147	`haskell-ts-mode` works with `lsp-mode` and, since Emacs 30, with
148	`eglot`.
149	
150	To add `eglot` support on Emacs 29 and earlier, add the following code
151	to your `init.el`:
152	
153	    (with-eval-after-load 'eglot
154	      (defvar eglot-server-programs)
155	      (add-to-list 'eglot-server-programs
156	                   '(haskell-ts-mode . ("haskell-language-server-wrapper" "--lsp"))))
157	
158	# TODO 
159	
160	-   Support for M-x align, so that calling it will align all the '='
161	    signs in a region.
162	-   Imenu support for functions with multiple definitions.
163	
164	

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