From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Pranshu Sharma via "Emacs development discussions." Newsgroups: gmane.emacs.devel Subject: Re: Merge haskell-ts-mode in upstream Date: Wed, 01 Jan 2025 18:04:17 +1000 Message-ID: <871pxnm03i.fsf@bauherren.ovh> References: <87cyhh7t00.fsf@bauherren.ovh> <87msglb89y.fsf@posteo.net> <87ed1s1akm.fsf@bauherren.ovh> <87msgfzsvl.fsf@posteo.net> <87r05rmxhm.fsf@bauherren.ovh> <87cyhazgw5.fsf@posteo.net> <875xn28qzj.fsf@bauherren.ovh> <87ed1o2ca8.fsf@posteo.net> Reply-To: Pranshu Sharma Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="5195"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: Pranshu Sharma via "Emacs development discussions." To: Philip Kaludercic Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Wed Jan 01 12:54:15 2025 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1tSxIk-0001CP-Fd for ged-emacs-devel@m.gmane-mx.org; Wed, 01 Jan 2025 12:54:14 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tSxHu-0007Jk-3i; Wed, 01 Jan 2025 06:53:22 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tStiR-0002cl-9n for emacs-devel@gnu.org; Wed, 01 Jan 2025 03:04:31 -0500 Original-Received: from [2001:19f0:7400:14e3:5400:5ff:fe30:b63e] (helo=mail.bauherren.ovh) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tStiO-0005sP-4o for emacs-devel@gnu.org; Wed, 01 Jan 2025 03:04:31 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=bauherren.ovh; s=mail; t=1735718665; bh=Zc/uDYYNtjCCFANSj17YP+8dvDZ+wPs7U4nwvJVo720=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=KI4hHhm2UHZk5BEpKskJB6bi11WbVbyUJDkMHccjWrWP29a1oL60iH4mFl+9uiBtH kQDAg9GWBssznCgovPbAMLsgij/ev2vGQRYe/KJWeDHbJyfPzami6sXDN6qkRm/K+b 1b0ouS8MNBKYjcshlm8fcZvPCOmr/AMP1h5hLaAXPJcfKvWEhTqSWUWbM+dhdMegY1 1yaILBxjEpwCBDyMdvmcQIs7yseb8Sr7cIZ7kXBfioR5bxFYKFm9x1wwqpUDTacs0y BPwKPhqWRAAjV0a4Qt+FaMXC6XgEBBvBG0zTnDPV3Ie3gHNIr0JmR1kQXRQYAGRO5U txnlHjlReT0pg== In-Reply-To: <87ed1o2ca8.fsf@posteo.net> (Philip Kaludercic's message of "Tue, 31 Dec 2024 13:49:03 +0000") X-Host-Lookup-Failed: Reverse DNS lookup failed for 2001:19f0:7400:14e3:5400:5ff:fe30:b63e (failed) Received-SPF: pass client-ip=2001:19f0:7400:14e3:5400:5ff:fe30:b63e; envelope-from=pranshu@bauherren.ovh; helo=mail.bauherren.ovh X-Spam_score_int: -8 X-Spam_score: -0.9 X-Spam_bar: / X-Spam_report: (-0.9 / 5.0 requ) BAYES_00=-1.9, DKIM_INVALID=0.1, DKIM_SIGNED=0.1, RDNS_NONE=0.793, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=no autolearn_force=no X-Spam_action: no action X-Mailman-Approved-At: Wed, 01 Jan 2025 06:53:18 -0500 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.devel:327543 Archived-At: --=-=-= Content-Type: text/plain Philip Kaludercic writes: > It would be helpful if you could prepare a patch against emacs.git, > which would also update NEWS and the documentation where applicable, > otherwise I can do it but it might take me some time. Ok, I did it. I don't think it is neccasary for me to add manual entry, but I add the news thing in this. I modified the top file comment thing with license and all to be consistant with the other .el files in emacs. --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: attachment; filename=haskts.diff Content-Transfer-Encoding: quoted-printable diff --git a/etc/NEWS b/etc/NEWS index 45b7d56a4cd..5c3cb30b780 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -557,6 +557,13 @@ package of the current buffer. It is bound to 'C-c C-= t p' in 'go-ts-mode'. The 'go-ts-mode-build-tags' user option is available to set a list of build tags for the test commands. =20 ++++ +** Haskell-ts mode + +A new major mode for haskell mode based on treesitter is provided. It +can interact with ghci, indent code, provide imenu functionality, and +provide syntax highlighting. + ** C-ts mode =20 +++ diff --git a/lisp/progmodes/haskell-ts-mode.el b/lisp/progmodes/haskell-ts-= mode.el new file mode 100644 index 00000000000..c6dced51078 --- /dev/null +++ b/lisp/progmodes/haskell-ts-mode.el @@ -0,0 +1,447 @@ +;;; haskell-ts-mode.el --- A treesit based major mode for haskell -*- lexi= cal-binding:t -*- + +;; Copyright (C) 2025 Free Software Foundation, Inc. + +;; Author: Pranshu Sharma +;; Version: 1 +;; Keywords: languages, haskell +;; URL: https://codeberg.org/pranshu/haskell-ts-mode + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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 of the License, or +;; (at your option) any later version. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: + +;; This is a major mode that uses treesitter to provide all the basic +;; major mode stuff, like indentation, font lock, etc... +;; It uses the grammer at: https://github.com/tree-sitter/tree-sitter-hask= ell + +;;; Code: + +(require 'comint) +(require 'treesit) + +(declare-function treesit-parser-create "treesit.c") +(declare-function treesit-node-start "treesit.c") +(declare-function treesit-node-parent "treesit.c") +(declare-function treesit-node-prev-sibling "treesit.c") +(declare-function treesit-node-next-sibling "treesit.c") +(declare-function treesit-node-end "treesit.c") +(declare-function treesit-node-child "treesit.c") +(declare-function treesit-node-type "treesit.c") + +(defgroup haskell-ts-mode nil + "Group that contains haskell-ts-mode variables" + :group 'langs) + +(defvar haskell-ts-font-lock-feature-list + `((comment str pragma parens) + (type definition function args) + (match keyword) + (otherwise signature type-sig))) + +(defcustom haskell-ts-ghci "ghci" + "The command to be called to run ghci." + :type 'string) + +(defcustom haskell-ts-ghci-buffer-name "Inferior Haskell" + "Buffer name for the ghci prcoess." + :type 'string) + +(defcustom haskell-ts-use-indent t + "Set to non-nil to use the indentation provided by haskell-ts-mode" + :type 'boolean) + +(defcustom haskell-ts-font-lock-level 4 + "Level of font lock, 1 for minimum highlghting and 4 for maximum." + :type '(choice (const :tag "Minimal Highlighting" 1) + (const :tag "Low Highlighting" 2) + (const :tag "High Highlighting" 3) + (const :tag "Maximum Highlighting" 4))) + +(defvar haskell-ts-prettify-symbols-alist + '(("\\" . "=CE=BB") + ("/=3D" . "=E2=89=A0") + ("->" . "=E2=86=92") + ("=3D>" . "=E2=87=92") + ("<-" . "=E2=86=90") + ("<=3D" . "=E2=89=A5") + (">=3D" . "=E2=89=A4"))) + +(defvar haskell-ts-font-lock + (treesit-font-lock-rules + :language 'haskell + :feature 'keyword + `(["module" "import" "data" "let" "where" "case" "type" + "if" "then" "else" "of" "do" "in" "instance" "class"] + @font-lock-keyword-face) + :language 'haskell + :feature 'otherwise + :override t + `(((match (guards guard: (boolean (variable) @font-lock-keyword-face))) + (:match "otherwise" @font-lock-keyword-face))) + :language 'haskell + :feature 'type-sig + "(signature (binding_list (variable) @font-lock-doc-markup-face)) + (signature (variable) @font-lock-doc-markup-face)" + :language 'haskell + :feature 'args + :override 'keep + (concat + "(function (infix left_operand: (_) @haskell-ts--fontify-arg))" + "(function (infix right_operand: (_) @haskell-ts--fontify-arg))" + "(generator . (_) @haskell-ts--fontify-arg)" + "(bind (as (variable) . (_) @haskell-ts--fontify-arg))" + "(patterns) @haskell-ts--fontify-arg") + :language 'haskell + :feature 'type + `((type) @font-lock-type-face + (constructor) @font-lock-type-face) + :language 'haskell + :override t + :feature 'signature + `((signature (function) @haskell-ts--fontify-type) + (context (function) @haskell-ts--fontify-type)) + :language 'haskell + :feature 'match + `((match ("|" @font-lock-doc-face) ("=3D" @font-lock-doc-face)) + (list_comprehension ("|" @font-lock-doc-face + (qualifiers (generator "<-" @font-lock-doc-face)))) + (match ("->" @font-lock-doc-face))) + :language 'haskell + :feature 'comment + `(((comment) @font-lock-comment-face) + ((haddock) @font-lock-doc-face)) + :language 'haskell + :feature 'pragma + `((pragma) @font-lock-preprocessor-face + (cpp) @font-lock-preprocessor-face) + :language 'haskell + :feature 'str + :override t + `((char) @font-lock-string-face + (string) @font-lock-string-face + (quasiquote (quoter) @font-lock-type-face) + (quasiquote (quasiquote_body) @font-lock-preprocessor-face)) + :language 'haskell + :feature 'parens + :override t + `(["(" ")" "[" "]"] @font-lock-operator-face + (infix operator: (_) @font-lock-operator-face)) + :language 'haskell + :feature 'function + :override t + `((function name: (variable) @font-lock-function-name-face) + (function (infix (operator) @font-lock-function-name-face)) + (declarations (type_synomym (name) @font-lock-function-name-face)) + (bind (variable) @font-lock-function-name-face) + (function (infix (infix_id (variable) @font-lock-function-name-face))) + (bind (as (variable) @font-lock-function-name-face)))) + "The treesitter font lock settings for haskell.") + +(defun haskell-ts--stand-alone-parent (_ parent bol) + (save-excursion + (goto-char (treesit-node-start parent)) + (let ((type (treesit-node-type parent))) + (if (and (not bol) + (or (looking-back "^[ \t]*" (line-beginning-position)) + (member + type + '("when" "where" "do" "let" "local_binds" "function")))) + (treesit-node-start parent) + (haskell-ts--stand-alone-parent 1 (funcall + (if bol 'treesit-node-parent 'identity) + (treesit-node-parent parent)) + nil))))) + +(defvar haskell-ts--ignore-types + (regexp-opt '("comment" "cpp" "haddock")) + "Node types that will be ignored by indentation.") + +(defvar haskell-ts-indent-rules + (let* ((p-sib + (lambda (node &optional arg) + (let* ((func (if arg + #'treesit-node-prev-sibling + #'treesit-node-next-sibling)) + (n (funcall func node))) + (while (and n (string-match haskell-ts--ignore-types + (treesit-node-type n))) + (setq n (funcall func n))) + n))) + (p-prev-sib + (lambda (node &optional _ _) (treesit-node-start (funcall p-sib node t)= ))) + (p-n-prev (lambda (node) (funcall p-sib node t))) + (parent-first-child (lambda (_ parent _) + (treesit-node-start (treesit-node-child parent 0))))) + `((haskell + ((node-is "^cpp$") column-0 0) + ((parent-is "^comment$") column-0 0) + ((parent-is "^haddock$") column-0 0) + ((parent-is "^imports$") column-0 0) + ;; Infix + ((n-p-gp nil "infix" "infix") + (lambda (_ node _) + (let ((first-inf nil)) + (while (string=3D "infix" + (treesit-node-type + (setq node (treesit-node-parent node)))) + (setq first-inf node)) + (funcall ,parent-first-child nil first-inf nil))) + 0) + ((node-is "^infix$") ,parent-first-child 0) + + ;; Lambda + ((parent-is "^lambda\\(_case\\)?$") standalone-parent 2) + + ((parent-is "^class_declarations$") prev-sibling 0) + + ((node-is "^where$") parent 2) + + ;; in + ((node-is "^in$") parent 0) + + ((parent-is "qualifiers") parent 0) + + ;; list + ((node-is "^]$") parent 0) + ((parent-is "^list$") standalone-parent 2) + + ;; If then else + ((node-is "^then$") parent 2) + ((node-is "^else$") parent 2) + + ((parent-is "^apply$") haskell-ts--stand-alone-parent 1) + ((node-is "^quasiquote$") grand-parent 2) + ((parent-is "^quasiquote_body$") (lambda (_ _ c) c) 0) + ((lambda (node parent bol) + (when-let ((n (treesit-node-prev-sibling node))) + (while (string=3D "comment" (treesit-node-type n)) + (setq n (treesit-node-prev-sibling n))) + (string=3D "do" (treesit-node-type n)))) + haskell-ts--stand-alone-parent + 3) + ((parent-is "^do$") ,p-prev-sib 0) + + ((parent-is "^alternatives$") ,p-prev-sib 0) + + ;; prev-adaptive-prefix is broken sometimes + (no-node + (lambda (_ _ _) + (save-excursion + (goto-char (line-beginning-position 0)) + (back-to-indentation) + (point))) + 0) + + ((parent-is "^data_constructors$") parent 0) + + ;; where + ((lambda (node _ _) + (let ((n (treesit-node-prev-sibling node))) + (while (string=3D "comment" (treesit-node-type n)) + (setq n (treesit-node-prev-sibling n))) + (string=3D "where" (treesit-node-type n)))) + + (lambda (_ b _) + (+ 1 (treesit-node-start (treesit-node-prev-sibling b)))) + 3) + ((parent-is "local_binds\\|instance_declarations") ,p-prev-sib 0) + + ;; Match + ((lambda (node _ _) + (and (string=3D "match" (treesit-node-type node)) + (string-match (regexp-opt '("patterns" "variable")) + (treesit-node-type (funcall ,p-n-prev node))))) + standalone-parent 2) + + ((node-is "match") ,p-prev-sib 0) + ((parent-is "match") standalone-parent 2) + + ((parent-is "^haskell$") column-0 0) + ((parent-is "^declarations$") column-0 0) + + ((parent-is "^record$") standalone-parent 2) + + ((parent-is "^exports$") + (lambda (_ b _) (treesit-node-start (treesit-node-prev-sibling b))) + 0) + ((n-p-gp nil "signature" "foreign_import") grand-parent 3) + ((parent-is "^case$") standalone-parent 4) + ((node-is "^alternatives$") + (lambda (_ b _) + (treesit-node-start (treesit-node-child b 0))) + 2) + ((node-is "^comment$") + (lambda (node parent _) + (pcase node + ;; (relevent means type not it haskell-ts--ignore-types) + ;; 1. next relevent sibling if exists + ((app ,p-sib (and (pred (not null)) n)) + (treesit-node-start n)) + ;; 2. previous relevent sibling if exists + ((app ,p-prev-sib (and (pred (not null)) n)) + n) + ;; 3. parent + (_ (treesit-node-start parent)))) + 0) + ;; Backup + (catch-all parent 2)))) + "\"Simple\" treesit indentation rules for haskell.") + +;; Copied from haskell-tng-mode, changed a bit + +(defvar haskell-ts-mode-syntax-table + (eval-when-compile + (let ((table (make-syntax-table)) + (syntax-list + '(("_" ?! ?_) + ("w" ?') + ;; Haskell has some goofy comment enders like C-q C-l + (">" 13 10 12 11) + ("_ 123" ?-) + ("(}1nb" ?\{) + ("){4nb" ?\}) + ("<" ?#) + (">" ?\n) + ;; Special operaters + ("." ?\, ?\; ?@) + ("\"" ?\") + ("$`" ?\`)))) + ;; The defaults are mostly fine + (dolist (ls syntax-list table) + (dolist (char (cdr ls)) + (modify-syntax-entry char (car ls) table)))))) + +(defmacro haskell-ts-imenu-name-function (check-func) + `(lambda (node) + (let ((nn (treesit-node-child node 0 node))) + (if (funcall ,check-func node) + (if (string=3D (treesit-node-type nn) "infix") + (treesit-node-text (treesit-node-child nn 1)) + (haskell-ts-defun-name node)) + nil)))) + +(defvar-keymap haskell-ts-mode-map + :doc "Keymap for haskell-ts-mode." + "C-c C-c" 'haskell-ts-compile-region-and-go + "C-c C-r" 'run-haskell) + +;;;###autoload +(define-derived-mode haskell-ts-mode prog-mode "haskell ts mode" + "Major mode for Haskell files using tree-sitter." + (unless (treesit-ready-p 'haskell) + (error "Tree-sitter for Haskell is not available")) + (treesit-parser-create 'haskell) + (setq-local treesit-defun-type-regexp "\\(?:\\(?:function\\|struct\\)_de= finition\\)") + ;; Indent + (when haskell-ts-use-indent + (setq-local treesit-simple-indent-rules haskell-ts-indent-rules) + (setq-local indent-tabs-mode nil)) + ;; Comment + (setq-local comment-start "-- ") + (setq-local comment-use-syntax t) + (setq-local comment-start-skip "\\(?: \\|^\\)-+") + ;; Electric + (setq-local electric-pair-pairs + '((?` . ?`) (?\( . ?\)) (?{ . ?}) (?\" . ?\") (?\[ . ?\]))) + ;; Navigation + (setq-local treesit-defun-name-function 'haskell-ts-defun-name) + (setq-local treesit-defun-type-regexp + ;; Since haskell is strict functional, any 2nd level + ;; entity is defintion + (cons ".+" + (lambda (node) + (and (not (string-match haskell-ts--ignore-types (treesit-node-typ= e node))) + (string=3D "declarations" (treesit-node-type (treesit-node-parent no= de))))))) + (setq-local prettify-symbols-alist haskell-ts-prettify-symbols-alist) +=20=20 + ;; Imenu + (setq-local treesit-simple-imenu-settings + `((nil haskell-ts-imenu-func-node-p nil + ,(haskell-ts-imenu-name-function #'haskell-ts-imenu-func-node-p)) + ("Signatures.." haskell-ts-imenu-sig-node-p nil + ,(haskell-ts-imenu-name-function #'haskell-ts-imenu-sig-node-p)) + ("Data..." haskell-ts-imenu-data-type-p nil + (lambda (node) + (treesit-node-text (treesit-node-child node 1)))))) + ;; font-lock + (setq-local treesit-font-lock-level haskell-ts-font-lock-level) + (setq-local treesit-font-lock-settings haskell-ts-font-lock) + (setq-local treesit-font-lock-feature-list + haskell-ts-font-lock-feature-list) + (treesit-major-mode-setup)) + +(defun haskell-ts--fontify-arg (node &optional _ _ _) + (if (string=3D "variable" (treesit-node-type node)) + (put-text-property + (treesit-node-start node) + (treesit-node-end node) + 'face font-lock-variable-name-face) + (mapc 'haskell-ts--fontify-arg (treesit-node-children node)))) + +(defun haskell-ts--fontify-type (node &optional _ _ _) + (let ((last-child (treesit-node-child node -1))) + (if (string=3D (treesit-node-type last-child) "function") + (haskell-ts--fontify-type last-child) + (put-text-property + (treesit-node-start last-child) + (treesit-node-end last-child) + 'face font-lock-variable-name-face)))) + +(defun haskell-ts-imenu-node-p (regex node) + (and (string-match-p regex (treesit-node-type node)) + (string=3D (treesit-node-type (treesit-node-parent node)) "declarat= ions"))) + +(defun haskell-ts-imenu-func-node-p (node) + (haskell-ts-imenu-node-p "function\\|bind" node)) + +(defun haskell-ts-imenu-sig-node-p (node) + (haskell-ts-imenu-node-p "signature" node)) + +(defun haskell-ts-imenu-data-type-p (node) + (haskell-ts-imenu-node-p "data_type" node)) + +(defun haskell-ts-defun-name (node) + (treesit-node-text (treesit-node-child node 0))) + +(defun haskell-ts-compile-region-and-go (start end) + "Compile the text from START to END in the haskell proc." + (interactive "r") + (let ((hs (haskell-ts-haskell-session)) + (str (buffer-substring-no-properties + start end))) + (comint-send-string hs ":{\n") + (comint-send-string + hs + (replace-regexp-in-string "^:\\}" "\\:}" str nil t)) + (comint-send-string hs "\n:}\n"))) + +(defun run-haskell () + (interactive) + (pop-to-buffer-same-window + (if (comint-check-proc (concat "*" haskell-ts-ghci-buffer-name "*")) + haskell-ts-ghci-buffer-name + (make-comint haskell-ts-ghci-buffer-name haskell-ts-ghci nil buffer-f= ile-name)))) + +(defun haskell-ts-haskell-session () + (get-buffer-process (concat "*" haskell-ts-ghci-buffer-name "*"))) + +(when (treesit-ready-p 'haskell) + (add-to-list 'auto-mode-alist '("\\.hs\\'" . haskell-ts-mode))) + +(provide 'haskell-ts-mode) + +;;; haskell-ts-mode.el ends here --=-=-= Content-Type: text/plain -- Pranshu Sharma --=-=-=--