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