nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

monads: Add 'text-file*'. 

* guix/monads.scm (text-file*): New procedure.
* tests/monads.scm ("text-file*"): New test.
* doc/guix.texi (The Store Monad): Change example since the previous one
  would erroneously fail to retain a reference to Coreutils.  Document
  'text-file*'.
master
Ludovic Courtès 2014-02-03 23:12:54 +01:00
parent 67995f4bea
commit 45adbd624f
3 changed files with 113 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
doc/guix.texi
View File

@ -1590,23 +1590,22 @@ in a monad---values that carry this additional context---are called
Consider this ``normal'' procedure:
@example
(define (profile.sh store)
;; Return the name of a shell script in the store that
;; initializes the 'PATH' environment variable.
(let* ((drv (package-derivation store coreutils))
(out (derivation->output-path drv)))
(add-text-to-store store "profile.sh"
(format #f "export PATH=~a/bin" out))))
(define (sh-symlink store)
;; Return a derivation that symlinks the 'bash' executable.
(let* ((drv (package-derivation store bash))
(out (derivation->output-path drv))
(sh (string-append out "/bin/bash")))
(build-expression->derivation store "sh"
`(symlink ,sh %output))))
@end example
Using @code{(guix monads)}, it may be rewritten as a monadic function:
@example
(define (profile.sh)
(define (sh-symlink)
;; Same, but return a monadic value.
(mlet %store-monad ((bin (package-file coreutils "bin")))
(text-file "profile.sh"
(string-append "export PATH=" bin))))
(mlet %store-monad ((sh (package-file bash "bin")))
(derivation-expression "sh" `(symlink ,sh %output))))
@end example
There are two things to note in the second version: the @code{store}
@ -1672,7 +1671,32 @@ open store connection.
@deffn {Monadic Procedure} text-file @var{name} @var{text}
Return as a monadic value the absolute file name in the store of the file
containing @var{text}.
containing @var{text}, a string.
@end deffn
@deffn {Monadic Procedure} text-file* @var{name} @var{text} @dots{}
Return as a monadic value a derivation that builds a text file
containing all of @var{text}. @var{text} may list, in addition to
strings, packages, derivations, and store file names; the resulting
store file holds references to all these.
This variant should be preferred over @code{text-file} anytime the file
to create will reference items from the store. This is typically the
case when building a configuration file that embeds store file names,
like this:
@example
(define (profile.sh)
;; Return the name of a shell script in the store that
;; initializes the 'PATH' environment variable.
(text-file* "profile.sh"
"export PATH=" coreutils "/bin:"
grep "/bin:" sed "/bin\n"))
@end example
In this example, the resulting @file{/nix/store/@dots{}-profile.sh} file
will references @var{coreutils}, @var{grep}, and @var{sed}, thereby
preventing them from being garbage-collected during its lifetime.
@end deffn
@deffn {Monadic Procedure} package-file @var{package} [@var{file}] @

53
guix/monads.scm
View File

@ -23,6 +23,7 @@
#:use-module ((system syntax)
#:select (syntax-local-binding))
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:export (;; Monads.
@ -53,6 +54,7 @@
store-lift
run-with-store
text-file
text-file*
package-file
package->derivation
built-derivations
@ -305,10 +307,59 @@ in the store monad."
(define* (text-file name text)
"Return as a monadic value the absolute file name in the store of the file
containing TEXT."
containing TEXT, a string."
(lambda (store)
(add-text-to-store store name text '())))
(define* (text-file* name #:rest text)
"Return as a monadic value a derivation that builds a text file containing
all of TEXT. TEXT may list, in addition to strings, packages, derivations,
and store file names; the resulting store file holds references to all these."
(define inputs
;; Transform packages and derivations from TEXT into a valid input list.
(filter-map (match-lambda
((? package? p) `("x" ,p))
((? derivation? d) `("x" ,d))
((x ...) `("x" ,@x))
((? string? s)
(and (direct-store-path? s) `("x" ,s)))
(x x))
text))
(define (computed-text text inputs)
;; Using the lowered INPUTS, return TEXT with derivations replaced with
;; their output file name.
(define (real-string? s)
(and (string? s) (not (direct-store-path? s))))
(let loop ((inputs inputs)
(text text)
(result '()))
(match text
(()
(string-concatenate-reverse result))
(((? real-string? head) rest ...)
(loop inputs rest (cons head result)))
((_ rest ...)
(match inputs
(((_ (? derivation? drv) sub-drv ...) inputs ...)
(loop inputs rest
(cons (apply derivation->output-path drv
sub-drv)
result)))
(((_ file) inputs ...)
;; FILE is the result of 'add-text-to-store' or so.
(loop inputs rest (cons file result))))))))
(define (builder inputs)
`(call-with-output-file (assoc-ref %outputs "out")
(lambda (port)
(display ,(computed-text text inputs) port))))
(mlet %store-monad ((inputs (lower-inputs inputs)))
(derivation-expression name (builder inputs)
#:inputs inputs)))
(define* (package-file package
#:optional file
#:key (system (%current-system)) (output "out"))

26
tests/monads.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -126,6 +126,30 @@
(readlink (string-append out "/guile-rocks"))))))
#:guile-for-build (package-derivation %store %bootstrap-guile)))
(test-assert "text-file*"
(let ((references (store-lift references)))
(run-with-store %store
(mlet* %store-monad
((drv (package->derivation %bootstrap-guile))
(guile -> (derivation->output-path drv))
(file (text-file "bar" "This is bar."))
(text (text-file* "foo"
%bootstrap-guile "/bin/guile "
`(,%bootstrap-guile "out") "/bin/guile "
drv "/bin/guile "
file))
(done (built-derivations (list text)))
(out -> (derivation->output-path text))
(refs (references out)))
;; Make sure we get the right references and the right content.
(return (and (lset= string=? refs (list guile file))
(equal? (call-with-input-file out get-string-all)
(string-append guile "/bin/guile "
guile "/bin/guile "
guile "/bin/guile "
file)))))
#:guile-for-build (package-derivation %store %bootstrap-guile))))
(test-assert "mapm"
(every (lambda (monad run)
(with-monad monad