summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-07-24 22:27:35 +0200
committerLudovic Courtès <ludo@gnu.org>2014-07-24 23:02:26 +0200
commit0a90af153199b03deced53da7ef7f50f0e561f80 (patch)
tree38c39490e95c2f2efc61ef9ab74de1bffd35e851
parent7ab44369b34a23e5d22ac51b7fbfe31c0de9fbfd (diff)
monads: Add 'interned-file'.
* guix/monads.scm (interned-file): New procedure. * tests/monads.scm ("interned-file"): New test. * doc/guix.texi (The Store Monad): Document it.
-rw-r--r--doc/guix.texi23
-rw-r--r--guix/monads.scm13
-rw-r--r--tests/monads.scm10
3 files changed, 46 insertions, 0 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 2f44ce9506..c504a5d0ba 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2012,6 +2012,29 @@ will references @var{coreutils}, @var{grep}, and @var{sed}, thereby
preventing them from being garbage-collected during its lifetime.
@end deffn
+@deffn {Monadic Procedure} interned-file @var{file} [@var{name}] @
+ [#:recursive? #t]
+Return the name of @var{file} once interned in the store. Use
+@var{name} as its store name, or the basename of @var{file} if
+@var{name} is omitted.
+
+When @var{recursive?} is true, the contents of @var{file} are added
+recursively; if @var{file} designates a flat file and @var{recursive?}
+is true, its contents are added, and its permission bits are kept.
+
+The example below adds a file to the store, under two different names:
+
+@example
+(run-with-store (open-connection)
+ (mlet %store-monad ((a (interned-file "README"))
+ (b (interned-file "README" "LEGU-MIN")))
+ (return (list a b))))
+
+@result{} ("/gnu/store/rwm@dots{}-README" "/gnu/store/44i@dots{}-LEGU-MIN")
+@end example
+
+@end deffn
+
@deffn {Monadic Procedure} package-file @var{package} [@var{file}] @
[#:system (%current-system)] [#:output "out"] Return as a monadic
value in the absolute file name of @var{file} within the @var{output}
diff --git a/guix/monads.scm b/guix/monads.scm
index c2c6f1a03d..4af2b704ab 100644
--- a/guix/monads.scm
+++ b/guix/monads.scm
@@ -55,6 +55,7 @@
run-with-store
text-file
text-file*
+ interned-file
package-file
origin->derivation
package->derivation
@@ -362,6 +363,18 @@ and store file names; the resulting store file holds references to all these."
(derivation-expression name (builder inputs)
#:inputs inputs)))
+(define* (interned-file file #:optional name
+ #:key (recursive? #t))
+ "Return the name of FILE once interned in the store. Use NAME as its store
+name, or the basename of FILE if NAME is omitted.
+
+When RECURSIVE? is true, the contents of FILE are added recursively; if FILE
+designates a flat file and RECURSIVE? is true, its contents are added, and its
+permission bits are kept."
+ (lambda (store)
+ (add-to-store store (or name (basename file))
+ recursive? "sha256" file)))
+
(define* (package-file package
#:optional file
#:key (system (%current-system)) (output "out"))
diff --git a/tests/monads.scm b/tests/monads.scm
index ac19d33f93..ea3e4006ab 100644
--- a/tests/monads.scm
+++ b/tests/monads.scm
@@ -108,6 +108,16 @@
guile)))
#:guile-for-build (package-derivation %store %bootstrap-guile)))
+(test-assert "interned-file"
+ (run-with-store %store
+ (mlet* %store-monad ((file -> (search-path %load-path "guix.scm"))
+ (a (interned-file file))
+ (b (interned-file file "b")))
+ (return (equal? (call-with-input-file file get-string-all)
+ (call-with-input-file a get-string-all)
+ (call-with-input-file b get-string-all))))
+ #:guile-for-build (package-derivation %store %bootstrap-guile)))
+
(define derivation-expression
(@@ (guix monads) derivation-expression))