;;; ccwl --- Concise Common Workflow Language
;;; Copyright © 2021–2024 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of ccwl.
;;;
;;; ccwl 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.
;;;
;;; ccwl 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 ccwl. If not, see <https://www.gnu.org/licenses/>.
(use-modules (rnrs exceptions)
(srfi srfi-1)
(srfi srfi-64)
(srfi srfi-71)
(ccwl ccwl)
(ccwl conditions))
(define input
(@@ (ccwl ccwl) input))
(define output
(@@ (ccwl ccwl) output))
(define make-array-type
(@@ (ccwl ccwl) make-array-type))
(define key
(@@ (ccwl ccwl) key))
(define collect-steps
(@@ (ccwl ccwl) collect-steps))
(define-syntax construct-type-syntax-wrapper
(lambda (x)
(syntax-case x ()
((_ type-spec)
((@@ (ccwl ccwl) construct-type-syntax)
#'type-spec)))))
(define-syntax-rule (test-condition test-name condition-predicate test-expression)
(test-assert test-name
(guard (condition
(else (condition-predicate condition)))
(begin test-expression
#f))))
(define (ccwl-violation-with-message? message)
(lambda (condition)
(and (ccwl-violation? condition)
(string=? (formatted-message-format condition)
message))))
(test-begin "ccwl")
(test-assert "stdin input should not have inputBinding"
(not (assoc-ref
(assoc-ref
(assoc-ref
((@@ (ccwl cwl) command->cwl-scm)
(command #:inputs (file #:type File)
#:run "wc" "-c"
#:stdin file))
'inputs)
'file)
'inputBinding)))
(test-equal "read all forms of inputs and outputs from a CWL workflow"
'(((spam string))
((ham stdout)
(eggs stdout)))
(let ((cwl-workflow (cwl-workflow "tests/input-output-parameters.cwl")))
(list (map (lambda (input)
(list (input-id input)
(input-type input)))
(cwl-workflow-inputs cwl-workflow))
(map (lambda (output)
(list (output-id output)
(output-type output)))
(cwl-workflow-outputs cwl-workflow)))))
(test-condition "input, when passed more than one positional argument, must raise a &ccwl-violation condition"
ccwl-violation?
(input #'(message string)))
(test-condition "input, when passed an unrecognized keyword, must raise a &ccwl-violation condition"
ccwl-violation?
(input #'(message #:foo string)))
(test-condition "input, when passed multiple arguments to a unary keyword, must raise a &ccwl-violation condition"
ccwl-violation?
(input #'(message #:type int string)))
(test-condition "output, when passed more than one positional argument, must raise a &ccwl-violation condition"
ccwl-violation?
(output #'(message string)))
(test-condition "output, when passed an unrecognized keyword, must raise a &ccwl-violation condition"
ccwl-violation?
(output #'(message #:foo string)))
(test-condition "output, when passed multiple arguments to a unary keyword, must raise a &ccwl-violation condition"
ccwl-violation?
(output #'(message #:type int string)))
(test-condition "command, when passed positional arguments, must raise a &ccwl-violation condition"
ccwl-violation?
(macroexpand
'(command foo
#:inputs (message #:type string)
#:run "echo" message
#:outputs (stdout #:type stdout))))
(test-condition "command, when passed an unrecognized keyword, must raise a &ccwl-violation condition"
ccwl-violation?
(macroexpand
'(command #:foo (message #:type string)
#:run "echo" message
#:outputs (stdout #:type stdout))))
(test-condition "command, when passed multiple arguments to a unary keyword, must raise a &ccwl-violation condition"
ccwl-violation?
(macroexpand
'(command #:inputs (message #:type string)
#:run "echo" message
#:outputs (stdout #:type stdout)
#:stdin "foo" "bar")))
;; TODO: Define this in the lexical scope of the test that requires
;; it.
(define print
(command #:inputs (message #:type string)
#:run "echo" message
#:outputs (printed-message #:type stdout)))
(test-equal "rename should work even on the final output of a workflow"
(list 'printed-message 'out1)
(map output-id
(workflow-outputs
(workflow ((message1 #:type string)
(message2 #:type string))
(tee (pipe (print (print1) #:message message1)
(rename #:out1 printed-message))
(print (print2) #:message message2))))))
;; TODO: Define this in the lexical scope of the test that requires
;; it.
(define print-with-default
(command #:inputs (message #:type string #:default "Hello")
#:run "echo" message
#:outputs (printed-message #:type stdout)))
(test-assert "allow steps with unspecified default arguments"
(workflow ()
(print-with-default)))
(test-assert "allow steps with expressions that evaluate to commands"
(workflow ((message #:type string))
((and #t print)
(print)
#:message message)))
(test-condition "step with expression that evaluates to a command but without a step identifier must raise a &ccwl-violation condition"
ccwl-violation?
(macroexpand
'(workflow ((message #:type string))
((and #t print)
#:message message))))
(test-assert "allow literal strings as arguments"
(workflow ()
(print #:message "Hello")))
;; TODO: Define this in the lexical scope of the test that requires
;; it.
(define print-int
(command #:inputs (number #:type int)
#:run "echo" number
#:outputs (printed-number #:type stdout)))
(test-assert "allow literal ints as arguments"
(workflow ()
(print-int #:number 42)))
(test-condition "step supplied with an unknown key must raise a &ccwl-violation condition"
ccwl-violation?
(macroexpand
'(workflow ((message #:type string))
(print #:message mess))))
(test-condition "unrecognized workflow syntaxes must raise a &ccwl-violation condition"
(ccwl-violation-with-message?
"Unrecognized workflow syntax [expected (workflow (input ...) tree)]")
(macroexpand
'(workflow foo ((message #:type string))
(print #:message message))))
(test-condition "multiple expressions in workflow body must raise a &ccwl-violation condition"
(ccwl-violation-with-message?
"More than one expression ~a in workflow body. Perhaps you need to combine them with a pipe or a tee?")
(macroexpand
'(workflow ((message1 #:type string)
(message2 #:type string))
(print (print1) #:message message1)
(print (print2) #:message message2))))
(test-condition "commands with non-string #:stderr parameters must raise a &ccwl-violation condition"
(ccwl-violation-with-message?
"Invalid #:stderr parameter ~a. #:stderr parameter must be a string")
(macroexpand
'(command #:inputs (message #:type string)
#:run "echo" message
#:outputs (printed #:type stderr)
#:stderr captured-stderr)))
(test-condition "commands with non-string #:stdout parameters must raise a &ccwl-violation condition"
(ccwl-violation-with-message?
"Invalid #:stdout parameter ~a. #:stdout parameter must be a string")
(macroexpand
'(command #:inputs (message #:type string)
#:run "echo" message
#:outputs (printed #:type stdout)
#:stdout captured-stdout)))
(test-condition "command definitions with undefined inputs in their #:run arguments must raise a &ccwl-violation condition"
(ccwl-violation-with-message?
"Undefined input ~a")
(macroexpand
'(command #:inputs (number #:type int)
#:run "echo" n)))
(test-condition "command definitions with undefined prefix inputs in their #:run arguments must raise a &ccwl-violation condition"
(ccwl-violation-with-message?
"Undefined input ~a")
(macroexpand
'(command #:inputs (number #:type int)
#:run "echo" ("-x" n))))
(test-condition "command definitions with invalid #:run arguments must raise a &ccwl-violation condition"
(ccwl-violation-with-message?
"Invalid command element ~a. Command elements must either be input identifiers or literal strings.")
(macroexpand
'(command #:run "echo" 42)))
(test-assert "tolerate prefixed string arguments in command definitions"
(command #:run "echo" ("-x" "foo")))
(test-condition "command definitions with non-string prefixes in prefixed inputs must raise a &ccwl-violation condition"
(ccwl-violation-with-message?
"Invalid prefix ~a. Prefixes must be strings.")
(macroexpand
'(command #:inputs (number #:type int)
#:run "echo" (-x number))))
(test-condition "inputs with an invalid #:stage? parameter must raise a &ccwl-violation condition"
(ccwl-violation-with-message?
"Invalid #:stage? parameter ~a. #:stage? must either be #t or #f.")
(macroexpand
'(command #:inputs (file #:type File
#:stage? 42)
#:run "cat" file)))
(test-condition "inputs with #:other parameters that fail to evaluate must raise a &ccwl-violation condition"
(ccwl-violation-with-message?
"#:other parameter not serializable to YAML")
(macroexpand
'(command #:inputs (file #:type File
#:other '((secondaryFiles . ".fai")))
#:run "cat" file)))
(test-condition "outputs with #:other parameters that fail to evaluate must raise a &ccwl-violation condition"
(ccwl-violation-with-message?
"#:other parameter not serializable to YAML")
(macroexpand
'(command #:inputs (file #:type File
#:other '((secondaryFiles . ".fai")))
#:run "cat" file)))
(test-condition "commands with #:other parameters that fail to evaluate must raise a &ccwl-violation condition"
(ccwl-violation-with-message?
"#:other parameter not serializable to YAML")
(macroexpand
'(command #:run "cat" file
#:other '((secondaryFiles . ".fai")))))
(test-eq "construct-type-syntax on primitive types"
'File
(construct-type-syntax-wrapper File))
(test-eq "construct-type-syntax on array types"
(make-array-type 'File)
(construct-type-syntax-wrapper (array File)))
(test-eq "construct-type-syntax on nested array types"
(make-array-type (make-array-type 'File))
(construct-type-syntax-wrapper (array (array File))))
(test-condition "rename with non-keyword arguments must raise a &ccwl-violation condition"
(ccwl-violation-with-message?
"Expected keyword (for example: #:foo, #:bar)")
(macroexpand
'(workflow ((message #:type string))
(rename (foo) #:foo message))))
(test-condition "rename with unknown key must raise a &ccwl-violation condition"
(ccwl-violation-with-message?
"Unknown key ~a. Known keys at this step are ~a.")
(macroexpand
'(workflow ((foo #:type string))
(rename #:bar foobar))))
(test-condition "commands with non-string #:separator parameters must raise a &ccwl-violation condition"
(ccwl-violation-with-message?
"Invalid #:separator parameter ~a. #:separator parameter must be a string.")
(macroexpand
'(command #:inputs (messages #:type (array string))
#:run "echo" (array messages #:separator foo))))
(test-assert "tee must deduplicate global workflow input keys"
(let ((keys steps (collect-steps #'(tee (print #:message message)
(identity))
(list (key 'message)))))
(= (length (delete-duplicates keys eq?))
(length keys))))
(test-equal "count argument positions correctly when left-flanked by prefixed string arguments"
3
;; Input `in' should be counted as position 3, not 2.
(match (command-inputs
(command #:inputs in
#:run "foo" ("--bar" "bar") in))
((in) (input-position in))))
(test-end "ccwl")
