base: Use inner definitions instead of big anonymous procedures.

* src/cuirass/base.scm (build-packages, process-specs): Use an inner
definition instead of a big anonymous procedure.

1 files changed, 48 insertions, 46 deletions

diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 005632f..1deb389 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -123,52 +123,54 @@ if required."
 
 (define (build-packages store db jobs)
   "Build JOBS and return a list of Build results."
-  (map (λ (job)
-         (let* ((name     (assq-ref job #:job-name))
-                (drv      (assq-ref job #:derivation))
-                (eval-id  (assq-ref job #:eval-id))
-                (success? #t)
-                (error-log (string-append (%package-cachedir) "/"
-                                          name ".log")))
-           (simple-format #t "building ~A...\n" drv)
-           (let ((log (call-with-output-string
-                        (λ (port)
-                          (parameterize ((current-build-output-port port))
-                            (catch 'srfi-34
-                              (λ ()
-                                (build-derivations store (list drv)))
-                              (λ (key . args)
-                                (set! success? #f)
-                                (pk "kets key:" key "args:" args))))))))
-             (when (not success?)
-               (with-output-to-file error-log
-                 (lambda () (display log)))
-               (simple-format #t "build failed: ~a\n" error-log))
-             (let* ((output (and success? (derivation-path->output-path drv)))
-                    (log    (if success? (log-file store output) error-log))
-                    (build  `((#:derivation . ,drv)
-                              (#:eval-id . ,eval-id)
-                              (#:log . ,log)
-                              (#:output . ,output))))
-               (db-add-build db build)
-               (simple-format #t "~A\n" output)
-               build))))
-       jobs))
+  (define (build job)
+    (let* ((name     (assq-ref job #:job-name))
+           (drv      (assq-ref job #:derivation))
+           (eval-id  (assq-ref job #:eval-id))
+           (success? #t)
+           (error-log (string-append (%package-cachedir) "/"
+                                     name ".log")))
+      (simple-format #t "building ~A...\n" drv)
+      (let ((log (call-with-output-string
+                   (λ (port)
+                     (parameterize ((current-build-output-port port))
+                       (catch 'srfi-34
+                         (λ ()
+                           (build-derivations store (list drv)))
+                         (λ (key . args)
+                           (set! success? #f)
+                           (pk "kets key:" key "args:" args))))))))
+        (when (not success?)
+          (with-output-to-file error-log
+            (λ () (display log)))
+          (simple-format #t "build failed: ~a\n" error-log))
+        (let* ((output (and success? (derivation-path->output-path drv)))
+               (log    (if success? (log-file store output) error-log))
+               (build  `((#:derivation . ,drv)
+                         (#:eval-id . ,eval-id)
+                         (#:log . ,log)
+                         (#:output . ,output))))
+          (db-add-build db build)
+          (simple-format #t "~A\n" output)
+          build))))
+
+  (map build jobs))
 
 (define (process-specs db jobspecs)
   "Evaluate and build JOBSPECS and store results in DB."
-  (for-each (λ (spec)
-              (let ((commit (fetch-repository spec))
-                    (stamp  (db-get-stamp db spec)))
-                (unless (string=? commit stamp)
-                  (unless (assq-ref spec #:no-compile?)
-                    (compile (string-append (%package-cachedir) "/"
-                                            (assq-ref spec #:name))))
-                  (with-store store
-                    (let* ((spec* (acons #:current-commit commit spec))
-                           (jobs  (evaluate store db spec*)))
-                      (unless (%use-substitutes?)
-                        (set-build-options store #:use-substitutes? #f))
-                      (build-packages store db jobs))))
-                (db-add-stamp db spec commit)))
-            jobspecs))
+  (define (process spec)
+    (let ((commit (fetch-repository spec))
+          (stamp  (db-get-stamp db spec)))
+      (unless (string=? commit stamp)
+        (unless (assq-ref spec #:no-compile?)
+          (compile (string-append (%package-cachedir) "/"
+                                  (assq-ref spec #:name))))
+        (with-store store
+          (let* ((spec* (acons #:current-commit commit spec))
+                 (jobs  (evaluate store db spec*)))
+            (unless (%use-substitutes?)
+              (set-build-options store #:use-substitutes? #f))
+            (build-packages store db jobs))))
+      (db-add-stamp db spec commit)))
+
+  (for-each process jobspecs))