TakeV/guix
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

import/print: package->code: Wrap S-expression in definition.

Browse source 
* guix/import/print.scm (package->code): Return a definition, not just a
package expression.
This commit is contained in:
Ricardo Wurmus 2020-04-15 00:39:45 +02:00
parent c893432320
commit 86a3b540d0
No known key found for this signature in database
GPG key ID: 197A5888235FACAC
1 changed files with 44 additions and 43 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

87
guix/import/print.scm
View file

@ -121,46 +121,47 @@ (define (package-lists->code lsts)
(home-page (package-home-page package)) (home-page (package-home-page package))
(supported-systems (package-supported-systems package)) (supported-systems (package-supported-systems package))
(properties (package-properties package))) (properties (package-properties package)))
`(package `(define-public ,(string->symbol name)
(name ,name) (package
(version ,version) (name ,name)
(source ,(source->code source version)) (version ,version)
,@(match properties (source ,(source->code source version))
(() '()) ,@(match properties
(_ `((properties ,properties)))) (() '())
,@(if replacement (_ `((properties ,properties))))
`((replacement ,replacement)) ,@(if replacement
'()) `((replacement ,replacement))
(build-system (@ (guix build-system ,(build-system-name build-system)) '())
,(symbol-append (build-system-name build-system) (build-system (@ (guix build-system ,(build-system-name build-system))
'-build-system))) ,(symbol-append (build-system-name build-system)
,@(match arguments '-build-system)))
(() '()) ,@(match arguments
(args `((arguments ,(list 'quasiquote args))))) (() '())
,@(match outputs (args `((arguments ,(list 'quasiquote args)))))
(("out") '()) ,@(match outputs
(outs `((outputs (list ,@outs))))) (("out") '())
,@(match native-inputs (outs `((outputs (list ,@outs)))))
(() '()) ,@(match native-inputs
(pkgs `((native-inputs ,(package-lists->code pkgs))))) (() '())
,@(match inputs (pkgs `((native-inputs ,(package-lists->code pkgs)))))
(() '()) ,@(match inputs
(pkgs `((inputs ,(package-lists->code pkgs))))) (() '())
,@(match propagated-inputs (pkgs `((inputs ,(package-lists->code pkgs)))))
(() '()) ,@(match propagated-inputs
(pkgs `((propagated-inputs ,(package-lists->code pkgs))))) (() '())
,@(if (lset= string=? supported-systems %supported-systems) (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) `((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 `((native-search-paths (list ,@paths)))))
(() '()) ,@(match (map search-path-specification->code search-paths)
(paths `((search-paths (list ,@paths))))) (() '())
(home-page ,home-page) (paths `((search-paths (list ,@paths)))))
(synopsis ,synopsis) (home-page ,home-page)
(description ,description) (synopsis ,synopsis)
(license ,(if (list? license) (description ,description)
`(list ,@(map license->code license)) (license ,(if (list? license)
(license->code license)))))) `(list ,@(map license->code license))
(license->code license)))))))