From 1475d45112243a37ae921df41977c4acf3064a6d Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Tue, 14 Apr 2020 17:23:33 +0200 Subject: import/print: Return license with prefix. * guix/import/print.scm (license->code): Prepend license: prefix. --- guix/import/print.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'guix/import/print.scm') diff --git a/guix/import/print.scm b/guix/import/print.scm index 4c2a91fa4f..b819e7cf90 100644 --- a/guix/import/print.scm +++ b/guix/import/print.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Ricardo Wurmus +;;; Copyright © 2017, 2020 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -57,7 +57,7 @@ when evaluated." ;; Print either license variable name or the code for a license object (define (license->code lic) (let ((var (variable-name lic '(guix licenses)))) - (or var + (or (symbol-append 'license: var) `(license (name ,(license-name lic)) (uri ,(license-uri lic)) -- cgit v1.2.3 From 6269dd567e85c78a87be8d55f7ddc801a0ea870c Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Tue, 14 Apr 2020 17:24:09 +0200 Subject: import/print: package->code: Wrap build system value in module reference. * guix/import/print.scm (package->code): Return build system value with corresponding module. --- guix/import/print.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'guix/import/print.scm') diff --git a/guix/import/print.scm b/guix/import/print.scm index b819e7cf90..4529a79b23 100644 --- a/guix/import/print.scm +++ b/guix/import/print.scm @@ -131,8 +131,9 @@ when evaluated." ,@(if replacement `((replacement ,replacement)) '()) - (build-system ,(symbol-append (build-system-name build-system) - '-build-system)) + (build-system (@ (guix build-system ,(build-system-name build-system)) + ,(symbol-append (build-system-name build-system) + '-build-system))) ,@(match arguments (() '()) (args `((arguments ,(list 'quasiquote args))))) -- cgit v1.2.3 From 86a3b540d08e0ece2a697f7caa6342a55394a6b3 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 15 Apr 2020 00:39:45 +0200 Subject: import/print: package->code: Wrap S-expression in definition. * guix/import/print.scm (package->code): Return a definition, not just a package expression. --- guix/import/print.scm | 87 ++++++++++++++++++++++++++------------------------- 1 file changed, 44 insertions(+), 43 deletions(-) (limited to 'guix/import/print.scm') diff --git a/guix/import/print.scm b/guix/import/print.scm index 4529a79b23..08f3ec9c34 100644 --- a/guix/import/print.scm +++ b/guix/import/print.scm @@ -121,46 +121,47 @@ when evaluated." (home-page (package-home-page package)) (supported-systems (package-supported-systems package)) (properties (package-properties package))) - `(package - (name ,name) - (version ,version) - (source ,(source->code source version)) - ,@(match properties - (() '()) - (_ `((properties ,properties)))) - ,@(if replacement - `((replacement ,replacement)) - '()) - (build-system (@ (guix build-system ,(build-system-name build-system)) - ,(symbol-append (build-system-name build-system) - '-build-system))) - ,@(match arguments - (() '()) - (args `((arguments ,(list 'quasiquote args))))) - ,@(match outputs - (("out") '()) - (outs `((outputs (list ,@outs))))) - ,@(match native-inputs - (() '()) - (pkgs `((native-inputs ,(package-lists->code pkgs))))) - ,@(match inputs - (() '()) - (pkgs `((inputs ,(package-lists->code pkgs))))) - ,@(match propagated-inputs - (() '()) - (pkgs `((propagated-inputs ,(package-lists->code pkgs))))) - ,@(if (lset= string=? supported-systems %supported-systems) - '() - `((supported-systems (list ,@supported-systems)))) - ,@(match (map search-path-specification->code native-search-paths) - (() '()) - (paths `((native-search-paths (list ,@paths))))) - ,@(match (map search-path-specification->code search-paths) - (() '()) - (paths `((search-paths (list ,@paths))))) - (home-page ,home-page) - (synopsis ,synopsis) - (description ,description) - (license ,(if (list? license) - `(list ,@(map license->code license)) - (license->code license)))))) + `(define-public ,(string->symbol name) + (package + (name ,name) + (version ,version) + (source ,(source->code source version)) + ,@(match properties + (() '()) + (_ `((properties ,properties)))) + ,@(if replacement + `((replacement ,replacement)) + '()) + (build-system (@ (guix build-system ,(build-system-name build-system)) + ,(symbol-append (build-system-name build-system) + '-build-system))) + ,@(match arguments + (() '()) + (args `((arguments ,(list 'quasiquote args))))) + ,@(match outputs + (("out") '()) + (outs `((outputs (list ,@outs))))) + ,@(match native-inputs + (() '()) + (pkgs `((native-inputs ,(package-lists->code pkgs))))) + ,@(match inputs + (() '()) + (pkgs `((inputs ,(package-lists->code pkgs))))) + ,@(match propagated-inputs + (() '()) + (pkgs `((propagated-inputs ,(package-lists->code pkgs))))) + ,@(if (lset= string=? supported-systems %supported-systems) + '() + `((supported-systems (list ,@supported-systems)))) + ,@(match (map search-path-specification->code native-search-paths) + (() '()) + (paths `((native-search-paths (list ,@paths))))) + ,@(match (map search-path-specification->code search-paths) + (() '()) + (paths `((search-paths (list ,@paths))))) + (home-page ,home-page) + (synopsis ,synopsis) + (description ,description) + (license ,(if (list? license) + `(list ,@(map license->code license)) + (license->code license))))))) -- cgit v1.2.3 From 3532fc39fff41eabd061370ee36a1d42b9fac0e6 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 15 Apr 2020 00:41:03 +0200 Subject: import/utils: alist->package: Ignore known inputs. * guix/import/utils.scm (alist->package): Accept optional list of known inputs, which are excluded from the specification lookup. * guix/import/print.scm (package->code)[package-lists->code]: Handle inputs which are just symbols. --- guix/import/print.scm | 2 ++ guix/import/utils.scm | 27 ++++++++++++++++----------- 2 files changed, 18 insertions(+), 11 deletions(-) (limited to 'guix/import/print.scm') diff --git a/guix/import/print.scm b/guix/import/print.scm index 08f3ec9c34..471687c0ff 100644 --- a/guix/import/print.scm +++ b/guix/import/print.scm @@ -92,6 +92,8 @@ when evaluated." (define (package-lists->code lsts) (list 'quasiquote (map (match-lambda + ((? symbol? s) + (list (symbol->string s) (list 'unquote s))) ((label pkg . out) (let ((mod (package-module-name pkg))) (cons* label diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 94c8cb040b..5fb1322535 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2012, 2013, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2016 Jelle Licht ;;; Copyright © 2016 David Craven -;;; Copyright © 2017, 2019 Ricardo Wurmus +;;; Copyright © 2017, 2019, 2020 Ricardo Wurmus ;;; Copyright © 2018 Oleg Pykhalov ;;; Copyright © 2019 Robert Vollmert ;;; @@ -310,7 +310,18 @@ the expected fields of an object." (uri (assoc-ref orig "uri")) (sha256 sha)))))) -(define (alist->package meta) +(define* (alist->package meta #:optional (known-inputs '())) + "Return a package value generated from the alist META. If the list of +strings KNOWN-INPUTS is provided, do not treat the mentioned inputs as +specifications to look up and replace them with plain symbols instead." + (define (process-inputs which) + (let-values (((regular known) + (lset-diff+intersection + string=? + (vector->list (or (assoc-ref meta which) #())) + known-inputs))) + (append (specs->package-lists regular) + (map string->symbol known)))) (package (name (assoc-ref meta "name")) (version (assoc-ref meta "version")) @@ -318,15 +329,9 @@ the expected fields of an object." (build-system (lookup-build-system-by-name (string->symbol (assoc-ref meta "build-system")))) - (native-inputs - (specs->package-lists - (vector->list (or (assoc-ref meta "native-inputs") '#())))) - (inputs - (specs->package-lists - (vector->list (or (assoc-ref meta "inputs") '#())))) - (propagated-inputs - (specs->package-lists - (vector->list (or (assoc-ref meta "propagated-inputs") '#())))) + (native-inputs (process-inputs "native-inputs")) + (inputs (process-inputs "inputs")) + (propagated-inputs (process-inputs "propagated-inputs")) (home-page (assoc-ref meta "home-page")) (synopsis -- cgit v1.2.3 From 3c0422b9be649e0a09caa0b893713a9f07855cd3 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Thu, 16 Apr 2020 22:09:41 +0200 Subject: import/print: Don't factorize URI if there's no version match. * guix/import/print.scm (package->code): If FACTORIZE-URI returns just the unmodified string use that as the URI. --- guix/import/print.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'guix/import/print.scm') diff --git a/guix/import/print.scm b/guix/import/print.scm index 471687c0ff..11cc218285 100644 --- a/guix/import/print.scm +++ b/guix/import/print.scm @@ -79,7 +79,9 @@ when evaluated." (patches (origin-patches source))) `(origin (method ,(procedure-name method)) - (uri (string-append ,@(factorize-uri uri version))) + (uri (string-append ,@(match (factorize-uri uri version) + ((? string? uri) (list uri)) + (factorized factorized)))) (sha256 (base32 ,(format #f "~a" (bytevector->nix-base32-string sha256)))) -- cgit v1.2.3