From bdda41e49d23821db072100fc2158de06990080a Mon Sep 17 00:00:00 2001
From: mattiasdrp <5543639+mattiasdrp@users.noreply.github.com>
Date: Fri, 29 Jul 2022 17:47:30 +0200
Subject: [PATCH] OCaml parser and first functions added

This update allows to fold comments, value, type and module
definitions if they're not on one line only

I'm not sure about the one line rule but it seems strange to fold a
value that fits on one line
---
 README.md          |  1 +
 ts-fold-parsers.el |  8 ++++++
 ts-fold.el         | 70 ++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 79 insertions(+)

diff --git a/README.md b/README.md
index 31acec2..a07cdf3 100644
--- a/README.md
+++ b/README.md
@@ -100,6 +100,7 @@ These languages are in development:
 * Agda
 * Elm
 * Emacs Lisp
+* OCaml
 * XML (upstream)
 
 ## ⚖️ Indicators Mode
diff --git a/ts-fold-parsers.el b/ts-fold-parsers.el
index 668bb77..cf9456e 100644
--- a/ts-fold-parsers.el
+++ b/ts-fold-parsers.el
@@ -45,6 +45,7 @@
 (declare-function ts-fold-range-c-preproc-elif "ts-fold.el")
 (declare-function ts-fold-range-c-preproc-else "ts-fold.el")
 (declare-function ts-fold-range-html "ts-fold.el")
+(declare-function ts-fold-range-ocaml "ts-fold.el")
 (declare-function ts-fold-range-python "ts-fold.el")
 (declare-function ts-fold-range-ruby "ts-fold.el")
 (declare-function ts-fold-range-rust-macro "ts-fold.el")
@@ -171,6 +172,13 @@
              (ts-fold-range-line-comment node offset "#")
            (ts-fold-range-c-like-comment node offset))))))
 
+(defun ts-fold-parsers-ocaml ()
+  "Rule sets for OCaml."
+  '((comment             . ts-fold-range-ocaml-comment)
+    (module_definition   . ts-fold-range-ocaml-module-definition)
+    (type_definition     . ts-fold-range-ocaml-type-definition)
+    (value_definition    . ts-fold-range-ocaml-value-definition)))
+
 (defun ts-fold-parsers-python ()
   "Rule sets for Python."
   '((function_definition . ts-fold-range-python)
diff --git a/ts-fold.el b/ts-fold.el
index 7d47842..646e1eb 100644
--- a/ts-fold.el
+++ b/ts-fold.el
@@ -90,6 +90,7 @@ The alist is in form of (major-mode . (foldable-node-type)).")
     (sh-mode         . ,(ts-fold-parsers-bash))
     (scala-mode      . ,(ts-fold-parsers-scala))
     (swift-mode      . ,(ts-fold-parsers-swift))
+    (tuareg-mode     . ,(ts-fold-parsers-ocaml))
     (typescript-mode . ,(ts-fold-parsers-typescript)))
   "An alist of (major-mode . (foldable-node-type . function)).
 
@@ -365,6 +366,10 @@ in backward direction."
       (setq iter-node (ts-fold--next-prev-node iter-node next)))
     last-node))
 
+(defun tsc-fold--one-liner-node (node)
+  "Helper function to check if NODE is on one line only."
+  (= (car (aref (tsc-node-range node) 2)) (car (aref (tsc-node-range node) 3))))
+
 (defun ts-fold-range-seq (node offset)
   "Return the fold range in sequence starting from NODE.
 
@@ -446,6 +451,71 @@ more information."
          (end (tsc-node-start-position end-node)))
     (ts-fold--cons-add (cons beg end) offset)))
 
+;;+ OCaml
+
+(defun ts-fold-range-ocaml-comment (node offset)
+  "Define fold range for `comment'.
+
+For arguments NODE and OFFSET, see function `ts-fold-range-seq' for
+more information."
+  (unless (tsc-fold--one-liner-node node)
+    (when-let*
+        ((text  (tsc-node-text node))
+         (beg   (if (string-prefix-p "(* " text)
+                    (+ 2 (tsc-node-start-position node))
+                  (+ 3 (tsc-node-start-position node))))
+         (end   (- (tsc-node-end-position node) 2)))
+      (cons beg end))))
+
+(defun ts-fold-range-ocaml-module-definition (node offset)
+  "Define fold range for `module_definition'.
+
+For arguments NODE and OFFSET, see function `ts-fold-range-seq' for
+more information."
+  (unless (tsc-fold--one-liner-node node)
+    (when-let*
+        ((module-binding (tsc-get-nth-named-child node 0))
+         (body           (tsc-get-child-by-field module-binding :body))
+         ;; body is struct ... end
+         (beg            (+ 6 (tsc-node-start-position body)))
+         (end            (- (tsc-node-end-position node) 3)))
+      (cons beg end))))
+
+(defun ts-fold-range-ocaml-type-definition (node offset)
+  "Define fold range for `type_definition'.
+
+For arguments NODE and OFFSET, see function `ts-fold-range-seq' for
+more information."
+  (unless (tsc-fold--one-liner-node node)
+    (when-let*
+        ((type-definition (tsc-get-nth-named-child node 0))
+         (body            (tsc-get-child-by-field type-definition :body))
+         (text            (tsc-node-text (tsc-get-nth-child body 0)))
+         (beg
+          (if (string-equal "{" text)
+              (1+ (tsc-node-start-position body))
+            (tsc-node-end-position (tsc-get-prev-sibling body))))
+         (end
+          (if (string-equal "{" text)
+              (1- (tsc-node-end-position node))
+            (tsc-node-end-position node))))
+      (cons beg end))))
+
+(defun ts-fold-range-ocaml-value-definition (node offset)
+  "Define fold range for `value_definition'.
+
+For arguments NODE and OFFSET, see function `ts-fold-range-seq' for
+more information."
+  (unless (tsc-fold--one-liner-node node)
+    (when-let*
+        ((let-binding  (tsc-get-nth-named-child node 0))
+         (body         (tsc-get-child-by-field let-binding :body))
+         (beg          (tsc-node-end-position (tsc-get-prev-sibling body)))
+         (end          (tsc-node-end-position node)))
+      (cons beg end))))
+
+;;- OCaml
+
 (defun ts-fold-range-python (node offset)
   "Define fold range for `function_definition' and `class_definition'.