From 0a90af153199b03deced53da7ef7f50f0e561f80 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 24 Jul 2014 22:27:35 +0200
Subject: 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.
---
 doc/guix.texi    | 23 +++++++++++++++++++++++
 guix/monads.scm  | 13 +++++++++++++
 tests/monads.scm | 10 ++++++++++
 3 files changed, 46 insertions(+)

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 @@ (define-module (guix monads)
             run-with-store
             text-file
             text-file*
+            interned-file
             package-file
             origin->derivation
             package->derivation
@@ -362,6 +363,18 @@ (define (builder inputs)
     (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 @@ (define (g x)
                       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))
 
-- 
cgit v1.2.3