;;; jao-clojure.el --- Clojure utilities -*- lexical-binding: t; -*- ;; Copyright (C) 2025 Jose Antonio Ortega Ruiz ;; Author: Jose Antonio Ortega Ruiz ;; 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 . ;;; 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