summaryrefslogtreecommitdiff
path: root/forge/forge.scm
diff options
context:
space:
mode:
authorArun Isaac2022-02-28 14:13:23 +0530
committerArun Isaac2022-02-28 18:08:53 +0530
commit8b900587e7e4334170191aec22b117034f4c39ed (patch)
tree14c78eba4a0009b4714bc6b184741a3abb54c085 /forge/forge.scm
parenta744674532b3af1f0d2e212e1579621db08df585 (diff)
downloadguix-forge-8b900587e7e4334170191aec22b117034f4c39ed.tar.gz
guix-forge-8b900587e7e4334170191aec22b117034f4c39ed.tar.lz
guix-forge-8b900587e7e4334170191aec22b117034f4c39ed.zip
forge: Do not use use-modules in derivation-job-gexp.
This composes better. * forge/forge.scm (derivation-job-gexp): Do not use use-modules.
Diffstat (limited to 'forge/forge.scm')
-rw-r--r--forge/forge.scm86
1 files changed, 53 insertions, 33 deletions
diff --git a/forge/forge.scm b/forge/forge.scm
index 73eeb67..5814593 100644
--- a/forge/forge.scm
+++ b/forge/forge.scm
@@ -173,39 +173,59 @@ file name or URI designating the Guix daemon endpoint."
(with-extensions (list guile-gcrypt guile-zlib)
(with-packages (list git-minimal nss-certs)
#~(begin
- (use-modules (forge build git)
- (guix derivations)
- (guix gexp)
- (guix monads)
- (guix store)
- (rnrs exceptions))
-
- (let ((derivation-output
- (parameterize ((%daemon-socket-uri #$guix-daemon-uri))
- (with-store store
- (guard (condition ((store-protocol-error? condition)
- (exit #f)))
- (run-with-store store
- (mlet* %store-monad ((git-checkout (latest-git-checkout
- #$(string-append (forge-project-name project)
- "-checkout")
- #$(forge-project-repository project)
- #$(forge-project-repository-branch project)
- #:show-commit? #t))
- (drv (gexp->derivation #$(string-append
- (forge-laminar-job-name job)
- "-derivation")
- (#$gexp-producer git-checkout)
- #:guile-for-build (read-derivation-from-file
- #$(raw-derivation-file
- (with-store store
- (package-derivation store guile-3.0))))
- #:substitutable? #f)))
- (mbegin %store-monad
- (built-derivations (list drv))
- (return (derivation->output-path drv))))))))))
- (format (current-error-port) "Built ~a successfully~%" derivation-output)
- derivation-output))))))
+ ;; We pull out macros using module-ref and functions using
+ ;; @@ instead of using use-modules because this gexp might
+ ;; be substituted into other gexps and use-modules only
+ ;; works at the top-level.
+ (let-syntax ((guard (macro-transformer
+ (module-ref (resolve-module '(rnrs exceptions))
+ 'guard)))
+ (mbegin (macro-transformer
+ (module-ref (resolve-module '(guix monads))
+ 'mbegin)))
+ (mlet* (macro-transformer
+ (module-ref (resolve-module '(guix monads))
+ 'mlet*)))
+ (with-store (macro-transformer
+ (module-ref (resolve-module '(guix store))
+ 'with-store)))
+ (return (identifier-syntax ((@@ (guix store) %store-monad)
+ %return))))
+ (let* ((latest-git-checkout (@@ (forge build git) latest-git-checkout))
+ (built-derivations (@@ (guix derivations) built-derivations))
+ (derivation->output-path (@@ (guix derivations) derivation->output-path))
+ (read-derivation-from-file (@@ (guix derivations) read-derivation-from-file))
+ (gexp->derivation (@@ (guix gexp) gexp->derivation))
+ (%daemon-socket-uri (@@ (guix store) %daemon-socket-uri))
+ (%store-monad (@@ (guix store) %store-monad))
+ (store-protocol-error? (@@ (guix store) store-protocol-error?))
+ (run-with-store (@@ (guix store) run-with-store))
+ (derivation-output
+ (parameterize ((%daemon-socket-uri #$guix-daemon-uri))
+ (with-store store
+ (guard (condition ((store-protocol-error? condition)
+ (exit #f)))
+ (run-with-store store
+ (mlet* %store-monad ((git-checkout (latest-git-checkout
+ #$(string-append (forge-project-name project)
+ "-checkout")
+ #$(forge-project-repository project)
+ #$(forge-project-repository-branch project)
+ #:show-commit? #t))
+ (drv (gexp->derivation #$(string-append
+ (forge-laminar-job-name job)
+ "-derivation")
+ (#$gexp-producer git-checkout)
+ #:guile-for-build (read-derivation-from-file
+ #$(raw-derivation-file
+ (with-store store
+ (package-derivation store guile-3.0))))
+ #:substitutable? #f)))
+ (mbegin %store-monad
+ (built-derivations (list drv))
+ (return (derivation->output-path drv))))))))))
+ (format (current-error-port) "Built ~a successfully~%" derivation-output)
+ derivation-output)))))))
(define forge-service-type
(service-type