code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
;;; Copyright © 2018, 2019 Marius Bakke <mbakke@fastmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build-system meson)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix derivations)
  #:use-module (guix search-paths)
  #:use-module (guix build-system)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system glib-or-gtk)
  #:use-module (guix packages)
  #:use-module (ice-9 match)
  #:export (%meson-build-system-modules
            meson-build-system))

;; Commentary:
;;
;; Standard build procedure for packages using Meson. This is implemented as an
;; extension of `gnu-build-system', with the option to turn on the glib/gtk
;; phases from `glib-or-gtk-build-system'.
;;
;; Code:

(define %meson-build-system-modules
  ;; Build-side modules imported by default.
  `((guix build meson-build-system)
    ;; The modules from glib-or-gtk contains the modules from gnu-build-system,
    ;; so there is no need to import that too.
    ,@%glib-or-gtk-build-system-modules))

(define (default-ninja)
  "Return the default ninja package."
  ;; Lazily resolve the binding to avoid a circular dependency.
  (let ((module (resolve-interface '(gnu packages ninja))))
    (module-ref module 'ninja)))

(define (default-meson)
  "Return the default meson package."
  ;; Lazily resolve the binding to avoid a circular dependency.
  (let ((module (resolve-interface '(gnu packages build-tools))))
    (module-ref module 'meson-for-build)))

(define* (lower name
                #:key source inputs native-inputs outputs system target
                (meson (default-meson))
                (ninja (default-ninja))
                (glib-or-gtk? #f)
                #:allow-other-keys
                #:rest arguments)
  "Return a bag for NAME."
  (define private-keywords
    `(#:source #:meson #:ninja #:inputs #:native-inputs #:outputs #:target))

  (and (not target) ;; TODO: add support for cross-compilation.
       (bag
         (name name)
         (system system)
         (build-inputs `(("meson" ,meson)
                         ("ninja" ,ninja)
                         ,@native-inputs
                         ,@inputs
                         ;; Keep the standard inputs of 'gnu-build-system'.
                         ,@(standard-packages)))
         (host-inputs (if source
                          `(("source" ,source))
                          '()))
         (outputs outputs)
         (build meson-build)
         (arguments (strip-keyword-arguments private-keywords arguments)))))

(define* (meson-build store name inputs
                      #:key (guile #f)
                      (outputs '("out"))
                      (configure-flags ''())
                      (search-paths '())
                      (build-type "debugoptimized")
                      (tests? #t)
                      (test-target "test")
                      (glib-or-gtk? #f)
                      (parallel-build? #t)
                      (parallel-tests? #f)
                      (validate-runpath? #t)
                      (patch-shebangs? #t)
                      (strip-binaries? #t)
                      (strip-flags ''("--strip-debug"))
                      (strip-directories ''("lib" "lib64" "libexec"
                                            "bin" "sbin"))
                      (elf-directories ''("lib" "lib64" "libexec"
                                          "bin" "sbin"))
                      (phases '(@ (guix build meson-build-system)
                                  %standard-phases))
                      (system (%current-system))
                      (imported-modules %meson-build-system-modules)
                      (modules '((guix build meson-build-system)
                                 (guix build utils)))
                      allowed-references
                      disallowed-references)
  "Build SOURCE using MESON, and with INPUTS, assuming that SOURCE
has a 'meson.build' file."

  ;; TODO: Copied from build-system/gnu, factorize this!
  (define canonicalize-reference
    (match-lambda
     ((? package? p)
      (derivation->output-path (package-derivation store p system
                                                   #:graft? #f)))
     (((? package? p) output)
      (derivation->output-path (package-derivation store p system
                                                   #:graft? #f)
                               output))
     ((? string? output)
      output)))

  (define builder
    `(let ((build-phases (if ,glib-or-gtk?
                             ,phases
                             (modify-phases ,phases
                               (delete 'glib-or-gtk-compile-schemas)
                               (delete 'glib-or-gtk-wrap)))))
       (use-modules ,@modules)
       (meson-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 build-phases
                    #:configure-flags ,configure-flags
                    #:build-type ,build-type
                    #:tests? ,tests?
                    #:test-target ,test-target
                    #:parallel-build? ,parallel-build?
                    #:parallel-tests? ,parallel-tests?
                    #:validate-runpath? ,validate-runpath?
                    #:patch-shebangs? ,patch-shebangs?
                    #:strip-binaries? ,strip-binaries?
                    #:strip-flags ,strip-flags
                    #:strip-directories ,strip-directories
                    #:elf-directories ,elf-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
                                #:allowed-references
                                (and allowed-references
                                     (map canonicalize-reference
                                          allowed-references))
                                #:disallowed-references
                                (and disallowed-references
                                     (map canonicalize-reference
                                          disallowed-references))))

(define meson-build-system
  (build-system
    (name 'meson)
    (description "The standard Meson build system")
    (lower lower)))

;;; meson.scm ends here


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build-system minetest)
  #:use-module (guix build-system copy)
  #:use-module (guix build-system gnu)
  #:use-module (guix build-system)
  #:use-module (guix utils)
  #:export (minetest-mod-build-system))

;;
;; Build procedure for minetest mods.  This is implemented as an extension
;; of ‘copy-build-system’.
;;
;; Code:

;; Lazily resolve the bindings to avoid circular dependencies.
(define (default-optipng)
  ;; Lazily resolve the binding to avoid a circular dependency.
  (module-ref (resolve-interface '(gnu packages image)) 'optipng))

(define (default-minetest)
  (module-ref (resolve-interface '(gnu packages games)) 'minetest))

(define (default-xvfb-run)
  (module-ref (resolve-interface '(gnu packages xorg)) 'xvfb-run))

(define %minetest-build-system-modules
  ;; Build-side modules imported by default.
  `((guix build minetest-build-system)
    ,@%copy-build-system-modules))

(define %default-modules
  ;; Modules in scope in the build-side environment.
  '((guix build gnu-build-system)
    (guix build minetest-build-system)
    (guix build utils)))

(define (standard-minetest-packages)
  "Return the list of (NAME PACKAGE OUTPUT) or (NAME PACKAGE) tuples of
standard packages used as implicit inputs of the Minetest build system."
  `(("xvfb-run" ,(default-xvfb-run))
    ("optipng" ,(default-optipng))
    ("minetest" ,(default-minetest))
    ,@(filter (lambda (input)
                (member (car input)
                        '("libc" "tar" "gzip" "bzip2" "xz" "locales")))
              (standard-packages))))

(define* (lower-mod name #:key (implicit-inputs? #t) #:allow-other-keys
                    #:rest arguments)
  (define lower (build-system-lower gnu-build-system))
  (apply lower
         name
         (substitute-keyword-arguments arguments
           ;; minetest-mod-build-system adds implicit inputs by itself,
           ;; so don't let gnu-build-system add its own implicit inputs
           ;; as well.
           ((#:implicit-inputs? implicit-inputs? #t)
            #f)
           ((#:implicit-cross-inputs? implicit-cross-inputs? #t)
            #f)
           ((#:imported-modules imported-modules %minetest-build-system-modules)
            imported-modules)
           ((#:modules modules %default-modules)
            modules)
           ((#:phases phases '%standard-phases)
            phases)
           ;; Ensure nothing sneaks into the closure.
           ((#:allowed-references allowed-references '())
            allowed-references)
           ;; Add the implicit inputs.
           ((#:native-inputs native-inputs '())
            (if implicit-inputs?
                (append native-inputs (standard-minetest-packages))
                native-inputs)))))

(define minetest-mod-build-system
  (build-system
    (name 'minetest-mod)
    (description "The build system for minetest mods")
    (lower lower-mod)))

;;; minetest.scm ends here

repo_name: maximed/guix

license: mit


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build-system minify)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix packages)
  #:use-module (guix derivations)
  #:use-module (guix search-paths)
  #:use-module (guix build-system)
  #:use-module (guix build-system gnu)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-26)
  #:export (%minify-build-system-modules
            minify-build
            minify-build-system))

;; Commentary:
;;
;; Standard minification procedure for JavaScript files.
;;
;; Code:

(define %minify-build-system-modules
  ;; Build-side modules imported by default.
  `((guix build minify-build-system)
    ,@%gnu-build-system-modules))

(define (default-uglify-js)
  "Return the default package to minify JavaScript source files."
  ;; Lazily resolve the binding to avoid a circular dependency.
  (let ((mod (resolve-interface '(gnu packages uglifyjs))))
    (module-ref mod 'uglifyjs)))

(define* (lower name
                #:key source inputs native-inputs outputs system
                (uglify-js (default-uglify-js))
                #:allow-other-keys
                #:rest arguments)
  "Return a bag for NAME."
  (define private-keywords
    '(#:source #:target #:inputs #:native-inputs))

  (bag
    (name name)
    (system system)
    (host-inputs `(,@(if source
                         `(("source" ,source))
                         '())
                   ,@inputs
                   ,@(standard-packages)))
    (build-inputs `(("uglify-js" ,uglify-js)
                    ,@native-inputs))
    (outputs outputs)
    (build minify-build)
    (arguments (strip-keyword-arguments private-keywords arguments))))

(define* (minify-build store name inputs
                       #:key
                       (javascript-files #f)
                       (phases '(@ (guix build minify-build-system)
                                   %standard-phases))
                       (outputs '("out"))
                       (system (%current-system))
                       search-paths
                       (guile #f)
                       (imported-modules %minify-build-system-modules)
                       (modules '((guix build minify-build-system)
                                  (guix build utils))))
  "Build SOURCE with INPUTS."
  (define builder
    `(begin
       (use-modules ,@modules)
       (minify-build #:name ,name
                     #:source ,(match (assoc-ref inputs "source")
                                 (((? derivation? source))
                                  (derivation->output-path source))
                                 ((source)
                                  source)
                                 (source
                                  source))
                     #:javascript-files ,javascript-files
                     #:phases ,phases
                     #:outputs %outputs
                     #:search-paths ',(map search-path-specification->sexp
                                           search-paths)
                     #:inputs %build-inputs)))

  (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
                                #:inputs inputs
                                #:system system
                                #:modules imported-modules
                                #:outputs outputs
                                #:guile-for-build guile-for-build))

(define minify-build-system
  (build-system
    (name 'minify)
    (description "The trivial JavaScript minification build system")
    (lower lower)))

;;; minify.scm ends here


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build-system node)
  #:use-module (guix utils)
  #:use-module (guix packages)
  #:use-module (guix derivations)
  #:use-module (guix search-paths)
  #:use-module (guix build-system)
  #:use-module (guix build-system gnu)
  #:use-module (ice-9 match)
  #:export (%node-build-system-modules
            node-build
            node-build-system))

(define %node-build-system-modules
  ;; Build-side modules imported by default.
  `((guix build node-build-system)
    (guix build json)
    ,@%gnu-build-system-modules))

(define (default-node)
  "Return the default Node package."
  ;; Lazily resolve the binding to avoid a circular dependency.
  (let ((node (resolve-interface '(gnu packages node))))
    (module-ref node 'node-lts)))

(define* (lower name
                #:key source inputs native-inputs outputs system target
                (node (default-node))
                #:allow-other-keys
                #:rest arguments)
  "Return a bag for NAME."
  (define private-keywords
    '(#:source #:target #:node #:inputs #:native-inputs))

  (and (not target)                    ;XXX: no cross-compilation
       (bag
         (name name)
         (system system)
         (host-inputs `(,@(if source
                              `(("source" ,source))
                              '())
                        ,@inputs

                        ;; Keep the standard inputs of 'gnu-build-system'.
                        ,@(standard-packages)))
         (build-inputs `(("node" ,node)
                         ,@native-inputs))
         (outputs outputs)
         (build node-build)
         (arguments (strip-keyword-arguments private-keywords arguments)))))

(define* (node-build store name inputs
                     #:key
                     (test-target "test")
                     (tests? #t)
                     (phases '(@ (guix build node-build-system)
                                 %standard-phases))
                     (outputs '("out"))
                     (search-paths '())
                     (system (%current-system))
                     (guile #f)
                     (imported-modules %node-build-system-modules)
                     (modules '((guix build node-build-system)
                                (guix build utils))))
  "Build SOURCE using NODE and INPUTS."
  (define builder
    `(begin
       (use-modules ,@modules)
       (node-build #:name ,name
                   #:source ,(match (assoc-ref inputs "source")
                               (((? derivation? source))
                                (derivation->output-path source))
                               ((source) source)
                               (source source))
                   #:system ,system
                   #:test-target ,test-target
                   #:tests? ,tests?
                   #:phases ,phases
                   #:outputs %outputs
                   #:search-paths ',(map search-path-specification->sexp
                                         search-paths)
                   #:inputs %build-inputs)))

  (define guile-for-build
    (match guile
      ((? package?)
       (package-derivation store guile system #:graft? #f))
      (#f
       (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
                                #:inputs inputs
                                #:system system
                                #:modules imported-modules
                                #:outputs outputs
                                #:guile-for-build guile-for-build))

(define node-build-system
  (build-system
    (name 'node)
    (description "The Node build system")
    (lower lower)))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2017 Ben Woodcroft <donttrustben@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build-system ocaml)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix derivations)
  #:use-module (guix search-paths)
  #:use-module (guix build-system)
  #:use-module (guix build-system gnu)
  #:use-module (guix packages)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:export (%ocaml-build-system-modules
            package-with-ocaml4.07
            strip-ocaml4.07-variant
            package-with-ocaml4.09
            strip-ocaml4.09-variant
            default-findlib
            default-ocaml
            lower
            ocaml-build
            ocaml-build-system))

;; Commentary:
;;
;; Standard build procedure for packages using ocaml. This is implemented as an
;; extension of `gnu-build-system'.
;;
;; OCaml packages don't use a single standard for their build system. Some use
;; autotools, other use custom configure scripts with Makefiles, others use
;; oasis to generate the configure script and Makefile and lastly, some use
;; custom ocaml scripts.
;;
;; Each phase in the build system will try to figure out what the build system
;; is for that package. Most packages come with a custom configure script and
;; a Makefile that in turn call custom build tools. Packages built with oasis
;; will have a `setup.ml' file in the top directory, that can be used for all
;; phases. In that case the Makefile is here only to call that script. In case
;; the setup.ml do not work as expected, the @var{use-make} argument can be
;; used to ignore the setup.ml file and run make instead.
;;
;; Some packages use their own custom scripts, `pkg/pkg.ml' or
;; `pkg/build.ml'. They can be used here too.
;;
;; Code:

(define %ocaml-build-system-modules
  ;; Build-side modules imported by default.
  `((guix build ocaml-build-system)
    ,@%gnu-build-system-modules))

(define (default-ocaml)
  "Return the default OCaml package."

  ;; Do not use `@' to avoid introducing circular dependencies.
  (let ((module (resolve-interface '(gnu packages ocaml))))
    (module-ref module 'ocaml)))

(define (default-findlib)
  "Return the default OCaml-findlib package."

  ;; Do not use `@' to avoid introducing circular dependencies.
  (let ((module (resolve-interface '(gnu packages ocaml))))
    (module-ref module 'ocaml-findlib)))

(define (default-dune-build-system)
  "Return the dune-build-system."

  ;; Do not use `@' to avoid introducing circular dependencies.
  (let ((module (resolve-interface '(guix build-system dune))))
    (module-ref module 'dune-build-system)))

(define (default-ocaml4.07)
  (let ((ocaml (resolve-interface '(gnu packages ocaml))))
    (module-ref ocaml 'ocaml-4.07)))

(define (default-ocaml4.07-findlib)
  (let ((module (resolve-interface '(gnu packages ocaml))))
    (module-ref module 'ocaml4.07-findlib)))

(define (default-ocaml4.07-dune)
  (let ((module (resolve-interface '(gnu packages ocaml))))
    (module-ref module 'ocaml4.07-dune)))

(define (default-ocaml4.09)
  (let ((ocaml (resolve-interface '(gnu packages ocaml))))
    (module-ref ocaml 'ocaml-4.09)))

(define (default-ocaml4.09-findlib)
  (let ((module (resolve-interface '(gnu packages ocaml))))
    (module-ref module 'ocaml4.09-findlib)))

(define (default-ocaml4.09-dune)
  (let ((module (resolve-interface '(gnu packages ocaml))))
    (module-ref module 'ocaml4.09-dune)))

(define* (package-with-explicit-ocaml ocaml findlib dune old-prefix new-prefix
                                       #:key variant-property)
  "Return a procedure of one argument, P.  The procedure creates a package
with the same fields as P, which is assumed to use OCAML-BUILD-SYSTEM, such
that it is compiled with OCAML and FINDLIB instead.  The inputs are changed
recursively accordingly.  If the name of P starts with OLD-PREFIX, this is
replaced by NEW-PREFIX; otherwise, NEW-PREFIX is prepended to the name.

When the package uses the DUNE-BUILD-SYSTEM, the procedure creates a package
with the same fields as P, such that it is compiled with OCAML, FINDLIB and DUNE
instead.

When VARIANT-PROPERTY is present, it is used as a key to search for
pre-defined variants of this transformation recorded in the 'properties' field
of packages.  The property value must be the promise of a package.  This is a
convenient way for package writers to force the transformation to use
pre-defined variants."
  (define package-variant
    (if variant-property
        (lambda (package)
          (assq-ref (package-properties package)
                    variant-property))
        (const #f)))

  (define (transform p)
    (cond
     ;; If VARIANT-PROPERTY is present, use that.
     ((package-variant p)
      => force)

     ;; Otherwise build the new package object graph.
     ((or (eq? (package-build-system p) ocaml-build-system)
          (eq? (package-build-system p) (default-dune-build-system)))
      (package
        (inherit p)
        (location (package-location p))
        (name (let ((name (package-name p)))
                (string-append new-prefix
                               (if (string-prefix? old-prefix name)
                                   (substring name
                                              (string-length old-prefix))
                                   name))))
        (arguments
         (let ((ocaml   (if (promise? ocaml) (force ocaml) ocaml))
               (findlib (if (promise? findlib) (force findlib) findlib))
               (dune (if (promise? dune) (force dune) dune)))
           (ensure-keyword-arguments (package-arguments p)
                                     `(#:ocaml   ,ocaml
                                       #:findlib ,findlib
                                       ,@(if (eq? (package-build-system p)
                                                  (default-dune-build-system))
                                             `(#:dune ,dune)
                                             '())))))))
     (else p)))

  (define (cut? p)
    (or (not (or (eq? (package-build-system p) ocaml-build-system)
                 (eq? (package-build-system p) (default-dune-build-system))))
        (package-variant p)))

  (package-mapping transform cut?))

(define package-with-ocaml4.07
  (package-with-explicit-ocaml (delay (default-ocaml4.07))
                               (delay (default-ocaml4.07-findlib))
                               (delay (default-ocaml4.07-dune))
                               "ocaml-" "ocaml4.07-"
                               #:variant-property 'ocaml4.07-variant))

(define (strip-ocaml4.07-variant p)
  "Remove the 'ocaml4.07-variant' property from P."
  (package
    (inherit p)
    (properties (alist-delete 'ocaml4.07-variant (package-properties p)))))

(define package-with-ocaml4.09
  (package-with-explicit-ocaml (delay (default-ocaml4.09))
                               (delay (default-ocaml4.09-findlib))
                               (delay (default-ocaml4.09-dune))
                               "ocaml-" "ocaml4.09-"
                               #:variant-property 'ocaml4.09-variant))

(define (strip-ocaml4.09-variant p)
  "Remove the 'ocaml4.09-variant' property from P."
  (package
    (inherit p)
    (properties (alist-delete 'ocaml4.09-variant (package-properties p)))))

(define* (lower name
                #:key source inputs native-inputs outputs system target
                (ocaml (default-ocaml))
                (findlib (default-findlib))
                #:allow-other-keys
                #:rest arguments)
  "Return a bag for NAME."
  (define private-keywords
    '(#:source #:target #:ocaml #:findlib #:inputs #:native-inputs))

  (and (not target)                               ;XXX: no cross-compilation
       (bag
         (name name)
         (system system)
         (host-inputs `(,@(if source
                              `(("source" ,source))
                              '())
                        ,@inputs

                        ;; Keep the standard inputs of 'gnu-build-system'.
                        ,@(standard-packages)))
         (build-inputs `(("ocaml" ,ocaml)
                         ("findlib" ,findlib)
                         ,@native-inputs))
         (outputs outputs)
         (build ocaml-build)
         (arguments (strip-keyword-arguments private-keywords arguments)))))

(define* (ocaml-build store name inputs
                      #:key (guile #f)
                      (outputs '("out")) (configure-flags ''())
                      (search-paths '())
                      (make-flags ''())
                      (build-flags ''())
                      (out-of-source? #t)
                      (use-make? #f)
                      (tests? #t)
                      (test-flags ''("--enable-tests"))
                      (test-target "test")
                      (install-target "install")
                      (validate-runpath? #t)
                      (patch-shebangs? #t)
                      (strip-binaries? #t)
                      (strip-flags ''("--strip-debug"))
                      (strip-directories ''("lib" "lib64" "libexec"
                                            "bin" "sbin"))
                      (phases '(@ (guix build ocaml-build-system)
                                  %standard-phases))
                      (system (%current-system))
                      (imported-modules %ocaml-build-system-modules)
                      (modules '((guix build ocaml-build-system)
                                 (guix build utils))))
  "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)
       (ocaml-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
                    #:configure-flags ,configure-flags
                    #:test-flags ,test-flags
                    #:make-flags ,make-flags
                    #:build-flags ,build-flags
                    #:out-of-source? ,out-of-source?
                    #:use-make? ,use-make?
                    #: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))

(define ocaml-build-system
  (build-system
    (name 'ocaml)
    (description "The standard OCaml build system")
    (lower lower)))

;;; ocaml.scm ends here


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build-system perl)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix derivations)
  #:use-module (guix search-paths)
  #:use-module (guix build-system)
  #:use-module (guix build-system gnu)
  #:use-module (guix packages)
  #:use-module (ice-9 match)
  #:export (%perl-build-system-modules
            perl-build
            perl-build-system))

;; Commentary:
;;
;; Standard build procedure for Perl packages using the "makefile
;; maker"---i.e., "perl Makefile.PL".  This is implemented as an extension of
;; `gnu-build-system'.
;;
;; Code:

(define %perl-build-system-modules
  ;; Build-side modules imported by default.
  `((guix build perl-build-system)
    ,@%gnu-build-system-modules))

(define (default-perl)
  "Return the default Perl package."

  ;; Do not use `@' to avoid introducing circular dependencies.
  (let ((module (resolve-interface '(gnu packages perl))))
    (module-ref module 'perl)))

(define* (lower name
                #:key source inputs native-inputs outputs
                system target
                (perl (default-perl))
                #:allow-other-keys
                #:rest arguments)
  "Return a bag for NAME."
  (define private-keywords
    '(#:source #:target #:perl #:inputs #:native-inputs))

  (and (not target)                               ;XXX: no cross-compilation
       (bag
         (name name)
         (system system)
         (host-inputs `(,@(if source
                              `(("source" ,source))
                              '())
                        ,@inputs

                        ;; Keep the standard inputs of 'gnu-build-system'.
                        ,@(standard-packages)))
         (build-inputs `(("perl" ,perl)
                         ,@native-inputs))
         (outputs outputs)
         (build perl-build)
         (arguments (strip-keyword-arguments private-keywords arguments)))))

(define* (perl-build store name inputs
                     #:key
                     (search-paths '())
                     (tests? #t)
                     (parallel-build? #t)
                     (parallel-tests? #t)
                     (make-maker? #f)
                     (make-maker-flags ''())
                     (module-build-flags ''())
                     (phases '(@ (guix build perl-build-system)
                                 %standard-phases))
                     (outputs '("out"))
                     (system (%current-system))
                     (guile #f)
                     (imported-modules %perl-build-system-modules)
                     (modules '((guix build perl-build-system)
                                (guix build utils))))
  "Build SOURCE using PERL, and with INPUTS.  This assumes that SOURCE
provides a `Makefile.PL' file as its build system."
  (define builder
    `(begin
       (use-modules ,@modules)
       (perl-build #:name ,name
                   #:source ,(match (assoc-ref inputs "source")
                               (((? derivation? source))
                                (derivation->output-path source))
                               ((source)
                                source)
                               (source
                                source))
                   #:search-paths ',(map search-path-specification->sexp
                                         search-paths)
                   #:make-maker? ,make-maker?
                   #:make-maker-flags ,make-maker-flags
                   #:module-build-flags ,module-build-flags
                   #:phases ,phases
                   #:system ,system
                   #:test-target "test"
                   #:tests? ,tests?
                   #:parallel-build? ,parallel-build?
                   #:parallel-tests? ,parallel-tests?
                   #:outputs %outputs
                   #:inputs %build-inputs)))

  (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))

(define perl-build-system
  (build-system
    (name 'perl)
    (description "The standard Perl build system")
    (lower lower)))

;;; perl.scm ends here


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build-system python)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix memoization)
  #:use-module (guix packages)
  #:use-module (guix derivations)
  #:use-module (guix search-paths)
  #:use-module (guix build-system)
  #:use-module (guix build-system gnu)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:export (%python-build-system-modules
            package-with-python2
            strip-python2-variant
            default-python
            default-python2
            python-build
            python-build-system
            pypi-uri))

;; Commentary:
;;
;; Standard build procedure for Python packages using 'setup.py'.  This is
;; implemented as an extension of 'gnu-build-system'.
;;
;; Code:

(define* (pypi-uri name version #:optional (extension ".tar.gz"))
  "Return a URI string for the Python package hosted on the Python Package
Index (PyPI) corresponding to NAME and VERSION.  EXTENSION is the file name
extension, such as '.tar.gz'."
  (string-append "https://files.pythonhosted.org/packages/source/"
                 (string-take name 1) "/" name "/"
                 name "-" version extension))

(define %python-build-system-modules
  ;; Build-side modules imported by default.
  `((guix build python-build-system)
    ,@%gnu-build-system-modules))

(define (default-python)
  "Return the default Python package."
  ;; Lazily resolve the binding to avoid a circular dependency.
  (let ((python (resolve-interface '(gnu packages python))))
    (module-ref python 'python-wrapper)))

(define (default-python2)
  "Return the default Python 2 package."
  (let ((python (resolve-interface '(gnu packages python))))
    (module-ref python 'python-2)))

(define* (package-with-explicit-python python old-prefix new-prefix
                                       #:key variant-property)
  "Return a procedure of one argument, P.  The procedure creates a package with
the same fields as P, which is assumed to use PYTHON-BUILD-SYSTEM, such that
it is compiled with PYTHON instead.  The inputs are changed recursively
accordingly.  If the name of P starts with OLD-PREFIX, this is replaced by
NEW-PREFIX; otherwise, NEW-PREFIX is prepended to the name.

When VARIANT-PROPERTY is present, it is used as a key to search for
pre-defined variants of this transformation recorded in the 'properties' field
of packages.  The property value must be the promise of a package.  This is a
convenient way for package writers to force the transformation to use
pre-defined variants."
  (define package-variant
    (if variant-property
        (lambda (package)
          (assq-ref (package-properties package)
                    variant-property))
        (const #f)))

  (define (transform p)
    (cond
     ;; If VARIANT-PROPERTY is present, use that.
     ((package-variant p)
      => force)

     ;; Otherwise build the new package object graph.
     ((eq? (package-build-system p) python-build-system)
      (package/inherit p
        (location (package-location p))
        (name (let ((name (package-name p)))
                (string-append new-prefix
                               (if (string-prefix? old-prefix name)
                                   (substring name
                                              (string-length old-prefix))
                                   name))))
        (arguments
         (let ((python (if (promise? python)
                           (force python)
                           python)))
           (ensure-keyword-arguments (package-arguments p)
                                     `(#:python ,python))))))
     (else p)))

  (define (cut? p)
    (or (not (eq? (package-build-system p) python-build-system))
        (package-variant p)))

  (package-mapping transform cut?))

(define package-with-python2
  ;; Note: delay call to 'default-python2' until after the 'arguments' field
  ;; of packages is accessed to avoid a circular dependency when evaluating
  ;; the top-level of (gnu packages python).
  (package-with-explicit-python (delay (default-python2))
                                "python-" "python2-"
                                #:variant-property 'python2-variant))

(define (strip-python2-variant p)
  "Remove the 'python2-variant' property from P."
  (package/inherit p
    (properties (alist-delete 'python2-variant (package-properties p)))))

(define* (lower name
                #:key source inputs native-inputs outputs system target
                (python (default-python))
                #:allow-other-keys
                #:rest arguments)
  "Return a bag for NAME."
  (define private-keywords
    '(#:source #:target #:python #:inputs #:native-inputs))

  (and (not target)                               ;XXX: no cross-compilation
       (bag
         (name name)
         (system system)
         (host-inputs `(,@(if source
                              `(("source" ,source))
                              '())
                        ,@inputs

                        ;; Keep the standard inputs of 'gnu-build-system'.
                        ,@(standard-packages)))
         (build-inputs `(("python" ,python)
                         ,@native-inputs))
         (outputs outputs)
         (build python-build)
         (arguments (strip-keyword-arguments private-keywords arguments)))))

(define* (python-build store name inputs
                       #:key
                       (tests? #t)
                       (test-target "test")
                       (use-setuptools? #t)
                       (configure-flags ''())
                       (phases '(@ (guix build python-build-system)
                                   %standard-phases))
                       (outputs '("out"))
                       (search-paths '())
                       (system (%current-system))
                       (guile #f)
                       (imported-modules %python-build-system-modules)
                       (modules '((guix build python-build-system)
                                  (guix build utils))))
  "Build SOURCE using PYTHON, and with INPUTS.  This assumes that SOURCE
provides a 'setup.py' file as its build system."
  (define builder
    `(begin
       (use-modules ,@modules)
       (python-build #:name ,name
                     #:source ,(match (assoc-ref inputs "source")
                                 (((? derivation? source))
                                  (derivation->output-path source))
                                 ((source)
                                  source)
                                 (source
                                  source))
                     #:configure-flags ,configure-flags
                     #:system ,system
                     #:test-target ,test-target
                     #:tests? ,tests?
                     #:use-setuptools? ,use-setuptools?
                     #:phases ,phases
                     #:outputs %outputs
                     #:search-paths ',(map search-path-specification->sexp
                                           search-paths)
                     #:inputs %build-inputs)))

  (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
                                #:inputs inputs
                                #:system system
                                #:modules imported-modules
                                #:outputs outputs
                                #:guile-for-build guile-for-build))

(define python-build-system
  (build-system
    (name 'python)
    (description "The standard Python build system")
    (lower lower)))

;;; python.scm ends here


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build-system qt)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module ((guix build qt-utils)
                #:select (%qt-wrap-excluded-inputs))
  #:use-module (guix derivations)
  #:use-module (guix search-paths)
  #:use-module (guix build-system)
  #:use-module (guix build-system cmake)
  #:use-module (guix build-system gnu)
  #:use-module (guix packages)
  #:use-module (ice-9 match)
  #:export (%qt-build-system-modules
            qt-build
            qt-build-system))

;; Commentary:
;;
;; This build system is an extension of the 'cmake-build-system'.  It
;; accommodates the needs of Qt and KDE applications by adding a phase run
;; after the 'install' phase:
;;
;; 'qt-wrap' phase:
;;
;; This phase looks for Qt5 plugin paths, QML paths and some XDG paths as well
;; as the corresponding environment variables.  If any of these is found in
;; the output or if respective environment variables are set, then all
;; programs in the output's "bin", "sbin", "libexec and "lib/libexec"
;; directories are wrapped in scripts defining the necessary environment
;; variables.
;;
;; Code:

(define %qt-build-system-modules
  ;; Build-side modules imported and used by default.
  `((guix build qt-build-system)
    (guix build qt-utils)
    ,@%cmake-build-system-modules))

(define (default-cmake)
  "Return the default CMake package."

  ;; Do not use `@' to avoid introducing circular dependencies.
  (let ((module (resolve-interface '(gnu packages cmake))))
    (module-ref module 'cmake-minimal)))

;; This barely is a copy from (guix build-system cmake), only adjusted to use
;; the variables defined here.
(define* (lower name
                #:key source inputs native-inputs outputs system target
                (cmake (default-cmake))
                #:allow-other-keys
                #:rest arguments)
  "Return a bag for NAME."
  (define private-keywords
    `(#:source #:cmake #:inputs #:native-inputs #:outputs
      ,@(if target '() '(#:target))))

  (bag
    (name name)
    (system system)
    (target target)
    (build-inputs `(,@(if source
                          `(("source" ,source))
                          '())
                    ,@`(("cmake" ,cmake))
                    ,@native-inputs
                    ,@(if target
                          ;; Use the standard cross inputs of
                          ;; 'gnu-build-system'.
                          (standard-cross-packages target 'host)
                          '())
                    ;; Keep the standard inputs of 'gnu-build-system'.
                    ,@(standard-packages)))
    (host-inputs inputs)

    ;; The cross-libc is really a target package, but for bootstrapping
    ;; reasons, we can't put it in 'host-inputs'.  Namely, 'cross-gcc' is a
    ;; native package, so it would end up using a "native" variant of
    ;; 'cross-libc' (built with 'gnu-build'), whereas all the other packages
    ;; would use a target variant (built with 'gnu-cross-build'.)
    (target-inputs (if target
                       (standard-cross-packages target 'target)
                       '()))
    (outputs outputs)
    (build (if target qt-cross-build qt-build))
    (arguments (strip-keyword-arguments private-keywords arguments))))

(define* (qt-build store name inputs
                   #:key (guile #f)
                   (outputs '("out")) (configure-flags ''())
                   (search-paths '())
                   (make-flags ''())
                   (out-of-source? #t)
                   (build-type "RelWithDebInfo")
                   (tests? #t)
                   (test-target "test")
                   (parallel-build? #t) (parallel-tests? #f)
                   (validate-runpath? #t)
                   (patch-shebangs? #t)
                   (strip-binaries? #t)
                   (strip-flags ''("--strip-debug"))
                   (strip-directories ''("lib" "lib64" "libexec"
                                         "bin" "sbin"))
                   (phases '(@ (guix build qt-build-system)
                               %standard-phases))
                   (qt-wrap-excluded-outputs ''())
                   (qt-wrap-excluded-inputs %qt-wrap-excluded-inputs)
                   (system (%current-system))
                   (imported-modules %qt-build-system-modules)
                   (modules '((guix build qt-build-system)
                              (guix build utils))))
  "Build SOURCE using CMAKE, and with INPUTS. This assumes that SOURCE
provides a 'CMakeLists.txt' file as its build system."
  (define builder
    `(begin
       (use-modules ,@modules)
       (qt-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
                 #:qt-wrap-excluded-outputs ,qt-wrap-excluded-outputs
                 #:qt-wrap-excluded-inputs ,qt-wrap-excluded-inputs
                 #:configure-flags ,configure-flags
                 #:make-flags ,make-flags
                 #:out-of-source? ,out-of-source?
                 #:build-type ,build-type
                 #:tests? ,tests?
                 #:test-target ,test-target
                 #:parallel-build? ,parallel-build?
                 #:parallel-tests? ,parallel-tests?
                 #: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))

;;;
;;; Cross-compilation.
;;;

(define* (qt-cross-build store name
                         #:key
                         target native-drvs target-drvs
                         (guile #f)
                         (outputs '("out"))
                         (configure-flags ''())
                         (search-paths '())
                         (native-search-paths '())
                         (make-flags ''())
                         (out-of-source? #t)
                         (build-type "RelWithDebInfo")
                         (tests? #f) ; nothing can be done
                         (test-target "test")
                         (parallel-build? #t) (parallel-tests? #f)
                         (validate-runpath? #t)
                         (patch-shebangs? #t)
                         (strip-binaries? #t)
                         (strip-flags ''("--strip-debug"
                                         "--enable-deterministic-archives"))
                         (strip-directories ''("lib" "lib64" "libexec"
                                               "bin" "sbin"))
                         (phases '(@ (guix build qt-build-system)
                                     %standard-phases))
                         (system (%current-system))
                         (build (nix-system->gnu-triplet system))
                         (imported-modules %qt-build-system-modules)
                         (modules '((guix build qt-build-system)
                                    (guix build utils))))
  "Cross-build NAME using CMAKE for TARGET, where TARGET is a GNU triplet and
with INPUTS.  This assumes that SOURCE provides a 'CMakeLists.txt' file as its
build system."
  (define builder
    `(begin
       (use-modules ,@modules)
       (let ()
         (define %build-host-inputs
           ',(map (match-lambda
                    ((name (? derivation? drv) sub ...)
                     `(,name . ,(apply derivation->output-path drv sub)))
                    ((name path)
                     `(,name . ,path)))
                  native-drvs))

         (define %build-target-inputs
           ',(map (match-lambda
                    ((name (? derivation? drv) sub ...)
                     `(,name . ,(apply derivation->output-path drv sub)))
                    ((name (? package? pkg) sub ...)
                     (let ((drv (package-cross-derivation store pkg
                                                          target system)))
                       `(,name . ,(apply derivation->output-path drv sub))))
                    ((name path)
                     `(,name . ,path)))
                  target-drvs))

         (qt-build #:source ,(match (assoc-ref native-drvs "source")
                                    (((? derivation? source))
                                     (derivation->output-path source))
                                    ((source)
                                     source)
                                    (source
                                     source))
                   #:system ,system
                   #:build ,build
                   #:target ,target
                   #:outputs %outputs
                   #:inputs %build-target-inputs
                   #:native-inputs %build-host-inputs
                   #:search-paths ',(map search-path-specification->sexp
                                         search-paths)
                   #:native-search-paths ',(map
                                            search-path-specification->sexp
                                            native-search-paths)
                   #:phases ,phases
                   #:configure-flags ,configure-flags
                   #:make-flags ,make-flags
                   #:out-of-source? ,out-of-source?
                   #:build-type ,build-type
                   #:tests? ,tests?
                   #:test-target ,test-target
                   #:parallel-build? ,parallel-build?
                   #:parallel-tests? ,parallel-tests?
                   #: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 (append native-drvs target-drvs)
                                #:outputs outputs
                                #:modules imported-modules
                                #:guile-for-build guile-for-build))

(define qt-build-system
  (build-system
    (name 'qt)
    (description
     "The CMake build system augmented with definition of suitable environment
variables for Qt and KDE in program wrappers.")
    (lower lower)))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2017, 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build-system r)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix packages)
  #:use-module (guix derivations)
  #:use-module (guix search-paths)
  #:use-module (guix build-system)
  #:use-module (guix build-system gnu)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-26)
  #:export (%r-build-system-modules
            r-build
            r-build-system
            cran-uri
            bioconductor-uri))

;; Commentary:
;;
;; Standard build procedure for R packages.
;;
;; Code:

(define (cran-uri name version)
  "Return a list of URI strings for the R package archive on CRAN for the
release corresponding to NAME and VERSION.  As only the most recent version is
available via the first URI, the second URI points to the archived version."
  (list (string-append "mirror://cran/src/contrib/"
                       name "_" version ".tar.gz")
        (string-append "mirror://cran/src/contrib/Archive/"
                       name "/" name "_" version ".tar.gz")))

(define* (bioconductor-uri name version #:optional type)
  "Return a URI string for the R package archive on Bioconductor for the
release corresponding to NAME and VERSION."
  (let ((type-url-part (match type
                         ('annotation "/data/annotation")
                         ('experiment "/data/experiment")
                         (_ "/bioc"))))
    (list (string-append "https://bioconductor.org/packages/release"
                         type-url-part
                         "/src/contrib/"
                         name "_" version ".tar.gz")
          ;; TODO: use %bioconductor-version from (guix import cran)
          (string-append "https://bioconductor.org/packages/3.13"
                         type-url-part
                         "/src/contrib/"
                         name "_" version ".tar.gz"))))

(define %r-build-system-modules
  ;; Build-side modules imported by default.
  `((guix build r-build-system)
    ,@%gnu-build-system-modules))

(define (default-r)
  "Return the default R package."
  ;; Lazily resolve the binding to avoid a circular dependency.
  (let ((r-mod (resolve-interface '(gnu packages statistics))))
    (module-ref r-mod 'r-minimal)))

(define* (lower name
                #:key source inputs native-inputs outputs system target
                (r (default-r))
                #:allow-other-keys
                #:rest arguments)
  "Return a bag for NAME."
  (define private-keywords
    '(#:source #:target #:r #:inputs #:native-inputs))

  (and (not target)                               ;XXX: no cross-compilation
       (bag
         (name name)
         (system system)
         (host-inputs `(,@(if source
                              `(("source" ,source))
                              '())
                        ,@inputs

                        ;; Keep the standard inputs of 'gnu-build-system'.
                        ,@(standard-packages)))
         (build-inputs `(("r" ,r)
                         ,@native-inputs))
         (outputs outputs)
         (build r-build)
         (arguments (strip-keyword-arguments private-keywords arguments)))))

(define* (r-build store name inputs
                  #:key
                  (tests? #t)
                  (test-target "tests")
                  (configure-flags ''())
                  (phases '(@ (guix build r-build-system)
                              %standard-phases))
                  (outputs '("out"))
                  (search-paths '())
                  (system (%current-system))
                  (guile #f)
                  (substitutable? #t)
                  (imported-modules %r-build-system-modules)
                  (modules '((guix build r-build-system)
                             (guix build utils))))
  "Build SOURCE with INPUTS."
  (define builder
    `(begin
       (use-modules ,@modules)
       (r-build #:name ,name
                #:source ,(match (assoc-ref inputs "source")
                            (((? derivation? source))
                             (derivation->output-path source))
                            ((source)
                             source)
                            (source
                             source))
                #:configure-flags ,configure-flags
                #:system ,system
                #:tests? ,tests?
                #:test-target ,test-target
                #:phases ,phases
                #:outputs %outputs
                #:search-paths ',(map search-path-specification->sexp
                                      search-paths)
                #:inputs %build-inputs)))

  (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
                                #:inputs inputs
                                #:system system
                                #:modules imported-modules
                                #:outputs outputs
                                #:guile-for-build guile-for-build
                                #:substitutable? substitutable?))

(define r-build-system
  (build-system
    (name 'r)
    (description "The standard R build system")
    (lower lower)))

;;; r.scm ends here


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build-system rakudo)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix derivations)
  #:use-module (guix search-paths)
  #:use-module (guix build-system)
  #:use-module (guix build-system gnu)
  #:use-module (guix packages)
  #:use-module (ice-9 match)
  #:export (%rakudo-build-system-modules
            rakudo-build
            rakudo-build-system))

;; Commentary:
;;
;; Standard build and install procedure for packages using the Rakudo
;; build system to be installed as system libraries.  This is
;; implemented as an extension of `gnu-build-system'.
;;
;; Code:

(define %rakudo-build-system-modules
  ;; Build-side modules imported by default.
  `((guix build rakudo-build-system)
    ,@%gnu-build-system-modules))

(define (default-rakudo)
  "Return the default Rakudo package."

  ;; Do not use `@' to avoid introducing circular dependencies.
  (let ((module (resolve-interface '(gnu packages perl6))))
    (module-ref module 'rakudo)))

(define (default-prove6)
  "Return the default perl6-tap-harness package for tests."
  (let ((module (resolve-interface '(gnu packages perl6))))
    (module-ref module 'perl6-tap-harness)))

(define (default-zef)
  "Return the default perl6-zef package."
  (let ((module (resolve-interface '(gnu packages perl6))))
    (module-ref module 'perl6-zef)))

(define* (lower name
                #:key source inputs native-inputs outputs
                system target
                (rakudo (default-rakudo))
                (prove6 (default-prove6))
                (zef (default-zef))
                (with-prove6? #t)
                (with-zef? #t)
                #:allow-other-keys
                #:rest arguments)
  "Return a bag for NAME."
  (define private-keywords
    '(#:source #:target #:rakudo #:prove6 #:zef #:inputs #:native-inputs))

  (and (not target)                               ;XXX: no cross-compilation
       (bag
         (name name)
         (system system)
         (host-inputs `(,@(if source
                              `(("source" ,source))
                              '())
                        ,@inputs

                        ;; Keep the standard inputs of 'gnu-build-system'.
                        ,@(standard-packages)))
         (build-inputs `(("rakudo" ,rakudo)
                         ,@(if with-prove6?
                               `(("perl6-tap-harness" ,prove6)
                                 ,@(if with-zef?
                                       `(("perl6-zef" ,zef))
                                       '()))
                               '())
                         ,@native-inputs))
         (outputs outputs)
         (build rakudo-build)
         (arguments (strip-keyword-arguments private-keywords arguments)))))

(define* (rakudo-build store name inputs
                       #:key
                       (search-paths '())
                       (tests? #t)
                       (phases '(@ (guix build rakudo-build-system)
                                   %standard-phases))
                       (outputs '("out"))
                       (system (%current-system))
                       (guile #f)
                       (with-zef? #t)
                       (with-prove6? #t)
                       (imported-modules %rakudo-build-system-modules)
                       (modules '((guix build rakudo-build-system)
                                  (guix build utils))))
  "Build SOURCE using PERL6, and with INPUTS."
  (define builder
    `(begin
       (use-modules ,@modules)
       (rakudo-build #:name ,name
                     #:source ,(match (assoc-ref inputs "source")
                                      (((? derivation? source))
                                       (derivation->output-path source))
                                      ((source)
                                       source)
                                      (source
                                        source))
                     #:search-paths ',(map search-path-specification->sexp
                                           search-paths)
                     #:phases ,phases
                     #:system ,system
                     #:tests? ,tests?
                     #:outputs %outputs
                     #:inputs %build-inputs)))

  (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))

(define rakudo-build-system
  (build-system
    (name 'rakudo)
    (description "The standard Rakudo build system")
    (lower lower)))

;;; rakudo.scm ends here


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Leo Prikler <leo.prikler@student.tugraz.at>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build-system renpy)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix memoization)
  #:use-module (guix packages)
  #:use-module (guix derivations)
  #:use-module (guix search-paths)
  #:use-module (guix build-system)
  #:use-module (guix build-system gnu)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:export (%renpy-build-system-modules
            default-renpy
            renpy-build
            renpy-build-system))

(define (default-renpy)
  "Return the default Ren'py package."
  ;; Lazily resolve the binding to avoid a circular dependency.
  (let ((module (resolve-interface '(gnu packages game-development))))
    (module-ref module 'renpy)))

(define %renpy-build-system-modules
  ;; Build-side modules imported by default.
  `((guix build renpy-build-system)
    (guix build json)
    (guix build python-build-system)
    ,@%gnu-build-system-modules))

(define* (lower name
                #:key source inputs native-inputs outputs system target
                (renpy (default-renpy))
                #:allow-other-keys
                #:rest arguments)
  "Return a bag for NAME."
  (define private-keywords
    '(#:source #:target #:renpy #:inputs #:native-inputs))

  (and (not target)                               ;XXX: no cross-compilation
       (bag
         (name name)
         (system system)
         (host-inputs `(,@(if source
                              `(("source" ,source))
                              '())
                        ,@inputs

                        ;; Keep the standard inputs of 'gnu-build-system'.
                        ,@(standard-packages)))
         (build-inputs `(("renpy" ,renpy)
                         ,@native-inputs))
         (outputs outputs)
         (build renpy-build)
         (arguments (strip-keyword-arguments private-keywords arguments)))))

(define* (renpy-build store name inputs
                       #:key
                       (phases '(@ (guix build renpy-build-system)
                                   %standard-phases))
                       (configure-flags ''())
                       (outputs '("out"))
                       (output "out")
                       (game "game")
                       (search-paths '())
                       (system (%current-system))
                       (guile #f)
                       (imported-modules %renpy-build-system-modules)
                       (modules '((guix build renpy-build-system)
                                  (guix build utils))))
  "Build SOURCE using RENPY, and with INPUTS."
  (define builder
    `(begin
       (use-modules ,@modules)
       (renpy-build #:name ,name
                    #:source ,(match (assoc-ref inputs "source")
                                (((? derivation? source))
                                 (derivation->output-path source))
                                ((source)
                                 source)
                                (source
                                 source))
                     #:configure-flags ,configure-flags
                     #:system ,system
                     #:phases ,phases
                     #:outputs %outputs
                     #:output ,output
                     #:game ,game
                     #:search-paths ',(map search-path-specification->sexp
                                           search-paths)
                     #:inputs %build-inputs)))

  (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
                                #:inputs inputs
                                #:system system
                                #:modules imported-modules
                                #:outputs outputs
                                #:guile-for-build guile-for-build))

(define renpy-build-system
  (build-system
    (name 'renpy)
    (description "The Ren'py build system")
    (lower lower)))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build-system ruby)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix packages)
  #:use-module (guix derivations)
  #:use-module (guix search-paths)
  #:use-module (guix build-system)
  #:use-module (guix build-system gnu)
  #:use-module (ice-9 match)
  #:export (rubygems-uri
            %ruby-build-system-modules
            ruby-build
            ruby-build-system))

(define (rubygems-uri name version)
  "Return a URI string for the gem archive for the release corresponding to
NAME and VERSION."
  (string-append "https://rubygems.org/downloads/" name "-" version ".gem"))

(define %ruby-build-system-modules
  ;; Build-side modules imported by default.
  `((guix build ruby-build-system)
    ,@%gnu-build-system-modules))

(define (default-ruby)
  "Return the default Ruby package."
  ;; Lazily resolve the binding to avoid a circular dependency.
  (let ((ruby (resolve-interface '(gnu packages ruby))))
    (module-ref ruby 'ruby)))

(define* (lower name
                #:key source inputs native-inputs outputs system target
                (ruby (default-ruby))
                #:allow-other-keys
                #:rest arguments)
  "Return a bag for NAME."
  (define private-keywords
    '(#:source #:target #:ruby #:inputs #:native-inputs))

  (and (not target)                    ;XXX: no cross-compilation
       (bag
         (name name)
         (system system)
         (host-inputs `(,@(if source
                              `(("source" ,source))
                              '())
                        ,@inputs

                        ;; Keep the standard inputs of 'gnu-build-system'.
                        ,@(standard-packages)))
         (build-inputs `(("ruby" ,ruby)
                         ,@native-inputs))
         (outputs outputs)
         (build ruby-build)
         (arguments (strip-keyword-arguments private-keywords arguments)))))

(define* (ruby-build store name inputs
                     #:key
                     (gem-flags ''())
                     (test-target "test")
                     (tests? #t)
                     (phases '(@ (guix build ruby-build-system)
                                 %standard-phases))
                     (outputs '("out"))
                     (search-paths '())
                     (system (%current-system))
                     (guile #f)
                     (imported-modules %ruby-build-system-modules)
                     (modules '((guix build ruby-build-system)
                                (guix build utils))))
  "Build SOURCE using RUBY and INPUTS."
  (define builder
    `(begin
       (use-modules ,@modules)
       (ruby-build #:name ,name
                   #:source ,(match (assoc-ref inputs "source")
                               (((? derivation? source))
                                (derivation->output-path source))
                               ((source)
                                source)
                               (source
                                source))
                   #:system ,system
                   #:gem-flags ,gem-flags
                   #:test-target ,test-target
                   #:tests? ,tests?
                   #:phases ,phases
                   #:outputs %outputs
                   #:search-paths ',(map search-path-specification->sexp
                                         search-paths)
                   #:inputs %build-inputs)))

  (define guile-for-build
    (match guile
      ((? package?)
       (package-derivation store guile system #:graft? #f))
      (#f
       (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
                                #:inputs inputs
                                #:system system
                                #:modules imported-modules
                                #:outputs outputs
                                #:guile-for-build guile-for-build))

(define ruby-build-system
  (build-system
    (name 'ruby)
    (description "The standard Ruby build system")
    (lower lower)))


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build-system scons)
  #:use-module (guix utils)
  #:use-module (guix packages)
  #:use-module (guix derivations)
  #:use-module (guix search-paths)
  #:use-module (guix build-system)
  #:use-module (guix build-system gnu)
  #:use-module (ice-9 match)
  #:export (%scons-build-system-modules
            scons-build
            scons-build-system))

;; Commentary:
;;
;; Standard build procedure for applications using SCons. This is implemented
;; as an extension of 'gnu-build-system'.
;;
;; Code:

(define %scons-build-system-modules
  ;; Build-side modules imported by default.
  `((guix build scons-build-system)
    ,@%gnu-build-system-modules))

(define (default-scons)
  "Return the default SCons package."
  ;; Lazily resolve the binding to avoid a circular dependency.
  (let ((python (resolve-interface '(gnu packages python-xyz))))
    (module-ref python 'scons)))

(define* (lower name
                #:key source inputs native-inputs outputs system target
                (scons (default-scons))
                #:allow-other-keys
                #:rest arguments)
  "Return a bag for NAME."
  (define private-keywords
    '(#:source #:target #:scons #:inputs #:native-inputs))

  (and (not target)                               ;XXX: no cross-compilation
       (bag
         (name name)
         (system system)
         (host-inputs `(,@(if source
                              `(("source" ,source))
                              '())
                        ,@inputs

                        ;; Keep the standard inputs of 'gnu-build-system'.
                        ,@(standard-packages)))
         (build-inputs `(("scons" ,scons)
                         ,@native-inputs))
         (outputs outputs)
         (build scons-build)
         (arguments (strip-keyword-arguments private-keywords arguments)))))

(define* (scons-build store name inputs
                      #:key
                      (tests? #t)
                      (scons-flags ''())
                      (build-targets ''())
                      (test-target "test")
                      (install-targets ''("install"))
                      (phases '(@ (guix build scons-build-system)
                                  %standard-phases))
                      (outputs '("out"))
                      (search-paths '())
                      (system (%current-system))
                      (guile #f)
                      (imported-modules %scons-build-system-modules)
                      (modules '((guix build scons-build-system)
                                 (guix build utils))))
  "Build SOURCE using SCons, and with INPUTS.  This assumes that SOURCE
provides a 'SConstruct' file as its build system."
  (define builder
    `(begin
       (use-modules ,@modules)
       (scons-build #:name ,name
                    #:source ,(match (assoc-ref inputs "source")
                                (((? derivation? source))
                                 (derivation->output-path source))
                                ((source)
                                 source)
                                (source
                                 source))
                    #:scons-flags ,scons-flags
                    #:system ,system
                    #:build-targets ,build-targets
                    #:test-target ,test-target
                    #:tests? ,tests?
                    #:install-targets ,install-targets
                    #:phases ,phases
                    #:outputs %outputs
                    #:search-paths ',(map search-path-specification->sexp
                                          search-paths)
                    #:inputs %build-inputs)))

  (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
                                #:inputs inputs
                                #:system system
                                #:modules imported-modules
                                #:outputs outputs
                                #:guile-for-build guile-for-build))

(define scons-build-system
  (build-system
    (name 'scons)
    (description "The standard SCons build system")
    (lower lower)))

;;; scons.scm ends here


code:
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (guix build-system texlive)
  #:use-module (guix store)
  #:use-module (guix utils)
  #:use-module (guix packages)
  #:use-module (guix derivations)
  #:use-module (guix search-paths)
  #:use-module (guix build-system)
  #:use-module (guix build-system gnu)
  #:use-module (guix svn-download)
  #:use-module (ice-9 match)
  #:export (%texlive-build-system-modules
            texlive-build
            texlive-build-system
            texlive-ref
            texlive-origin
            %texlive-tag
            %texlive-revision))

;; Commentary:
;;
;; Standard build procedure for Texlive packages.
;;
;; Code:

;; These variables specify the SVN tag and the matching SVN revision.  They
;; are taken from https://www.tug.org/svn/texlive/tags/
(define %texlive-tag "texlive-2019.3")
(define %texlive-revision 51265)

(define (texlive-origin name version locations hash)
  "Return an <origin> object for a TeX Live package consisting of multiple
LOCATIONS with a provided HASH.  Use NAME and VERSION to compute a prettier
name for the checkout directory."
  (origin
    (method svn-multi-fetch)
    (uri (svn-multi-reference
          (url (string-append "svn://www.tug.org/texlive/tags/"
                              %texlive-tag "/Master/texmf-dist/"))
          (locations locations)
          (revision %texlive-revision)))
    (file-name (string-append name "-" version "-checkout"))
    (sha256 hash)))

(define (texlive-ref component id)
  "Return a <svn-reference> object for the package ID, which is part of the
given Texlive COMPONENT."
  (svn-reference
   (url (string-append "svn://www.tug.org/texlive/tags/"
                       %texlive-tag "/Master/texmf-dist/"
                       "source/" component "/" id))
   (revision %texlive-revision)))

(define %texlive-build-system-modules
  ;; Build-side modules imported by default.
  `((guix build texlive-build-system)
    (guix build union)
    ,@%gnu-build-system-modules))

(define (default-texlive-bin)
  "Return the default texlive-bin package."
  ;; Lazily resolve the binding to avoid a circular dependency.
  (let ((tex-mod (resolve-interface '(gnu packages tex))))
    (module-ref tex-mod 'texlive-bin)))

(define (default-texlive-latex-base)
  "Return the default texlive-latex-base package."
  ;; Lazily resolve the binding to avoid a circular dependency.
  (let ((tex-mod (resolve-interface '(gnu packages tex))))
    (module-ref tex-mod 'texlive-latex-base)))

(define* (lower name
                #:key
                source inputs native-inputs outputs
                system target
                (texlive-latex-base (default-texlive-latex-base))
                (texlive-bin (default-texlive-bin))
                #:allow-other-keys
                #:rest arguments)
  "Return a bag for NAME."
  (define private-keywords
    '(#:source #:target #:inputs #:native-inputs
      #:texlive-latex-base #:texlive-bin))

  (bag
    (name name)
    (system system)
    (host-inputs `(,@(if source
                         `(("source" ,source))
                         '())
                   ,@inputs

                   ;; Keep the standard inputs of 'gnu-build-system'.
                   ,@(standard-packages)))
    (build-inputs `(("texlive-bin" ,texlive-bin)
                    ("texlive-latex-base" ,texlive-latex-base)
                    ,@native-inputs))
    (outputs outputs)
    (build texlive-build)
    (arguments (strip-keyword-arguments private-keywords arguments))))

(define* (texlive-build store name inputs
                        #:key
                        (tests? #f)
                        tex-directory
                        (build-targets #f)
                        (tex-format "luatex")
                        (phases '(@ (guix build texlive-build-system)
                                    %standard-phases))
                        (outputs '("out"))
                        (search-paths '())
                        (system (%current-system))
                        (guile #f)
                        (substitutable? #t)
                        (imported-modules %texlive-build-system-modules)
                        (modules '((guix build texlive-build-system)
                                   (guix build union)
                                   (guix build utils))))
  "Build SOURCE with INPUTS."
  (define builder
    `(begin
       (use-modules ,@modules)
       (texlive-build #:name ,name
                      #:source ,(match (assoc-ref inputs "source")
                                       (((? derivation? source))
                                        (derivation->output-path source))
                                       ((source)
                                        source)
                                       (source
                                        source))
                      #:tex-directory ,tex-directory
                      #:build-targets ,build-targets
                      #:tex-format ,tex-format
                      #:system ,system
                      #:tests? ,tests?
                      #:phases ,phases
                      #:outputs %outputs
                      #:search-paths ',(map search-path-specification->sexp
                                            search-paths)
                      #:inputs %build-inputs)))

  (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
                                #:inputs inputs
                                #:system system
                                #:modules imported-modules
                                #:outputs outputs
                                #:guile-for-build guile-for-build
                                #:substitutable? substitutable?))

(define texlive-build-system
  (build-system
    (name 'texlive)
    (description "The build system for TeX Live packages")
    (lower lower)))

;;; texlive.scm ends here