diff options
| -rw-r--r-- | NEWS | 7 | ||||
| -rw-r--r-- | snakemake-mode.el | 81 | ||||
| -rw-r--r-- | snakemake.el | 400 | ||||
| -rw-r--r-- | test-snakemake.el (renamed from test-snakemake-mode.el) | 143 |
4 files changed, 552 insertions, 79 deletions
@@ -1,5 +1,12 @@ NEWS -- history of user-visible changes -*- mode: org; -*- +* v0.4.0 (unreleased) + +** New features + +- New library snakemake.el provides a popup interface for running + Snakemake from Emacs. + * v0.3.0 ** New features diff --git a/snakemake-mode.el b/snakemake-mode.el index 46e4273..2e40b7b 100644 --- a/snakemake-mode.el +++ b/snakemake-mode.el @@ -6,7 +6,7 @@ ;; URL: https://github.com/kyleam/snakemake-mode ;; Keywords: tools ;; Version: 0.3.0 -;; Package-Requires: ((emacs "24")) +;; Package-Requires: ((emacs "24") (cl-lib "0.5") (magit-popup "2.4.0")) ;; 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 @@ -27,6 +27,9 @@ ;; builds on Python mode to provide fontification, indentation, and ;; imenu indexing for Snakemake's rule blocks. ;; +;; See also snakemake.el, which is packaged with snakemake-mode.el and +;; provides an interface for running Snakemake commands. +;; ;; If Snakemake mode is installed from MELPA, no additional setup is ;; required. It will be loaded the first time a file named 'Snakefile' ;; is opened. @@ -41,17 +44,15 @@ ;;; Code: -(require 'compile) (require 'python) ;;; Customization ;;;###autoload -(defgroup snakemake nil +(defgroup snakemake-mode nil "Support for Snakemake files" - :group 'tools - :prefix "snakemake-") + :group 'tools) (defcustom snakemake-mode-hook nil "Hook run when entering `snakemake-mode'." @@ -65,14 +66,6 @@ "Offset for field values that the line below the field key." :type 'integer) -(defcustom snakemake-executable "snakemake" - "Snakemake executable to use in compile command." - :type 'string) - -(defcustom snakemake-compile-command-options nil - "Flags to add to default Snakemake compilation command." - :type '(repeat string)) - ;;; Regexp @@ -301,51 +294,6 @@ or subworkflow block." (1- (current-column)))))) -;;; Compilation - -(defun snakemake-compile-command () - "Return Snakemake compile command. -Flags are taken from `snakemake-compile-command-options'." - (mapconcat 'identity - (cons snakemake-executable snakemake-compile-command-options) - " ")) - -(defun snakemake-compile-rule (jobs) - "Run Snakemake with the rule at point as the target. - -The numeric prefix JOBS controls the number of jobs that -Snakemake runs (defaults to 1). If JOBS is zero, perform a dry -run. If JOBS is negative, just touch the output files. - -Customize `snakemake-executable' and -`snakemake-compile-command-options' to control the compilation -command." - (interactive "p") - (unless (snakemake-in-rule-or-subworkflow-block-p) - (user-error "Not in rule block")) - (save-excursion - (end-of-line) - (re-search-backward snakemake-rule-or-subworkflow-re) - (let ((block-type (match-string-no-properties 1)) - (rule-name (match-string-no-properties 2))) - (pcase block-type - ("rule" - (let* ((job-flag (cond - ((> jobs 0) (format " -j%s " jobs)) - ((zerop jobs) " -n ") - (t " -t "))) - (compile-command (concat (snakemake-compile-command) job-flag - rule-name))) - (call-interactively #'compile))) - ("subworkflow" (user-error "Cannot compile a subworkflow")))))) - -(add-to-list 'compilation-error-regexp-alist 'snakemake) -(add-to-list - 'compilation-error-regexp-alist-alist - '(snakemake . ("^SyntaxError in line \\([0-9]+\\) of \\(.*[^A-z]Snakefile\\):$" - 2 1))) - - ;;; Imenu (defun snakemake-imenu-create-index () @@ -375,13 +323,6 @@ label." ;;; Mode -(defvar snakemake-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map python-mode-map) - (define-key map (kbd "C-c C-b") 'snakemake-compile-rule) - map) - "Keymap for `snakemake-mode'.") - (defvar snakemake-font-lock-keywords `((,snakemake-rule-or-subworkflow-line-re (1 font-lock-keyword-face) (2 font-lock-function-name-face)) @@ -391,18 +332,12 @@ label." ;;;###autoload (define-derived-mode snakemake-mode python-mode "Snakemake" - "Mode for editing Snakemake files. - -\\<snakemake-mode-map>\ -Type \\[snakemake-compile-rule] to run Snakemake with the rule of -the block at point as the target. -\n\\{snakemake-mode-map}" + "Mode for editing Snakemake files." (set (make-local-variable 'imenu-create-index-function) #'snakemake-imenu-create-index) (set (make-local-variable 'indent-line-function) 'snakemake-indent-line) (set (make-local-variable 'font-lock-defaults) - `(,(append snakemake-font-lock-keywords python-font-lock-keywords))) - (set (make-local-variable 'compile-command) (snakemake-compile-command))) + `(,(append snakemake-font-lock-keywords python-font-lock-keywords)))) ;;;###autoload (add-to-list 'auto-mode-alist '("Snakefile\\'" . snakemake-mode)) diff --git a/snakemake.el b/snakemake.el new file mode 100644 index 0000000..8a985ee --- /dev/null +++ b/snakemake.el @@ -0,0 +1,400 @@ +;;; snakemake.el --- Call Snakemake from Emacs -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 Kyle Meyer + +;; Author: Kyle Meyer <kyle@kyleam.com> +;; URL: https://github.com/kyleam/snakemake-mode + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This package provides a popup interface, built on Magit's popup +;; library [1], for calling Snakemake [2]. The main entry point is +;; `snakemake-popup', which you should consider giving a global key +;; binding. +;; +;; The popup currently includes four actions, all which lead to +;; `compile' being called with "snakemake ...". What's different +;; between the actions is how targets are selected. +;; +;; snakemake-build-targets-at-point +;; +;; This command builds the file name or rule at point if it's a +;; valid build target. +;; +;; How the file name targets are retrieved depends on functions in +;; `snakemake-file-targets-hook'. The default functions grab file +;; names from Dired, Org links, and general text under point that +;; looks like a file name. +;; +;; snakemake-compile +;; +;; This action leads to an interactive `compile' call that allows +;; you to edit the command before it is run. +;; +;; It tries to guess what the target name should be, but it +;; doesn't verify if this target is actually a build target. This +;; lax behavior is useful to, for example, pull in an input file +;; name from Dired and then edit the extension to get the desired +;; output name. +;; +;; snakemake-build-rule-target +;; +;; This command prompts with a list of all target rules for the +;; current Snakefile and builds the selected one. +;; +;; snakemake-build-file-target +;; +;; Like `snakemake-build-rule-target', but this command prompts +;; for a file name, using the file name at point, if it's a valid +;; target, as the default completion. +;; +;; When `snakemake-file-target-program' is set to a program that +;; outputs a list of files, the user is prompted with that list +;; instead. snakemake.el's source repo contains a script, +;; "snakemake-file-targets", that can be used for this purpose. +;; It outputs a list of all concrete output files for the current +;; Snakefile. +;; +;; [1] http://magit.vc/manual/magit-popup.html +;; [2] https://bitbucket.org/snakemake/snakemake/wiki/Home + +;;; Code: + +(require 'cl-lib) +(require 'compile) +(require 'magit-popup) + +(require 'snakemake-mode) + + +;;; Customization + +;;;###autoload +(defgroup snakemake nil + "Interface for running Snakemake" + :group 'tools) + +(defcustom snakemake-program "snakemake" + "Command to run Snakemake." + :type 'string + :package-version '(snakemake-mode . "0.4.0")) + +(defcustom snakemake-file-target-program + (executable-find "snakemake-file-targets") + "Program that returns newline-delimited list of output files." + :type '(choice (const :tag "None" nil) + (string :tag "Program")) + :package-version '(snakemake-mode . "0.4.0")) + +(defcustom snakemake-root-dir-function nil + "Function used to find root directory of the current \"project\". +This function will be called with no arguments and should return +an absolute path or, if no root is found, nil. When nil, only +Snakefiles in the current directory will be detected." + :type '(choice (const :tag "None" nil) + (function :tag "Use VC" vc-root-dir) + (function :tag "Use Projectile" projectile-project-root)) + :package-version '(snakemake-mode . "0.4.0")) + +(defcustom snakemake-file-targets-hook + '(snakemake-dired-file-targets + snakemake-org-link-file-targets + snakemake-thingatpt-file-targets) + "Functions to return file targets at point. +These will be called, with no arguments, until one of them +signals success by returning non-nil. If non-nil, the return +value should be a list of absolute paths." + :type 'hook + :package-version '(snakemake-mode . "0.4.0")) + + +;;; Utilities + +(defun snakemake-snakefile-directory (&optional path) + "Return current Snakefile's directory for PATH. + +If PATH is nil, it defaults to `default-directory'. + +Which Snakefile, if any, is current is determined by the value of +`default-directory'. + +* A file named \"Snakefile\" in `default-directory' is always + considered the current file. + +* If `default-directory' does not contain a file named + \"Snakefile\", look in the directory given by + `snakemake-root-dir-function'." + (let ((default-directory + (or (and path (file-name-directory (expand-file-name path))) + default-directory))) + (or (and (file-exists-p "Snakefile") default-directory) + (and snakemake-root-dir-function + (let ((topdir (ignore-errors + (funcall snakemake-root-dir-function)))) + (when topdir + (and (file-exists-p (expand-file-name "Snakefile" topdir)) + topdir)))) + (user-error "No Snakefile found for %s" default-directory)))) + +(defvar snakemake--cache (make-hash-table :test #'equal)) +(defmacro snakemake-with-cache (directory cache-info &rest body) + "Execute BODY and cache result, with DIRECTORY's Snakefile as current. +CACHE-INFO should uniquely identify the call when taken together +with DIRECTORY and the Snakefile's modification time." + (declare (indent defun) (debug (form form body))) + (let ((cached (cl-gensym "cached")) + (key (cl-gensym "key"))) + `(let* ((default-directory (snakemake-snakefile-directory ,directory)) + (,key (list default-directory + (nth 5 (file-attributes + (expand-file-name "Snakefile"))) + ,@cache-info)) + (,cached (gethash ,key snakemake--cache 'not-found))) + (if (eq ,cached 'not-found) + (let ((result ,(macroexp-progn body))) + (puthash ,key result snakemake--cache) + result) + ,cached)))) + +(defun snakemake-insert-output (&rest args) + "Call `snakemake-program' with ARGS and insert output." + (apply #'call-process snakemake-program nil t nil args)) + +(defun snakemake-rule-targets (&optional directory) + "Return list of target rules for DIRECTORY's Snakefile." + (snakemake-with-cache directory ("target-rules") + (split-string + (with-temp-buffer + (if (= 0 (snakemake-insert-output + "--nocolor" "--list-target-rules")) + (buffer-string) + (error "Error finding rule targets")))))) + +(defun snakemake-file-targets (&optional directory) + "Return list of output files for DIRECTORY's Snakefile. +The file list is determined by the output of +`snakemake-file-target-program'." + (when snakemake-file-target-program + (snakemake-with-cache directory ("target-files") + (split-string + (with-temp-buffer + (if (= 0 (call-process snakemake-file-target-program nil t)) + (buffer-string) + (error "Error finding file targets"))))))) + +(defun snakemake-check-target (target &optional directory) + "Return non-nil if TARGET is a valid target for DIRECTORY's Snakefile." + (snakemake-with-cache directory (target) + (with-temp-buffer + (snakemake-insert-output "--quiet" "--dryrun" target) + (goto-char (point-min)) + ;; Lean towards misclassifying targets as valid rather than + ;; silently dropping valid targets as invalid. + (not (looking-at (regexp-opt (list "MissingRuleException" + "RuleException"))))))) + +(declare-function org-element-context "org-element") +(declare-function org-element-property "org-element") +(defun snakemake-org-link-file-targets () + "Return file path from Org link. +This function returns a list for consistency with other +target-returning functions, but any non-nil return value is +currently limited to a single-item list." + (when (derived-mode-p 'org-mode) + (let ((el (org-element-context))) + ;; Don't use `org-element-lineage' because it isn't available + ;; until Org version 8.3. + (while (and el (not (memq (car el) '(link)))) + (setq el (org-element-property :parent el))) + (when (eq (car el) 'link) + (list (expand-file-name (org-element-property :path el))))))) + +(declare-function dired-get-marked-files "dired") +(defun snakemake-dired-file-targets () + "Return marked Dired files." + (and (derived-mode-p 'dired-mode) + (dired-get-marked-files))) + +(defun snakemake-thingatpt-file-targets () + "Return file at point accordinng `thing-at-point'. +This function returns a list for consistency with other +target-returning functions, but any non-nil return value is +currently limited to a single-item list." + (let ((fname (thing-at-point 'filename))) + (and fname + (list (expand-file-name fname))))) + +(defun snakemake-file-targets-at-point (&optional check) + "Return list of file targets at point. +If CHECK is non-nil, filter files to known targets of the current +Snakefile." + (let* ((dir (snakemake-snakefile-directory)) + (fnames (run-hook-with-args-until-success + 'snakemake-file-targets-hook)) + (targets (mapcar (lambda (f) (file-relative-name f dir)) + fnames))) + (when targets + (if check + (let ((default-directory dir)) + (cl-remove-if-not #'snakemake-check-target targets)) + targets)))) + +(defun snakemake-rule-at-point (&optional targets-only) + "Return name of rule at point. + +If TARGETS-ONLY is non-nil, verify that the rule is a valid +target. + +This function returns a list for consistency with other +target-returning functions, but any non-nil return value is +currently limited to a single-item list." + (when (and (derived-mode-p 'snakemake-mode) + (snakemake-in-rule-or-subworkflow-block-p)) + (save-excursion + (end-of-line) + (re-search-backward snakemake-rule-or-subworkflow-re) + (let ((rule (and (equal (match-string-no-properties 1) "rule") + (match-string-no-properties 2)))) + (and (or (not targets-only) (snakemake-check-target rule)) + (list rule)))))) + +(defun snakemake--prompt (prompt default) + (concat prompt + (and default (format " (default %s)" default)) + ": ")) + +(defun snakemake-read-file-target () + "Read a file target. +If `snakemake-file-target-program' is non-nil, use it to generate +a collection file targets to prompt with. Otherwise, just read a +file name, adjusting the returned file name's path relative to +`snakemake-snakefile-directory'." + (let ((default (car (snakemake-file-targets-at-point t)))) + (if snakemake-file-target-program + (completing-read + (snakemake--prompt "File" default) + (snakemake-file-targets) + nil nil nil nil + default) + (let* ((sdir (snakemake-snakefile-directory)) + (rel-default (and default + (file-relative-name + (expand-file-name default sdir))))) + (file-relative-name + (read-file-name + (snakemake--prompt "File" rel-default) + nil rel-default) + sdir))))) + +(defun snakemake-read-rule (&optional targets-only) + "Read a rule for the current Snakefile. +If TARGETS-ONLY is non-nil, only prompt with rules that are valid +targets." + (let ((default (car (snakemake-rule-at-point targets-only)))) + (completing-read + (snakemake--prompt "Rule" default) + (if targets-only (snakemake-rule-targets) (snakemake-all-rules)) + nil nil nil nil + default))) + + +;;; Compilation commands + +(add-to-list 'compilation-error-regexp-alist 'snakemake) +(add-to-list + 'compilation-error-regexp-alist-alist + '(snakemake . ("^SyntaxError in line \\([0-9]+\\) of \\(.*[^A-z]Snakefile\\):$" + 2 1))) + +(defun snakemake--define-compile-command (targets args) + (mapconcat #'identity + `(,snakemake-program ,@args "--" ,@targets) + " ")) + +(defun snakemake-compile-targets (targets args) + "Run non-interactive `compile' with 'snakemake [ARGS] -- TARGETS'." + (let ((default-directory (snakemake-snakefile-directory))) + (compile (snakemake--define-compile-command targets args)))) + +;;;###autoload +(defun snakemake-build-targets-at-point (&optional args) + "Build target(s) at point without any prompts. + +$ snakemake [ARGS] -- <targets>" + (interactive (list (snakemake-arguments))) + (let ((targets (or (snakemake-file-targets-at-point 'check) + (snakemake-rule-at-point 'target) + (user-error "No target found at point"))) + (default-directory (snakemake-snakefile-directory))) + (snakemake-compile-targets targets args))) + +;;;###autoload +(defun snakemake-build-file-target (&optional args) + "Build target file. + +$ snakemake [ARGS] -- <file>" + (interactive (list (snakemake-arguments))) + (snakemake-compile-targets + (list (snakemake-read-file-target)) + args)) + +;;;###autoload +(defun snakemake-build-rule-target (&optional args) + "Build target rule, prompting with known rules. + +$ snakemake [ARGS] -- <rule>" + (interactive (list (snakemake-arguments))) + (snakemake-compile-targets + (list (snakemake-read-rule 'targets)) + args)) + +;;;###autoload +(defun snakemake-compile (&optional args) + "Read `compile' command for building targets. + +$ snakemake [ARGS] -- <targets>" + (interactive (list (snakemake-arguments))) + (let* ((default-directory (snakemake-snakefile-directory)) + (compilation-read-command t) + (compile-command (snakemake--define-compile-command + (or (snakemake-file-targets-at-point) + (snakemake-rule-at-point) + (list "")) + args))) + (call-interactively #'compile))) + +;;;###autoload (autoload 'snakemake-popup "snakemake" nil t) +(magit-define-popup snakemake-popup + "Popup console for running Snakemake." + :switches + '((?f "Force" "--force") + (?i "Ignore temp()" "--notemp") + (?n "Dry run" "--dryrun") + (?p "Print shell commands" "-p") + (?r "Print reason" "--reason") + (?t "Touch files" "--touch")) + :options + '((?j "Number of jobs" "-j")) + :actions + '((?c "Compile" snakemake-compile) nil nil + (?p "Build target at point" snakemake-build-targets-at-point) + (?f "Build file" snakemake-build-file-target) + (?r "Build rule" snakemake-build-rule-target)) + :default-action 'snakemake-compile + :max-action-columns 3) + +(provide 'snakemake) +;;; snakemake.el ends here diff --git a/test-snakemake-mode.el b/test-snakemake.el index 3581e93..03cf1f1 100644 --- a/test-snakemake-mode.el +++ b/test-snakemake.el @@ -1,4 +1,4 @@ -;;; test-snakemake-mode.el --- Tests for snakemake-mode.el +;;; test-snakemake.el --- Tests for snakemake{,-mode}.el ;; Copyright (C) 2015-2016 Kyle Meyer <kyle@kyleam.com> @@ -21,6 +21,7 @@ (require 'cl-lib) (require 'snakemake-mode) +(require 'snakemake) (require 'ert) ;; This is modified from `org-tests.el' (55c0708). @@ -48,9 +49,46 @@ Also, mute messages." ,@body)))) (def-edebug-spec snakemake-with-temp-text (form body)) +(defmacro snakemake-with-temp-dir (&rest body) + "Run BODY in a temporary directory with Snakefile. +`snakemake-test-dir' is bound to top-level directory." + (declare (indent 0) (debug t)) + `(cl-letf (((symbol-function 'message) (lambda (&rest args) nil))) + (let* ((snakemake-test-dir (file-name-as-directory + (make-temp-file "sm-test-dir" t))) + (snakemake-root-dir-function `(lambda () ,snakemake-test-dir))) + (unwind-protect + (let ((default-directory snakemake-test-dir)) + (mkdir "subdir") + (with-temp-file "Snakefile" + (insert "\ + +rule aa: + output: \"aa.out\" + shell: \"echo aa.content > {output}\" + +rule bb: + input: \"aa.out\" + output: \"bb.out\" + shell: \"cat {input} > {output}\" + +rule cc_wildcards: + input: \"bb.out\" + output: \"{name}.outwc\" + shell: \"cat {input} > {output}\" + +rule dd_subdir: + input: \"aa.out\" + output: \"subdir/dd.out\" + shell: \"cat {input} > {output}\"")) + ,@body) + (delete-directory snakemake-test-dir t))))) +(def-edebug-spec snakemake-with-temp-dir (body)) -;;; Indentation +;;; snakemake-mode.el + +;;;; Indentation (ert-deftest test-snakemake-mode/indentation-at-rule-block () "Test `snakemake-indent-line' at top of rule block." @@ -438,8 +476,7 @@ rule abc: (snakemake-indent-line) (buffer-string))))) - -;;; Other +;;;; Other (ert-deftest test-snakemake-mode/in-rule-block () "Test `snakemake-in-rule-or-subworkflow-block-p'" @@ -616,6 +653,100 @@ rule abc: <point>" (snakemake-previous-field-value-column))))) + +;;; snakemake.el + +(ert-deftest test-snakemake/snakefile-directory () + "Test `snakemake-snakefile-directory'." + (snakemake-with-temp-dir + (should (equal default-directory (snakemake-snakefile-directory))) + (let ((topdir default-directory)) + (should (equal topdir + (let ((default-directory "subdir")) + (snakemake-snakefile-directory))))))) + +(ert-deftest test-snakemake/rule-targets () + "Test `snakemake-rule-targets'." + (should + (equal '("aa" "bb" "dd_subdir") + (snakemake-with-temp-dir + (snakemake-rule-targets))))) -(provide 'test-snakemake-mode) -;;; test-snakemake-mode.el ends here +(ert-deftest test-snakemake/file-targets () + "Test `snakemake-file-targets'." + (should + (equal + (and snakemake-file-target-program + '("aa.out" "bb.out" "subdir/dd.out")) + (snakemake-with-temp-dir + (snakemake-file-targets))))) + +(ert-deftest test-snakemake/check-target () + "Test `snakemake-check-target'." + (should + (snakemake-with-temp-dir + (snakemake-check-target "aa.out"))) + (should-not + (snakemake-with-temp-dir + (snakemake-check-target "aa.out.not-target")))) + +(ert-deftest test-snakemake/org-link-file-targets () + "Test `snakemake-org-link-file-targets'." + (should (equal '("/path/to/fname") + (with-temp-buffer + (org-mode) + (insert "\n[[file:/path/to/fname][descr]]\n") + (forward-line -1) + (snakemake-org-link-file-targets))))) + +(ert-deftest test-snakemake/file-targets-at-point () + "Test `snakemake-file-targets-at-point'." + (should + (equal '("aa.out") + (snakemake-with-temp-dir + (with-temp-buffer + (insert "aa.out") + (beginning-of-line) + (snakemake-file-targets-at-point 'check))))) + (should-not + (snakemake-with-temp-dir + (with-temp-buffer + (insert "aa.out.not-target") + (beginning-of-line) + (snakemake-file-targets-at-point 'check)))) + (should + (equal '("aa.out.not-target") + (snakemake-with-temp-dir + (with-temp-buffer + (insert "aa.out.not-target") + (beginning-of-line) + (snakemake-file-targets-at-point)))))) + +(ert-deftest test-snakemake/rule-at-point () + "Test `snakemake-rule-targets-at-point'." + (should + (equal '("aa") + (snakemake-with-temp-dir + (with-temp-buffer + (snakemake-mode) + (insert-file-contents "Snakefile") + (re-search-forward "rule aa:") + (snakemake-rule-at-point 'target))))) + (should + (equal '("cc_wildcards") + (snakemake-with-temp-dir + (with-temp-buffer + (snakemake-mode) + (insert-file-contents "Snakefile") + (re-search-forward "rule cc_wildcards:") + (snakemake-rule-at-point))))) + (should-not + (snakemake-with-temp-dir + (with-temp-buffer + (snakemake-mode) + (insert-file-contents "Snakefile") + (re-search-forward "rule cc_wildcards:") + (snakemake-rule-at-point 'target))))) + +(provide 'test-snakemake) +;;; test-snakemake.el ends here |