From 737484092c3afc994eeab446b805b0998853b47d Mon Sep 17 00:00:00 2001 From: Kyle Meyer Date: Sun, 28 Feb 2016 03:25:52 -0500 Subject: Add popup interface for compilation --- NEWS | 7 + snakemake-mode.el | 81 +----- snakemake.el | 400 ++++++++++++++++++++++++++ test-snakemake-mode.el | 621 ---------------------------------------- test-snakemake.el | 752 +++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 1167 insertions(+), 694 deletions(-) create mode 100644 snakemake.el delete mode 100644 test-snakemake-mode.el create mode 100644 test-snakemake.el diff --git a/NEWS b/NEWS index ed3a887..b39a8ee 100644 --- a/NEWS +++ b/NEWS @@ -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 @@ -300,51 +293,6 @@ or subworkflow block." (when (re-search-forward rule-re (point-at-eol) t) (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 @@ -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. - -\\\ -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 +;; 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 . + +;;; 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] -- " + (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] -- " + (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] -- " + (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] -- " + (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-mode.el deleted file mode 100644 index 3581e93..0000000 --- a/test-snakemake-mode.el +++ /dev/null @@ -1,621 +0,0 @@ -;;; test-snakemake-mode.el --- Tests for snakemake-mode.el - -;; Copyright (C) 2015-2016 Kyle Meyer - -;; Author: Kyle Meyer - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'snakemake-mode) -(require 'ert) - -;; This is modified from `org-tests.el' (55c0708). -(defmacro snakemake-with-temp-text (text &rest body) - "Run body in a temporary Snakemake mode buffer. - -Fill the buffer with TEXT. If the string \"\" appears in -TEXT then remove it and place the point there before running -BODY, otherwise place the point at the beginning of the inserted -text. - -Also, mute messages." - (declare (indent 1)) - `(cl-letf (((symbol-function 'message) (lambda (&rest args) nil))) - (let ((inside-text (if (stringp ,text) ,text (eval ,text)))) - (with-temp-buffer - (snakemake-mode) - (let ((point (string-match "" inside-text))) - (if point - (progn - (insert (replace-match "" nil nil inside-text)) - (goto-char (1+ (match-beginning 0)))) - (insert inside-text) - (goto-char (point-min)))) - ,@body)))) -(def-edebug-spec snakemake-with-temp-text (form body)) - - - -;;; Indentation - -(ert-deftest test-snakemake-mode/indentation-at-rule-block () - "Test `snakemake-indent-line' at top of rule block." - - ;; Always shift first line of block to column 0. - (should - (string= - "rule abc:" - (snakemake-with-temp-text - "rule abc:" - (snakemake-indent-line) - (buffer-string)))) - (should - (string= - "rule abc:" - (snakemake-with-temp-text - " rule abc:" - (snakemake-indent-line) - (buffer-string)))) - - ;; Don't move point if beyond column 0. - (should - (string= - "rule abc: " - (snakemake-with-temp-text - " rule abc: " - (snakemake-indent-line) - (buffer-string)))) - (should - (string= - "rule " - (snakemake-with-temp-text - " rule abc: " - (snakemake-indent-line) - (buffer-substring (point-min) (point)))))) - -(ert-deftest test-snakemake-mode/indentation-outside-rule () - "Test `snakemake-indent-line' outside rule block." - ;; Use standard Python mode indentation outside of rule blocks. - (should - (string= - " -def ok(): - " - (snakemake-with-temp-text - " -def ok(): -" - (snakemake-indent-line) - (buffer-string))))) - -(ert-deftest test-snakemake-mode/indentation-field-key () - "Test `snakemake-indent-line' on field key line." - - ;; Always indent first line to `snakemake-indent-field-offset'. - ;; Move point to `snakemake-indent-field-offset' if it is before any - ;; text on the line. - (should - (string= - " -rule abc: - " - (snakemake-with-temp-text - " -rule abc: -" - (snakemake-indent-line) - (buffer-string)))) - (should - (string= - " -rule abc: - " - (snakemake-with-temp-text - " -rule abc: -" - (snakemake-indent-line) - (snakemake-indent-line) - (buffer-string)))) - (should - (string= - " -rule abc: - text" - (snakemake-with-temp-text - " -rule abc: -text" - (snakemake-indent-line) - (buffer-substring (point-min) (point))))) - (should - (string= - " -rule abc: - te" - (snakemake-with-temp-text - " -rule abc: -text" - (snakemake-indent-line) - (buffer-substring (point-min) (point))))) - - ;; Always indent field key to `snakemake-indent-field-offset'. - ;; Move point to `snakemake-indent-field-offset' if it is before any - ;; text on the line. - (should - (string= - " -rule abc: - input: 'infile' - output:" - (snakemake-with-temp-text - " -rule abc: - input: 'infile' -output:" - (snakemake-indent-line) - (buffer-string)))) - (should - (string= - " -rule abc: - input: 'infile' - output:" - (snakemake-with-temp-text - " -rule abc: - input: 'infile' -output:" - (snakemake-indent-line) - (snakemake-indent-line) - (buffer-string)))) - (should - (string= - " -rule abc: - input: 'infile' - output: " - (snakemake-with-temp-text - " -rule abc: - input: 'infile' -output: " - (snakemake-indent-line) - (buffer-string)))) - (should - (string= - " -rule abc: - input: 'infile' - " - (snakemake-with-temp-text - " -rule abc: - input: 'infile' - output:" - (snakemake-indent-line) - (buffer-substring (point-min) (point)))))) - -(ert-deftest test-snakemake-mode/indentation-field-value () - "Test `snakemake-indent-line' on field value line." - - ;; Always indent line below naked field key to - ;; `snakemake-indent-field-offset' + - ;; `snakemake-indent-value-offset'. Move point to to this position - ;; as well if it is before any text on the line. - (should - (string= - " -rule abc: - output: - " - (snakemake-with-temp-text - " -rule abc: - output: -" - (snakemake-indent-line) - (buffer-string)))) - (should - (string= - " -rule abc: - output: - " - (snakemake-with-temp-text - " -rule abc: - output: -" - (snakemake-indent-line) - (snakemake-indent-line) - (buffer-string)))) - (should - (string= - " -rule abc: - output: - " - (snakemake-with-temp-text - " -rule abc: - output: - " - (snakemake-indent-line) - (buffer-string)))) - - ;; Add step with Python indentation for non-blank lines under naked - ;; field keys. Field keys with values starting on the same line do - ;; not use Python indentation because this is invalid syntax in - ;; Snakemake. - (should - (string= - " -rule abc: - output: 'file{}{}'.format('one', - 'two'" - (snakemake-with-temp-text - " -rule abc: - output: 'file{}{}'.format('one', -'two'" - (snakemake-indent-line) - (buffer-string)))) - (should - (string= - " -rule abc: - output: - 'file{}{}'.format('one', - 'two'" - (snakemake-with-temp-text - " -rule abc: - output: - 'file{}{}'.format('one', -'two'" - (snakemake-indent-line) - (buffer-string)))) - (should - (string= - " -rule abc: - output: - 'file{}{}'.format('one', - " - (snakemake-with-temp-text - " -rule abc: - output: - 'file{}{}'.format('one', -" - (snakemake-indent-line) - (buffer-string)))) - - ;; On non-naked field key cycle indentation between - ;; `snakemake-indent-field-offset' and column of previous field - ;; value. If point is before any text on the line, move it to the - ;; start of the text instead. - (should - (string= - " -rule abc: - output: 'file' - " - (snakemake-with-temp-text - " -rule abc: - output: 'file' -" - (snakemake-indent-line) - (buffer-string)))) - (should - (string= - " -rule abc: - output: 'file' - " - (snakemake-with-temp-text - " -rule abc: - output: 'file' -" - (snakemake-indent-line) - (snakemake-indent-line) - (buffer-string)))) - (should - (string= - " -rule abc: - output: 'file' - " - (snakemake-with-temp-text - " -rule abc: - output: 'file' -" - (snakemake-indent-line) - (snakemake-indent-line) - (snakemake-indent-line) - (buffer-string)))) - (should - (string= - " -rule abc: - output: 'file' - 'text'" - (snakemake-with-temp-text - " -rule abc: - output: 'file' -'text'" - (snakemake-indent-line) - (buffer-string)))) - (should - (string= - " -rule abc: - output: 'file' - 'text'" - (snakemake-with-temp-text - " -rule abc: - output: 'file' -'text'" - (snakemake-indent-line) - (snakemake-indent-line) - (buffer-string)))) - (should - (string= - " -rule abc: - output: 'file' - 'text' " - (snakemake-with-temp-text - " -rule abc: - output: 'file' -'text' " - (snakemake-indent-line) - (buffer-string)))) - (should - (string= - " -rule abc: - output: 'file' - " - (snakemake-with-temp-text - " -rule abc: - output: 'file' - 'text'" - (snakemake-indent-line) - (buffer-substring (point-min) (point))))) - (should - (string= - " -rule abc: - output: 'file' - 'text'" - (snakemake-with-temp-text - " -rule abc: - output: 'file' - 'text'" - (snakemake-indent-line) - (snakemake-indent-line) - (buffer-string)))) - - ;; Indent body of run field according to Python mode. - (should - (string= - " -rule abc: - run: - with this: - " - (snakemake-with-temp-text - " -rule abc: - run: - with this: -" - (snakemake-indent-line) - (buffer-string))))) - - -;;; Other - -(ert-deftest test-snakemake-mode/in-rule-block () - "Test `snakemake-in-rule-or-subworkflow-block-p'" - - ;; At top of block - (snakemake-with-temp-text - " -rule abc: - output: 'file'" - (should (snakemake-in-rule-or-subworkflow-block-p))) - - ;; Body of block - (snakemake-with-temp-text - " -rule abc: - output: 'file'" - (should (snakemake-in-rule-or-subworkflow-block-p))) - - ;; First blank line after - (snakemake-with-temp-text - " -rule abc: - output: 'file' -" - (should (snakemake-in-rule-or-subworkflow-block-p))) - - ;; Second blank line after - (snakemake-with-temp-text - " -rule abc: - output: 'file' - -" - (should-not (snakemake-in-rule-or-subworkflow-block-p))) - - - ;; Blank line in docstring - (snakemake-with-temp-text - " -rule abc: - \"\"\"docstring header - - docstring line - \"\"\" - output: 'file'" - (should (snakemake-in-rule-or-subworkflow-block-p))) - - ;; Before - (snakemake-with-temp-text - " -rule abc: - output: 'file'" - (should-not (snakemake-in-rule-or-subworkflow-block-p))) - - ;; Subworkflow - (snakemake-with-temp-text - " -subworkflow otherworkflow: - workdir: '../path/to/otherworkflow' - snakefile: '../path/to/otherworkflow/Snakefile'" - (should (snakemake-in-rule-or-subworkflow-block-p)))) - -(ert-deftest test-snakemake-mode/first-field-line-p () - "Test `snakemake-first-field-line-p'." - (snakemake-with-temp-text - " -rule abc: -" - (should (snakemake-first-field-line-p))) - (snakemake-with-temp-text - " -rule abc: - output: 'file'" - (should (snakemake-first-field-line-p))) - (snakemake-with-temp-text - " -rule abc: - output: -" - (should-not (snakemake-first-field-line-p)))) - -(ert-deftest test-snakemake-mode/below-naked-field-p () - "Test `snakemake-below-naked-field-p'." - (snakemake-with-temp-text - " -rule abc: - output: -" - (should (snakemake-below-naked-field-p))) - (snakemake-with-temp-text - " -rule abc: - output: 'file' -" - (should-not (snakemake-below-naked-field-p))) - (snakemake-with-temp-text - " -rule abc: - output: " - (should-not (snakemake-below-naked-field-p)))) - -(ert-deftest test-snakemake-mode/naked-field-line-p () - "Test `snakemake-naked-field-line-p'." - (snakemake-with-temp-text - " -rule abc: - output: -" - (should (snakemake-naked-field-line-p))) - (snakemake-with-temp-text - " -rule abc: - output: - 'file', - " - (should (snakemake-naked-field-line-p))) - (snakemake-with-temp-text - " -rule abc: - output: " - (should (snakemake-naked-field-line-p))) - (snakemake-with-temp-text - " -rule abc: - output: 'file' -" - (should-not (snakemake-naked-field-line-p))) - (snakemake-with-temp-text - " -rule abc: - input: - 'infile' - output: 'file' -" - (should-not (snakemake-naked-field-line-p)))) - -(ert-deftest test-snakemake-mode/run-field-line-p () - "Test `snakemake-run-field-line-p'." - (snakemake-with-temp-text - " -rule abc: - run: -" - (should (snakemake-run-field-line-p))) - (snakemake-with-temp-text - " -rule abc: - run: - with file: -" - (should (snakemake-run-field-line-p))) - (snakemake-with-temp-text - " -rule abc: - output: 'file' -" - (should-not (snakemake-run-field-line-p)))) - -(ert-deftest test-snakemake-mode/previous-field-value-column () - "Test `snakemake-previous-field-value-column'." - (should (= 12 - (snakemake-with-temp-text - " -rule abc: - output: 'file' -" - (snakemake-previous-field-value-column)))) - (should (= 12 - (snakemake-with-temp-text - " -rule abc: - output: 'file', - 'another' -" - (snakemake-previous-field-value-column))))) - - -(provide 'test-snakemake-mode) -;;; test-snakemake-mode.el ends here diff --git a/test-snakemake.el b/test-snakemake.el new file mode 100644 index 0000000..03cf1f1 --- /dev/null +++ b/test-snakemake.el @@ -0,0 +1,752 @@ +;;; test-snakemake.el --- Tests for snakemake{,-mode}.el + +;; Copyright (C) 2015-2016 Kyle Meyer + +;; Author: Kyle Meyer + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'snakemake-mode) +(require 'snakemake) +(require 'ert) + +;; This is modified from `org-tests.el' (55c0708). +(defmacro snakemake-with-temp-text (text &rest body) + "Run body in a temporary Snakemake mode buffer. + +Fill the buffer with TEXT. If the string \"\" appears in +TEXT then remove it and place the point there before running +BODY, otherwise place the point at the beginning of the inserted +text. + +Also, mute messages." + (declare (indent 1)) + `(cl-letf (((symbol-function 'message) (lambda (&rest args) nil))) + (let ((inside-text (if (stringp ,text) ,text (eval ,text)))) + (with-temp-buffer + (snakemake-mode) + (let ((point (string-match "" inside-text))) + (if point + (progn + (insert (replace-match "" nil nil inside-text)) + (goto-char (1+ (match-beginning 0)))) + (insert inside-text) + (goto-char (point-min)))) + ,@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)) + + +;;; snakemake-mode.el + +;;;; Indentation + +(ert-deftest test-snakemake-mode/indentation-at-rule-block () + "Test `snakemake-indent-line' at top of rule block." + + ;; Always shift first line of block to column 0. + (should + (string= + "rule abc:" + (snakemake-with-temp-text + "rule abc:" + (snakemake-indent-line) + (buffer-string)))) + (should + (string= + "rule abc:" + (snakemake-with-temp-text + " rule abc:" + (snakemake-indent-line) + (buffer-string)))) + + ;; Don't move point if beyond column 0. + (should + (string= + "rule abc: " + (snakemake-with-temp-text + " rule abc: " + (snakemake-indent-line) + (buffer-string)))) + (should + (string= + "rule " + (snakemake-with-temp-text + " rule abc: " + (snakemake-indent-line) + (buffer-substring (point-min) (point)))))) + +(ert-deftest test-snakemake-mode/indentation-outside-rule () + "Test `snakemake-indent-line' outside rule block." + ;; Use standard Python mode indentation outside of rule blocks. + (should + (string= + " +def ok(): + " + (snakemake-with-temp-text + " +def ok(): +" + (snakemake-indent-line) + (buffer-string))))) + +(ert-deftest test-snakemake-mode/indentation-field-key () + "Test `snakemake-indent-line' on field key line." + + ;; Always indent first line to `snakemake-indent-field-offset'. + ;; Move point to `snakemake-indent-field-offset' if it is before any + ;; text on the line. + (should + (string= + " +rule abc: + " + (snakemake-with-temp-text + " +rule abc: +" + (snakemake-indent-line) + (buffer-string)))) + (should + (string= + " +rule abc: + " + (snakemake-with-temp-text + " +rule abc: +" + (snakemake-indent-line) + (snakemake-indent-line) + (buffer-string)))) + (should + (string= + " +rule abc: + text" + (snakemake-with-temp-text + " +rule abc: +text" + (snakemake-indent-line) + (buffer-substring (point-min) (point))))) + (should + (string= + " +rule abc: + te" + (snakemake-with-temp-text + " +rule abc: +text" + (snakemake-indent-line) + (buffer-substring (point-min) (point))))) + + ;; Always indent field key to `snakemake-indent-field-offset'. + ;; Move point to `snakemake-indent-field-offset' if it is before any + ;; text on the line. + (should + (string= + " +rule abc: + input: 'infile' + output:" + (snakemake-with-temp-text + " +rule abc: + input: 'infile' +output:" + (snakemake-indent-line) + (buffer-string)))) + (should + (string= + " +rule abc: + input: 'infile' + output:" + (snakemake-with-temp-text + " +rule abc: + input: 'infile' +output:" + (snakemake-indent-line) + (snakemake-indent-line) + (buffer-string)))) + (should + (string= + " +rule abc: + input: 'infile' + output: " + (snakemake-with-temp-text + " +rule abc: + input: 'infile' +output: " + (snakemake-indent-line) + (buffer-string)))) + (should + (string= + " +rule abc: + input: 'infile' + " + (snakemake-with-temp-text + " +rule abc: + input: 'infile' + output:" + (snakemake-indent-line) + (buffer-substring (point-min) (point)))))) + +(ert-deftest test-snakemake-mode/indentation-field-value () + "Test `snakemake-indent-line' on field value line." + + ;; Always indent line below naked field key to + ;; `snakemake-indent-field-offset' + + ;; `snakemake-indent-value-offset'. Move point to to this position + ;; as well if it is before any text on the line. + (should + (string= + " +rule abc: + output: + " + (snakemake-with-temp-text + " +rule abc: + output: +" + (snakemake-indent-line) + (buffer-string)))) + (should + (string= + " +rule abc: + output: + " + (snakemake-with-temp-text + " +rule abc: + output: +" + (snakemake-indent-line) + (snakemake-indent-line) + (buffer-string)))) + (should + (string= + " +rule abc: + output: + " + (snakemake-with-temp-text + " +rule abc: + output: + " + (snakemake-indent-line) + (buffer-string)))) + + ;; Add step with Python indentation for non-blank lines under naked + ;; field keys. Field keys with values starting on the same line do + ;; not use Python indentation because this is invalid syntax in + ;; Snakemake. + (should + (string= + " +rule abc: + output: 'file{}{}'.format('one', + 'two'" + (snakemake-with-temp-text + " +rule abc: + output: 'file{}{}'.format('one', +'two'" + (snakemake-indent-line) + (buffer-string)))) + (should + (string= + " +rule abc: + output: + 'file{}{}'.format('one', + 'two'" + (snakemake-with-temp-text + " +rule abc: + output: + 'file{}{}'.format('one', +'two'" + (snakemake-indent-line) + (buffer-string)))) + (should + (string= + " +rule abc: + output: + 'file{}{}'.format('one', + " + (snakemake-with-temp-text + " +rule abc: + output: + 'file{}{}'.format('one', +" + (snakemake-indent-line) + (buffer-string)))) + + ;; On non-naked field key cycle indentation between + ;; `snakemake-indent-field-offset' and column of previous field + ;; value. If point is before any text on the line, move it to the + ;; start of the text instead. + (should + (string= + " +rule abc: + output: 'file' + " + (snakemake-with-temp-text + " +rule abc: + output: 'file' +" + (snakemake-indent-line) + (buffer-string)))) + (should + (string= + " +rule abc: + output: 'file' + " + (snakemake-with-temp-text + " +rule abc: + output: 'file' +" + (snakemake-indent-line) + (snakemake-indent-line) + (buffer-string)))) + (should + (string= + " +rule abc: + output: 'file' + " + (snakemake-with-temp-text + " +rule abc: + output: 'file' +" + (snakemake-indent-line) + (snakemake-indent-line) + (snakemake-indent-line) + (buffer-string)))) + (should + (string= + " +rule abc: + output: 'file' + 'text'" + (snakemake-with-temp-text + " +rule abc: + output: 'file' +'text'" + (snakemake-indent-line) + (buffer-string)))) + (should + (string= + " +rule abc: + output: 'file' + 'text'" + (snakemake-with-temp-text + " +rule abc: + output: 'file' +'text'" + (snakemake-indent-line) + (snakemake-indent-line) + (buffer-string)))) + (should + (string= + " +rule abc: + output: 'file' + 'text' " + (snakemake-with-temp-text + " +rule abc: + output: 'file' +'text' " + (snakemake-indent-line) + (buffer-string)))) + (should + (string= + " +rule abc: + output: 'file' + " + (snakemake-with-temp-text + " +rule abc: + output: 'file' + 'text'" + (snakemake-indent-line) + (buffer-substring (point-min) (point))))) + (should + (string= + " +rule abc: + output: 'file' + 'text'" + (snakemake-with-temp-text + " +rule abc: + output: 'file' + 'text'" + (snakemake-indent-line) + (snakemake-indent-line) + (buffer-string)))) + + ;; Indent body of run field according to Python mode. + (should + (string= + " +rule abc: + run: + with this: + " + (snakemake-with-temp-text + " +rule abc: + run: + with this: +" + (snakemake-indent-line) + (buffer-string))))) + +;;;; Other + +(ert-deftest test-snakemake-mode/in-rule-block () + "Test `snakemake-in-rule-or-subworkflow-block-p'" + + ;; At top of block + (snakemake-with-temp-text + " +rule abc: + output: 'file'" + (should (snakemake-in-rule-or-subworkflow-block-p))) + + ;; Body of block + (snakemake-with-temp-text + " +rule abc: + output: 'file'" + (should (snakemake-in-rule-or-subworkflow-block-p))) + + ;; First blank line after + (snakemake-with-temp-text + " +rule abc: + output: 'file' +" + (should (snakemake-in-rule-or-subworkflow-block-p))) + + ;; Second blank line after + (snakemake-with-temp-text + " +rule abc: + output: 'file' + +" + (should-not (snakemake-in-rule-or-subworkflow-block-p))) + + + ;; Blank line in docstring + (snakemake-with-temp-text + " +rule abc: + \"\"\"docstring header + + docstring line + \"\"\" + output: 'file'" + (should (snakemake-in-rule-or-subworkflow-block-p))) + + ;; Before + (snakemake-with-temp-text + " +rule abc: + output: 'file'" + (should-not (snakemake-in-rule-or-subworkflow-block-p))) + + ;; Subworkflow + (snakemake-with-temp-text + " +subworkflow otherworkflow: + workdir: '../path/to/otherworkflow' + snakefile: '../path/to/otherworkflow/Snakefile'" + (should (snakemake-in-rule-or-subworkflow-block-p)))) + +(ert-deftest test-snakemake-mode/first-field-line-p () + "Test `snakemake-first-field-line-p'." + (snakemake-with-temp-text + " +rule abc: +" + (should (snakemake-first-field-line-p))) + (snakemake-with-temp-text + " +rule abc: + output: 'file'" + (should (snakemake-first-field-line-p))) + (snakemake-with-temp-text + " +rule abc: + output: +" + (should-not (snakemake-first-field-line-p)))) + +(ert-deftest test-snakemake-mode/below-naked-field-p () + "Test `snakemake-below-naked-field-p'." + (snakemake-with-temp-text + " +rule abc: + output: +" + (should (snakemake-below-naked-field-p))) + (snakemake-with-temp-text + " +rule abc: + output: 'file' +" + (should-not (snakemake-below-naked-field-p))) + (snakemake-with-temp-text + " +rule abc: + output: " + (should-not (snakemake-below-naked-field-p)))) + +(ert-deftest test-snakemake-mode/naked-field-line-p () + "Test `snakemake-naked-field-line-p'." + (snakemake-with-temp-text + " +rule abc: + output: +" + (should (snakemake-naked-field-line-p))) + (snakemake-with-temp-text + " +rule abc: + output: + 'file', + " + (should (snakemake-naked-field-line-p))) + (snakemake-with-temp-text + " +rule abc: + output: " + (should (snakemake-naked-field-line-p))) + (snakemake-with-temp-text + " +rule abc: + output: 'file' +" + (should-not (snakemake-naked-field-line-p))) + (snakemake-with-temp-text + " +rule abc: + input: + 'infile' + output: 'file' +" + (should-not (snakemake-naked-field-line-p)))) + +(ert-deftest test-snakemake-mode/run-field-line-p () + "Test `snakemake-run-field-line-p'." + (snakemake-with-temp-text + " +rule abc: + run: +" + (should (snakemake-run-field-line-p))) + (snakemake-with-temp-text + " +rule abc: + run: + with file: +" + (should (snakemake-run-field-line-p))) + (snakemake-with-temp-text + " +rule abc: + output: 'file' +" + (should-not (snakemake-run-field-line-p)))) + +(ert-deftest test-snakemake-mode/previous-field-value-column () + "Test `snakemake-previous-field-value-column'." + (should (= 12 + (snakemake-with-temp-text + " +rule abc: + output: 'file' +" + (snakemake-previous-field-value-column)))) + (should (= 12 + (snakemake-with-temp-text + " +rule abc: + output: 'file', + 'another' +" + (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))))) + +(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 -- cgit v1.2.3