aboutsummaryrefslogtreecommitdiff
path: root/ccwl/cwl.scm
blob: b4a60259e9954d93585d4cd69e9686c54d7bf62f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
;;; ccwl --- Concise Common Workflow Language
;;; Copyright © 2021, 2023 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/>.

;;; Commentary:

;; This file implements conversion from ccwl objects (<workflow>,
;; <command>, <input>, <output>, <step>) to CWL YAML.

;;; Code:

(define-module (ccwl cwl)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 match)
  #:use-module (ccwl ccwl)
  #:use-module (ccwl utils)
  #:use-module (ccwl yaml)
  #:export (workflow->cwl
            command->cwl
            workflow-or-command->cwl))

(define %cwl-version "v1.2")

(define workflow-or-command->cwl
  (match-lambda*
    (((? workflow? workflow) port)
     (workflow->cwl workflow port))
    (((? command? command) port)
     (command->cwl command port))))

(define (workflow->cwl workflow port)
  "Render WORKFLOW, a <workflow> object, to PORT as a CWL YAML
specification."
  (scm->yaml (workflow->cwl-scm workflow)
             port))

(define (filter-alist alist)
  "Filter ALIST removing entries with #f as the value. If the
resulting association list is empty, return #f. Else, return that
association list."
  (match (filter (match-lambda
                   ((_ . #f) #f)
                   (_ #t))
                 alist)
    (() #f)
    (result result)))

(define* (workflow->cwl-scm workflow)
  "Render WORKFLOW, a <workflow> object, into a CWL tree."
  `((cwlVersion . ,%cwl-version)
    (class . Workflow)
    (requirements . ((SubworkflowFeatureRequirement)
                     ,@(if (every (compose null? step-scattered-inputs)
                                  (workflow-steps workflow))
                           '()
                           '((ScatterFeatureRequirement)))))
    ,@(workflow-other workflow)
    (inputs . ,(map input->cwl-scm
                    (workflow-inputs workflow)))
    (outputs . ,(map (cut output->cwl-scm <> #:workflow? #t)
                     (workflow-outputs workflow)))
    (steps . ,(map (lambda (step)
                     `(,(step-id step)
                       (in . ,(map (lambda (in)
                                     (match in
                                       ((id . (? string? source))
                                        in)
                                       ((id . (? input? input))
                                        (cons id (input-id input)))))
                                   (step-in step)))
                       (out . ,(list->vector (map output-id (step-out step))))
                       (run . ,(match (step-run step)
                                 ((? command? command)
                                  (command->cwl-scm command))
                                 ((? cwl-workflow? cwl-workflow)
                                  (cwl-workflow-file cwl-workflow))
                                 ((? workflow? workflow)
                                  (workflow->cwl-scm workflow))
                                 (tree tree)))
                       ,@(match (step-scattered-inputs step)
                           (() '())
                           (scattered-inputs
                            `((scatter . ,(list->vector scattered-inputs))
                              (scatterMethod . ,(step-scatter-method step)))))))
                   (workflow-steps workflow)))))

(define (type->cwl type)
  "Render @var{type} into a CWL tree."
  (if (array-type? type)
      `((type . array)
        (items . ,(type->cwl (array-type-member-type type))))
      type))

(define* (output->cwl-scm output #:key workflow?)
  "Render @var{output}, a @code{<output>} object, into a CWL tree. If
@var{workflow?} is @code{#t}, this is a workflow output."
  `(,(output-id output)
    ,@(or (filter-alist
           `((type . ,(type->cwl (output-type output)))
             ;; outputBinding is relevant only to commands, and
             ;; outputSource is relevant only to workflows.
             ,@(if workflow?
                   `((outputSource . ,(match (output-source output)
                                        ((? string? source) source)
                                        ((? input? input) (input-id input)))))
                   `((outputBinding . ,(output-binding output))))))
          '())
    ,@(output-other output)))

(define (command->cwl command port)
  "Render @var{command}, a @code{<command>} object, to @var{port} as a
CWL YAML specification."
  (scm->yaml (command->cwl-scm command)
             port))

(define (input->cwl-scm input)
  "Render @var{input}, a @code{<input>} object, into a CWL tree."
  `(,(input-id input)
    (type . ,(type->cwl (input-type input)))
    ,@(or (filter-alist
           `((label . ,(input-label input))
             (default . ,(and (not (unspecified-default? (input-default input)))
                              (input-default input)))
             ;; inputBinding is only relevant to commands, not
             ;; workflows. But, the input position and prefix are not set
             ;; for worklow inputs and therefore this sub-expression has
             ;; no effect. So, leave this be.
             (inputBinding . ,(filter-alist
                               `((position . ,(input-position input))
                                 (prefix . ,(input-prefix input))
                                 (itemSeparator . ,(input-separator input)))))))
          '())
    ,@(input-other input)))

(define (command->cwl-scm command)
  "Render COMMAND, a <command> object, into a CWL tree."
  `((cwlVersion . ,%cwl-version)
    (class . CommandLineTool)
    (requirements
     ,@(if (any input-stage? (command-inputs command))
           ;; Stage any inputs that need to be.
           `((InitialWorkDirRequirement
              (listing . ,(list->vector
                           (filter-map (lambda (input)
                                         (and (input-stage? input)
                                              (string-append "$(inputs."
                                                             (symbol->string (input-id input))
                                                             ")")))
                                       (command-inputs command))))))
           '())
     ,@(command-requirements command))
    ,@(command-other command)
    (arguments . ,(list->vector
                   ;; Put string arguments into the arguments array.
                   (filter-mapi (lambda (arg index)
                                  (and (string? arg)
                                       `((position . ,index)
                                         (valueFrom . ,arg))))
                                (command-args command))))
    (inputs . ,(map input->cwl-scm
                    (command-inputs command)))
    (outputs . ,(map output->cwl-scm (command-outputs command)))
    ,@(if (command-stdin command)
          `((stdin . ,(string-append "$(inputs."
                                     (symbol->string
                                      (command-stdin command))
                                     ".path)")))
          '())
    ,@(if (command-stderr command)
          `((stderr . ,(command-stderr command)))
          '())
    ,@(if (command-stdout command)
          `((stdout . ,(command-stdout command)))
          '())))