;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
file-append-base
file-append-suffix
+ raw-derivation-file
+ raw-derivation-file?
+
load-path-expression
gexp-modules
(with-monad %store-monad
(return drv)))
+;; Expand to a raw ".drv" file for the lowerable object it wraps. In other
+;; words, this gives the raw ".drv" file instead of its build result.
+(define-record-type <raw-derivation-file>
+ (raw-derivation-file obj)
+ raw-derivation-file?
+ (obj raw-derivation-file-object)) ;lowerable object
+
+(define-gexp-compiler raw-derivation-file-compiler <raw-derivation-file>
+ compiler => (lambda (obj system target)
+ (mlet %store-monad ((obj (lower-object
+ (raw-derivation-file-object obj)
+ system #:target target)))
+ ;; Returning the .drv file name instead of the <derivation>
+ ;; record ensures that 'lower-gexp' will classify it as a
+ ;; "source" and not as an "input".
+ (return (if (derivation? obj)
+ (derivation-file-name obj)
+ obj))))
+ expander => (lambda (obj lowered output)
+ (if (derivation? lowered)
+ (derivation-file-name lowered)
+ lowered)))
+
\f
;;;
;;; File declarations.
appears."
(syntax-case s ()
((_ file rest ...)
+ (string? (syntax->datum #'file))
+ ;; FILE is a literal, so resolve it relative to the source directory.
#'(%local-file file
(delay (absolute-file-name file (current-source-directory)))
rest ...))
+ ((_ file rest ...)
+ ;; Resolve FILE relative to the current directory.
+ #'(%local-file file
+ (delay (absolute-file-name file (getcwd)))
+ rest ...))
((_)
#'(syntax-error "missing file name"))
(id
;; Compile FILE by returning a derivation that builds the file.
(match file
(($ <scheme-file> name gexp splice?)
- (gexp->file name gexp #:splice? splice?))))
+ (gexp->file name gexp
+ #:splice? splice?
+ #:system system
+ #:target target))))
;; Appending SUFFIX to BASE's output file name.
(define-record-type <file-append>
(or (pred x)
(one-of rest ...))))))
(one-of symbol? string? keyword? pair? null? array?
- number? boolean?)))
+ number? boolean? char?)))
(define* (reference->sexp ref #:optional native?)
(with-monad %store-monad
(chmod port #o555))))
#:system system
#:target target
- #:module-path module-path)))
+ #:module-path module-path
+
+ ;; These derivations are not worth offloading or
+ ;; substituting.
+ #:local-build? #t
+ #:substitutable? #f)))
(define* (gexp->file name exp #:key
(set-load-path? #t)
(module-path %load-path)
- (splice? #f))
+ (splice? #f)
+ (system (%current-system))
+ target)
"Return a derivation that builds a file NAME containing EXP. When SPLICE?
is true, EXP is considered to be a list of expressions that will be spliced in
the resulting file.
exp
(gexp ((ungexp exp)))))))))
#:local-build? #t
- #:substitutable? #f)
+ #:substitutable? #f
+ #:system system
+ #:target target)
(mlet %store-monad ((set-load-path
(load-path-expression modules module-path
- #:extensions extensions)))
+ #:extensions extensions
+ #:system system
+ #:target target)))
(gexp->derivation name
(gexp
(call-with-output-file (ungexp output)
(gexp ((ungexp exp)))))))))
#:module-path module-path
#:local-build? #t
- #:substitutable? #f))))
+ #:substitutable? #f
+ #:system system
+ #:target target))))
(define* (text-file* name #:rest text)
"Return as a monadic value a derivation that builds a text file containing