[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
05/16: packages: Turn 'bag->derivation' into a monadic procedure.
From: |
Ludovic Courtès |
Subject: |
05/16: packages: Turn 'bag->derivation' into a monadic procedure. |
Date: |
Wed, 28 Jun 2017 17:48:54 -0400 (EDT) |
civodul pushed a commit to branch wip-build-systems-gexp
in repository guix.
commit 8724e57fe9b8cdd78d1d047aec0bed6d1ef7f812
Author: Ludovic Courtès <address@hidden>
Date: Sat Apr 4 22:05:15 2015 +0200
packages: Turn 'bag->derivation' into a monadic procedure.
* guix/packages.scm (bag->derivation): Turn into a monadic procedure by
remove 'store' parameter and removing the call to 'store-lower'.
(bag->cross-derivation): Likewise.
(bag->derivation*): New procedure.
(package-derivation, package-cross-derivation): Use it instead of
'bag->derivation'.
* tests/packages.scm ("bag->derivation"): Change to monadic style.
("bag->derivation, cross-compilation"): Likewise.
---
guix/packages.scm | 23 ++++++++++-------------
tests/packages.scm | 8 +++++---
2 files changed, 15 insertions(+), 16 deletions(-)
diff --git a/guix/packages.scm b/guix/packages.scm
index 550ddf7..dc0ae0b 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1041,13 +1041,12 @@ TARGET."
(bag (package->bag package system target)))
(bag-grafts store bag)))
-(define* (bag->derivation store bag
- #:optional context)
+(define* (bag->derivation bag #:optional context)
"Return the derivation to build BAG for SYSTEM. Optionally, CONTEXT can be
a package object describing the context in which the call occurs, for improved
error reporting."
(if (bag-target bag)
- (bag->cross-derivation store bag)
+ (bag->cross-derivation bag)
(let* ((system (bag-system bag))
(inputs (bag-transitive-inputs bag))
(paths (delete-duplicates
@@ -1060,15 +1059,12 @@ error reporting."
(inputs (map (cut expand-input context <>)
inputs)))
- ;; TODO: Change to monadic style.
- (apply (store-lower (bag-build bag))
- store (bag-name bag) inputs
+ (apply (bag-build bag) (bag-name bag) inputs
#:search-paths paths
#:outputs (bag-outputs bag) #:system system
(bag-arguments bag)))))
-(define* (bag->cross-derivation store bag
- #:optional context)
+(define* (bag->cross-derivation bag #:optional context)
"Return the derivation to build BAG, which is actually a cross build.
Optionally, CONTEXT can be a package object denoting the context of the call.
This is an internal procedure."
@@ -1098,9 +1094,7 @@ This is an internal procedure."
(_ '()))
all))))
- ;; TODO: Change to monadic style.
- (apply (store-lower (bag-build bag))
- store (bag-name bag)
+ (apply (bag-build bag) (bag-name bag)
#:native-drvs build-drvs
#:target-drvs (append host-drvs target-drvs)
#:search-paths paths
@@ -1109,6 +1103,9 @@ This is an internal procedure."
#:system system #:target target
(bag-arguments bag))))
+(define bag->derivation*
+ (store-lower bag->derivation))
+
(define* (package-derivation store package
#:optional (system (%current-system))
#:key (graft? (%graft?)))
@@ -1119,7 +1116,7 @@ This is an internal procedure."
;; system, will be queried many, many times in a row.
(cached package (cons system graft?)
(let* ((bag (package->bag package system #f #:graft? graft?))
- (drv (bag->derivation store bag package)))
+ (drv (bag->derivation* store bag package)))
(if graft?
(match (bag-grafts store bag)
(()
@@ -1142,7 +1139,7 @@ This is an internal procedure."
system identifying string)."
(cached package (list system target graft?)
(let* ((bag (package->bag package system target #:graft? graft?))
- (drv (bag->derivation store bag package)))
+ (drv (bag->derivation* store bag package)))
(if graft?
(match (bag-grafts store bag)
(()
diff --git a/tests/packages.scm b/tests/packages.scm
index 9547d2f..23cbb73 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -856,12 +856,13 @@
(("dep" package)
(eq? package dep)))))
-(test-assert "bag->derivation"
+(test-assertm "bag->derivation"
(parameterize ((%graft? #f))
(let ((bag (package->bag gnu-make))
(drv (package-derivation %store gnu-make)))
(parameterize ((%current-system "foox86-hurd")) ;should have no effect
- (equal? drv (bag->derivation %store bag))))))
+ (mlet %store-monad ((bag-drv (bag->derivation bag)))
+ (return (equal? drv bag-drv)))))))
(test-assert "bag->derivation, cross-compilation"
(parameterize ((%graft? #f))
@@ -870,7 +871,8 @@
(drv (package-cross-derivation %store gnu-make target)))
(parameterize ((%current-system "foox86-hurd") ;should have no effect
(%current-target-system "foo64-linux-gnu"))
- (equal? drv (bag->derivation %store bag))))))
+ (mlet %store-monad ((bag-drv (bag->derivation bag)))
+ (return (equal? drv bag-drv)))))))
(when (or (not (network-reachable?)) (shebang-too-long?))
(test-skip 1))
- branch wip-build-systems-gexp created (now 6ce5f33), Ludovic Courtès, 2017/06/28
- 08/16: packages: Simplify patch instantiation., Ludovic Courtès, 2017/06/28
- 03/16: gexp: Micro-optimize sexp serialization., Ludovic Courtès, 2017/06/28
- 04/16: tests: Add 'test-assertm' to (guix tests)., Ludovic Courtès, 2017/06/28
- 13/16: utils: Memoize 'absolute-dirname'., Ludovic Courtès, 2017/06/28
- 12/16: gexp: 'local-file' calls 'canonicalize-path' only in rare cases., Ludovic Courtès, 2017/06/28
- 14/16: download: 'built-in-builders*' relies on the functional cache., Ludovic Courtès, 2017/06/28
- 01/16: gnu: bootstrap: Move 'use-modules' forms to the beginning of build expressions., Ludovic Courtès, 2017/06/28
- 15/16: store: Add 'GUIX_PROFILING' support for the object cache., Ludovic Courtès, 2017/06/28
- 09/16: Use 'mapm' instead of 'sequence' + 'map'., Ludovic Courtès, 2017/06/28
- 05/16: packages: Turn 'bag->derivation' into a monadic procedure.,
Ludovic Courtès <=
- 11/16: packages: Turn 'cache!' into a single-value-return cache., Ludovic Courtès, 2017/06/28
- 06/16: store: Add a functional object cache and use it in 'lower-object'., Ludovic Courtès, 2017/06/28
- 10/16: gexp: 'imported-files' takes file-like objects., Ludovic Courtès, 2017/06/28
- 07/16: DRAFT gexp: Handle list conversion to <gexp-input> in the expanded code., Ludovic Courtès, 2017/06/28
- 16/16: packages: Core procedures are written in monadic style., Ludovic Courtès, 2017/06/28
- 02/16: build-system: Rewrite using gexps., Ludovic Courtès, 2017/06/28