1 files changed, 186 insertions, 0 deletions
diff --git a/lib/prog/jao-clojure.el b/lib/prog/jao-clojure.el
new file mode 100644
index 0000000..796c35d
--- /dev/null
+++ b/lib/prog/jao-clojure.el
@@ -0,0 +1,186 @@
+;;; jao-clojure.el --- Clojure utilities             -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2025  Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <mail@jao.io>
+;; Keywords: languages
+
+;; This program 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.
+
+;; This program 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 this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Helpers for clojure coding
+
+;;; Code:
+
+(require 'clojure-mode)
+(require 'project)
+(require 'cider-test)
+(require 'jao-skel)
+
+;;;; Jumping between implementation and test files
+(defun jao-clojure--ext-dir (prefix)
+  (let* ((ext (file-name-extension buffer-file-name))
+         (ext-rx (format "/%s/" ext)))
+    (if (string-match-p ext-rx buffer-file-name)
+        (format "%s/%s" prefix ext)
+      prefix)))
+
+(defun jao-clojure-find-current-test ()
+  (save-excursion
+    (and (re-search-backward
+          "(deftest\\(?:\\W+^:\\w+\\)*\\W+\\b\\(.+\\)\\b" nil t)
+         (match-string-no-properties 1))))
+
+(defvar jao-clojure--src-candidates '("lib" "src" "srv" "app"))
+
+(defun jao-clojure--test-namespace-p (ns)
+  (or (string-suffix-p "-test" ns)
+      (string-match "\\(.+\\)\\.\\(test\\)\\(\\..+\\)" ns)))
+
+(defun jao-clojure-test-buffer-p ()
+  (jao-clojure--test-namespace-p (clojure-find-ns)))
+
+(defun jao-clojure--test-for (namespace sep)
+  (replace-regexp-in-string "\\." sep (cider-test-default-test-ns-fn namespace)))
+
+(defun jao-clojure--infer-test-ns (ns)
+  (if (jao-clojure--test-namespace-p ns)
+      ns
+    (jao-clojure--test-for ns ".")))
+
+(defun jao-clojure--root () (project-root (project-current)))
+
+(defun jao-clojure-jump-to-test ()
+  "Jump from implementation to test file."
+  (interactive)
+  (let* ((f (format "%s/%s/%s.%s"
+                    (jao-clojure--root)
+                    "test"
+                    (jao-clojure--test-for (clojure-find-ns) "/")
+                    (file-name-extension buffer-file-name)))
+         (f (replace-regexp-in-string "-" "_" f)))
+    (find-file f)))
+
+(defun jao-clojure--implementation-for (namespace)
+  (thread-last (replace-regexp-in-string "-test$" "" namespace)
+               (replace-regexp-in-string "\\.test\\." ".")
+               (replace-regexp-in-string "-" "_")
+               (replace-regexp-in-string "\\." "/")
+               (substring-no-properties)))
+
+(defun jao-clojure--find-implementation (src)
+  (let ((f (format "%s%s/%s.%s"
+                   (jao-clojure--root)
+                   src
+                   (jao-clojure--implementation-for (clojure-find-ns))
+                   (file-name-extension buffer-file-name))))
+    (and (file-exists-p f) f)))
+
+(defun jao-clojure-jump-to-implementation ()
+  "Jump from test file to implementation."
+  (interactive)
+  (let ((impl (car (seq-keep #'jao-clojure--find-implementation
+                             jao-clojure--src-candidates))))
+    (if impl (find-file impl) (message "No implementation file found"))))
+
+(defun jao-clojure-other-file ()
+  "Toggle between implementation and test file"
+  (interactive)
+  (if (jao-clojure-test-buffer-p)
+      (jao-clojure-jump-to-implementation)
+    (jao-clojure-jump-to-test)))
+
+(defun jao-clojure--setup-compilation (&optional ns)
+  ;; (set (make-local-variable 'compile-command) (jao-clojure--test-str ns))
+  )
+
+;;;; Skeletons
+(defconst jao-clojure--ns-destruct-rx
+  (format "\\(?:%s\\|tests?\\)\\.\\(?:clj[cs]?\\.\\)?\\(.+\\)"
+          (regexp-opt jao-clojure--src-candidates)))
+
+(defun jao-clojure-buffer-namespace ()
+  (let* ((ddir (jao-compilation-root))
+         (mbase (and ddir
+                     (concat (replace-regexp-in-string "/" "." ddir) ".")))
+         (mbase (and mbase
+                     (string-match jao-clojure--ns-destruct-rx mbase)
+                     (match-string 1 mbase))))
+    (concat (or mbase "")
+            (replace-regexp-in-string "_" "-" (jao-skel-basename)))))
+
+(defvar jao-clojure--test-check-lines
+  (concat "[clojure.test.check :as tc]\n                  "
+          "[clojure.test.check.generators :as gen]\n        "
+          "[clojure.test.check.properties :as prop :include-macros true]\n"))
+
+(defun jao-clojure--cljs-test-reqs (prefix-cmp last-cmp test-check)
+  (concat "  (:require [cljs.test :as t :refer-macros [is deftest async]]"
+          "\n          [" prefix-cmp "." last-cmp " :as " last-cmp "])"))
+
+(defun jao-clojure--clj-test-reqs (prefix-cmp last-cmp test-check)
+  (format "(:use clojure.test)\n  (:require %s(%s [%s :as %s]))"
+          (if test-check
+              (concat "(clojure.test.check [clojure-test :refer [defspec]])\n"
+                      jao-clojure--test-check-lines)
+            "")
+          prefix-cmp last-cmp last-cmp))
+
+(defun jao-clojure--cljc-test-reqs (prefix-cmp last-cmp test-check)
+  (concat "(:require #?(:clj [clojure.test :as t :refer [is deftest]]\n"
+          "               :cljs [cljs.test :as t :refer-macros [is deftest]])\n"
+          (when test-check
+            (concat "            [clojure.test.check-clojure-test #?@("
+                    ":cljs [:refer-macros [defspec]]\n"
+                    ":clj [:refer [defspec]))]\n"
+                    jao-clojure--test-check-lines))
+          "           [" prefix-cmp "." last-cmp " :as " last-cmp "])"))
+
+(defun jao-clojure--skel-ns-contents (ns)
+  (if (jao-clojure--test-namespace-p ns)
+      (let ((test-check (y-or-n-p "Include test.check requires? "))
+            (ns (concat (match-string 1 ns) (match-string 3 ns))))
+        (let* ((cmps (split-string ns "\\."))
+               (last-cmp (car (last cmps)))
+               (prefix-cmp (mapconcat 'identity (butlast cmps) "."))
+               (ext (file-name-extension buffer-file-name)))
+          (cond ((string= "cljs" ext)
+                 (jao-clojure--cljs-test-reqs prefix-cmp last-cmp test-check))
+                ((string= "cljc" ext)
+                 (jao-clojure--cljc-test-reqs prefix-cmp last-cmp test-check))
+                ((string= "clj" ext)
+                 (jao-clojure--clj-test-reqs prefix-cmp last-cmp test-check)))))
+    (format "%S" (read-string "Brief module description: "))))
+
+(define-skeleton jao-clojure-skeleton
+  "Standard Clojure module file skeleton"
+  ""
+  (jao-skel-copyright-line ";; ")
+  \n
+  (jao-skel-author-line ";; Author: ")
+  (jao-skel-date-line ";; Start date: ")
+  \n '(setq v1 (jao-clojure-buffer-namespace))
+  _ "(ns " v1
+  '(jao-clojure--setup-compilation v1)
+  \n (jao-clojure--skel-ns-contents v1) ")"
+  \n
+  '(ignore-errors (indent-region (region-beginning) (region-end)))
+  >  -)
+
+(jao-skel-install "\\.clj[sc]?$" 'jao-clojure-skeleton)
+
+
+(provide 'jao-clojure)
+;;; jao-clojure.el ends here