Merge branch 'master' into core-updates-frozen

[jackhill/guix/guix.git] / guix / build-system / dune.scm

diff --git a/guix/build-system/dune.scm b/guix/build-system/dune.scm
index 5b33ef6..12100fd 100644 (file)
--- a/guix/build-system/dune.scm
+++ b/guix/build-system/dune.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2017 Ben Woodcroft <donttrustben@gmail.com>
+;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 pukkamustard <pukkamustard@posteo.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -21,7 +22,7 @@
 (define-module (guix build-system dune)
   #:use-module (guix store)
   #:use-module (guix utils)
-  #:use-module (guix derivations)
+  #:use-module (guix gexp)
   #:use-module (guix search-paths)
   #:use-module (guix build-system)
   #:use-module ((guix build-system gnu) #:prefix gnu:)
@@ -72,7 +73,7 @@
            "--profile" "release")))
 
   (define private-keywords
-    '(#:source #:target #:dune #:findlib #:ocaml #:inputs #:native-inputs))
+    '(#:target #:dune #:findlib #:ocaml #:inputs #:native-inputs))
 
   (and (not target)                               ;XXX: no cross-compilation
        (let ((base (ocaml:lower name
@@ -94,8 +95,9 @@
                        `(#:dune-release-flags ,dune-release-flags)
                        (strip-keyword-arguments private-keywords arguments)))))))
 
-(define* (dune-build store name inputs
-                     #:key (guile #f)
+(define* (dune-build name inputs
+                     #:key
+                     guile source
                      (outputs '("out"))
                      (search-paths '())
                      (build-flags ''())
@@ -122,51 +124,40 @@
   "Build SOURCE using OCAML, and with INPUTS. This assumes that SOURCE
 provides a 'setup.ml' file as its build system."
   (define builder
-    `(begin
-       (use-modules ,@modules)
-       (dune-build #:source ,(match (assoc-ref inputs "source")
-                               (((? derivation? source))
-                                (derivation->output-path source))
-                               ((source)
-                                source)
-                               (source
-                                source))
-                   #:system ,system
-                   #:outputs %outputs
-                   #:inputs %build-inputs
-                   #:search-paths ',(map search-path-specification->sexp
-                                         search-paths)
-                   #:phases ,phases
-                   #:test-flags ,test-flags
-                   #:build-flags ,build-flags
-                   #:out-of-source? ,out-of-source?
-                   #:jbuild? ,jbuild?
-                   #:package ,package
-                   #:dune-release-flags ,dune-release-flags
-                   #:tests? ,tests?
-                   #:test-target ,test-target
-                   #:install-target ,install-target
-                   #:validate-runpath? ,validate-runpath?
-                   #:patch-shebangs? ,patch-shebangs?
-                   #:strip-binaries? ,strip-binaries?
-                   #:strip-flags ,strip-flags
-                   #:strip-directories ,strip-directories)))
+    (with-imported-modules imported-modules
+      #~(begin
+          (use-modules #$@modules)
+          (dune-build #:source #$source
+                      #:system #$system
+                      #:outputs (list #$@(map (lambda (name)
+                                                #~(cons #$name
+                                                        (ungexp output name)))
+                                              outputs))
+                      #:inputs (map (lambda (tuple)
+                                      (apply cons tuple))
+                                    '#$inputs)
+                      #:search-paths '#$(map search-path-specification->sexp
+                                             search-paths)
+                      #:phases #$phases
+                      #:test-flags #$test-flags
+                      #:build-flags #$build-flags
+                      #:out-of-source? #$out-of-source?
+                      #:jbuild? #$jbuild?
+                      #:package #$package
+                      #:dune-release-flags #$dune-release-flags
+                      #:tests? #$tests?
+                      #:test-target #$test-target
+                      #:install-target #$install-target
+                      #:validate-runpath? #$validate-runpath?
+                      #:patch-shebangs? #$patch-shebangs?
+                      #:strip-binaries? #$strip-binaries?
+                      #:strip-flags #$strip-flags
+                      #:strip-directories #$strip-directories))))
 
-  (define guile-for-build
-    (match guile
-      ((? package?)
-       (package-derivation store guile system #:graft? #f))
-      (#f                                         ; the default
-       (let* ((distro (resolve-interface '(gnu packages commencement)))
-              (guile  (module-ref distro 'guile-final)))
-         (package-derivation store guile system #:graft? #f)))))
-
-  (build-expression->derivation store name builder
-                                #:system system
-                                #:inputs inputs
-                                #:modules imported-modules
-                                #:outputs outputs
-                                #:guile-for-build guile-for-build))
+  (gexp->derivation name builder
+                    #:system system
+                    #:target #f
+                    #:guile-for-build guile))
 
 (define dune-build-system
   (build-system