code.delx.au - dotemacs/blob - text-edit/my-find-test-file.el

   1 ;;; -*- lexical-binding: t -*-
   2
   3 (require 'cl-lib)
   4
   5 (defun my/prod-file-p (file)
   6   (not (or (string-match-p "test" file)
   7            (string-match-p "spec" file))))
   8
   9 (defun my/matching-test-file-p (test-file base-name extension)
  10   (cl-loop for pattern in (list
  11                            (concat "test/.*" base-name "[^/]*\\." extension "$")
  12                            (concat "spec/.*" base-name "[^/]*\\." extension "$")
  13                            (concat "test[^/]*" base-name "[^/]*\\." extension "$")
  14                            (concat base-name "[^/]*test\\." extension "$")
  15                            (concat base-name "[^/]*spec\\." extension "$"))
  16            for matched = (string-match-p pattern test-file)
  17            until matched
  18            finally return (not (null matched))))
  19
  20 (defun my/matching-prod-file-p (prod-file base-name extension)
  21   (dolist (pattern '("test" "it.spec" "spec" "^\\.*" "\\.*$"))
  22     (setq base-name (replace-regexp-in-string pattern "" base-name)))
  23   (and (my/prod-file-p prod-file)
  24        (string-match-p (concat base-name "[^/]*\\." extension "$") prod-file)))
  25
  26 (defun my/find-prod-or-test-file (&optional initial-directory)
  27   "Find test file in the current project.
  28 INITIAL-DIRECTORY, if non-nil, is used as the root directory for search."
  29   (interactive
  30    (list (when current-prefix-arg
  31            (read-directory-name "From directory: "))))
  32   (counsel-require-program "rg")
  33
  34   (let* ((default-directory (or initial-directory
  35                                 (locate-dominating-file default-directory ".git")
  36                                 default-directory))
  37          (files (split-string
  38                  (shell-command-to-string counsel-rg-files-command)
  39                  "\n"
  40                  t))
  41          (base-name (file-name-sans-extension (file-name-nondirectory (buffer-file-name))))
  42          (extension (file-name-extension (buffer-file-name)))
  43          (predicate (if (my/prod-file-p (buffer-file-name)) #'my/matching-test-file-p #'my/matching-prod-file-p))
  44          (results nil))
  45
  46     (dolist (file files)
  47       (if (funcall predicate file base-name extension)
  48           (cl-pushnew file results)))
  49
  50     (cl-case (length results)
  51       (0 (message "No matching file found."))
  52       (1 (find-file (car results)))
  53       (t (ivy-read "Find test file" results
  54                    :action #'counsel-git-action
  55                    :caller 'my/find-prod-or-test-file)))))
  56
  57 (provide 'my-find-test-file)