guix build: Modularize transformation handling.

* guix/scripts/build.scm (options/resolve-packages): Remove.
(options->things-to-build, transform-package-source): New procedure.
(%transformations): New variable.
(options->transformation): New procedure.
(options->derivations): Rewrite to use 'options->things-to-build' and
'options->transformation'.

guix/scripts/build.scm

@@ -383,9 +383,40 @@ must be one of 'package', 'all', or 'transitive'~%")
 
          %standard-build-options))
 
+(define (options->things-to-build opts)
+  "Read the arguments from OPTS and return a list of high-level objects to
+build---packages, gexps, derivations, and so on."
+  (define ensure-list
+    (match-lambda
+      ((x ...) x)
+      (x       (list x))))
+
+  (append-map (match-lambda
+                (('argument . (? string? spec))
+                 (cond ((derivation-path? spec)
+                        (list (call-with-input-file spec read-derivation)))
+                       ((store-path? spec)
+                        ;; Nothing to do; maybe for --log-file.
+                        '())
+                       (else
+                        (list (specification->package spec)))))
+                (('file . file)
+                 (ensure-list (load* file (make-user-module '()))))
+                (('expression . str)
+                 (ensure-list (read/eval str)))
+                (('argument . (? derivation? drv))
+                 drv)
+                (('argument . (? derivation-path? drv))
+                 (list ))
+                (_ '()))
+              opts))
+
 (define (options->derivations store opts)
   "Given OPTS, the result of 'args-fold', return a list of derivations to
 build."
+  (define transform
+    (options->transformation opts))
+
   (define package->derivation
     (match (assoc-ref opts 'target)
       (#f package-derivation)
@@ -393,86 +424,51 @@ build."
        (cut package-cross-derivation <> <> triplet <>))))
 
   (define src    (assoc-ref opts 'source))
-  (define sys    (assoc-ref opts 'system))
+  (define system (assoc-ref opts 'system))
   (define graft? (assoc-ref opts 'graft?))
 
   (parameterize ((%graft? graft?))
-    (let ((opts (options/with-source store
+    (append-map (match-lambda
-                                     (options/resolve-packages store opts))))
+                  ((? package? p)
-      (concatenate
-       (filter-map (match-lambda
-                    (('argument . (? package? p))
                    (match src
                      (#f
-                        (list (package->derivation store p sys)))
+                      (list (package->derivation store p system)))
                      (#t
                       (let ((s (package-source p)))
                         (list (package-source-derivation store s))))
                      (proc
                       (map (cut package-source-derivation store <>)
                            (proc p)))))
-                    (('argument . (? derivation? drv))
+                  ((? derivation? drv)
                    (list drv))
-                    (('argument . (? derivation-path? drv))
-                     (list (call-with-input-file drv read-derivation)))
-                    (('argument . (? store-path?))
-                     ;; Nothing to do; maybe for --log-file.
-                     #f)
-                    (_ #f))
-                   opts)))))
-
-(define (options/resolve-packages store opts)
-  "Return OPTS with package specification strings replaced by actual
-packages."
-  (define system
-    (or (assoc-ref opts 'system) (%current-system)))
-
-  (define (object->argument obj)
-    (match obj
-      ((? package? p)
-       `(argument . ,p))
                   ((? procedure? proc)
-       (let ((drv (run-with-store store
+                   (list (run-with-store store
                            (mbegin %store-monad
                              (set-guile-for-build (default-guile))
                              (proc))
                            #:system system)))
-         `(argument . ,drv)))
                   ((? gexp? gexp)
-       (let ((drv (run-with-store store
+                   (list (run-with-store store
                            (mbegin %store-monad
                              (set-guile-for-build (default-guile))
                              (gexp->derivation "gexp" gexp
-                                        #:system system)))))
+                                               #:system system))))))
-         `(argument . ,drv)))))
+                (transform store (options->things-to-build opts)))))
 
-  (map (match-lambda
+(define (transform-package-source sources)
-        (('argument . (? string? spec))
+  "Return a transformation procedure that uses replaces package sources with
-         (if (store-path? spec)
+the matching URIs given in SOURCES."
-             `(argument . ,spec)
-             `(argument . ,(specification->package spec))))
-        (('file . file)
-         (object->argument (load* file (make-user-module '()))))
-        (('expression . str)
-         (object->argument (read/eval str)))
-        (opt opt))
-       opts))
-
-(define (options/with-source store opts)
-  "Process with 'with-source' options in OPTS, replacing the relevant package
-arguments with packages that use the specified source."
   (define new-sources
-    (filter-map (match-lambda
+    (map (lambda (uri)
-                 (('with-source . uri)
            (cons (package-name->name+version (basename uri))
                  uri))
-                 (_ #f))
+         sources))
-                opts))
 
-  (let loop ((opts    opts)
+  (lambda (store packages)
+    (let loop ((packages packages)
                (sources  new-sources)
                (result   '()))
-    (match opts
+      (match packages
         (()
          (unless (null? sources)
            (warning (_ "sources do not match any package:~{ ~a~}~%")
@@ -480,19 +476,38 @@ arguments with packages that use the specified source."
                       (((name . uri) ...)
                        uri))))
          (reverse result))
-      ((('argument . (? package? p)) tail ...)
+        (((? package? p) tail ...)
          (let ((source (assoc-ref sources (package-name p))))
            (loop tail
                  (alist-delete (package-name p) sources)
-               (alist-cons 'argument
+                 (cons (if source
-                           (if source
                            (package-with-source store p source)
                            p)
                        result))))
-      ((('with-source . _) tail ...)
+        ((thing tail ...)
-       (loop tail sources result))
+         (loop tail sources result))))))
-      ((head tail ...)
+
-       (loop tail sources (cons head result))))))
+(define %transformations
+  ;; Transformations that can be applied to things to build.  The car is the
+  ;; key used in the option alist, and the cdr is the transformation
+  ;; procedure; it is called with two arguments: the store, and a list of
+  ;; things to build.
+  `((with-source . ,transform-package-source)))
+
+(define (options->transformation opts)
+  "Return a procedure that, when passed a list of things to build (packages,
+derivations, etc.), applies the transformations specified by OPTS."
+  (apply compose
+         (map (match-lambda
+                ((key . transform)
+                 (let ((args (filter-map (match-lambda
+                                           ((k . arg)
+                                            (and (eq? k key) arg)))
+                                         opts)))
+                   (if (null? args)
+                       (lambda (store things) things)
+                       (transform args)))))
+              %transformations)))
 
 (define (show-build-log store file urls)
   "Show the build log for FILE, falling back to remote logs from URLS if