ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gexp: Export 'gexp-input' constructor.

Browse source 
* guix/gexp.scm (<gexp-input>)[gexp-input]: Rename to...
  [%gexp-input]: ... this.  Adjust callers accordingly.
  (gexp-input): New procedure.
  (gexp-inputs)[add-reference-inputs]: When the input is a list, check
  whether each item is already 'gexp-input?' and to not rewrap those.
  (gexp-outputs)[add-reference-output]: Likewise.
  (gexp->sexp): Likewise.
* tests/gexp.scm ("input list splicing + gexp-input +
  ungexp-native-splicing"): New test.
This commit is contained in:
Ludovic Courtès 2015-03-15 21:45:37 +01:00
parent e39d146107
commit 0dbea56bbf
2 changed files with 41 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
guix/gexp.scm
View file

@ -29,6 +29,10 @@ (define-module (guix gexp)
#:use-module (ice-9 match)
#:export (gexp
gexp?
gexp-input
gexp-input?
gexp->derivation
gexp->file
gexp->script
@ -81,12 +85,19 @@ (define (write-gexp gexp port)
;; The input of a gexp.
(define-record-type <gexp-input>
(gexp-input thing output native?)
(%gexp-input thing output native?)
gexp-input?
(thing gexp-input-thing) ;<package> | <origin> | <derivation> | ...
(output gexp-input-output) ;string
(native? gexp-input-native?)) ;Boolean
(define* (gexp-input thing ;convenience procedure
#:optional (output "out")
#:key native?)
"Return a new <gexp-input> for the OUTPUT of THING; NATIVE? determines
whether this should be considered a \"native\" input or not."
(%gexp-input thing output native?))
;; Reference to one of the derivation's outputs, for gexps used in
;; derivations.
(define-record-type <gexp-output>
@ -309,7 +320,10 @@ (define (add-reference-inputs ref result)
(fold-right add-reference-inputs result
;; XXX: For now, automatically convert LST to a list of
;; gexp-inputs.
(map (cut gexp-input <> output native?) lst)))
(map (match-lambda
((? gexp-input? x) x)
(x (%gexp-input x "out" native?)))
lst)))
(_
;; Ignore references to other kinds of objects.
result)))
@ -331,7 +345,10 @@ (define (add-reference-output ref result)
(append (gexp-outputs exp) result))
(($ <gexp-input> (lst ...) output native?)
;; XXX: Automatically convert LST.
(add-reference-output (map (cut gexp-input <> output native?) lst)
(add-reference-output (map (match-lambda
((? gexp-input? x) x)
(x (%gexp-input x "out" native?)))
lst)
result))
((lst ...)
(fold-right add-reference-output result lst))
@ -379,8 +396,11 @@ (define* (reference->sexp ref #:optional native?)
(sequence %store-monad
(map (lambda (ref)
;; XXX: Automatically convert REF to an gexp-input.
(reference->sexp (gexp-input ref "out"
(or n? native?))))
(reference->sexp
(if (gexp-input? ref)
ref
(%gexp-input ref "out" n?))
native?))
refs)))
(($ <gexp-input> x)
(return x))
@ -453,17 +473,17 @@ (define (escape->ref exp)
((ungexp output name)
#'(gexp-output name))
((ungexp thing)
#'(gexp-input thing "out" #f))
#'(%gexp-input thing "out" #f))
((ungexp drv-or-pkg out)
#'(gexp-input drv-or-pkg out #f))
#'(%gexp-input drv-or-pkg out #f))
((ungexp-splicing lst)
#'(gexp-input lst "out" #f))
#'(%gexp-input lst "out" #f))
((ungexp-native thing)
#'(gexp-input thing "out" #t))
#'(%gexp-input thing "out" #t))
((ungexp-native drv-or-pkg out)
#'(gexp-input drv-or-pkg out #t))
#'(%gexp-input drv-or-pkg out #t))
((ungexp-native-splicing lst)
#'(gexp-input lst "out" #t))))
#'(%gexp-input lst "out" #t))))
(define (substitute-ungexp exp substs)
;; Given EXP, an 'ungexp' or 'ungexp-native' form, substitute it with

10
tests/gexp.scm
View file

@ -219,6 +219,16 @@ (define (match-input thing)
(equal? (gexp->sexp* exp) ;native
(gexp->sexp* exp "mips64el-linux")))))
(test-assert "input list splicing + gexp-input + ungexp-native-splicing"
(let* ((inputs (list (gexp-input glibc "debug") %bootstrap-guile))
(exp (gexp (list (ungexp-native-splicing (cons (+ 2 3) inputs))))))
(and (lset= equal?
`((,glibc "debug") (,%bootstrap-guile "out"))
(gexp-native-inputs exp))
(null? (gexp-inputs exp))
(equal? (gexp->sexp* exp) ;native
(gexp->sexp* exp "mips64el-linux")))))
(test-equal "output list"
2
(let ((exp (gexp (begin (mkdir (ungexp output))