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

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