diff options
Diffstat (limited to 'guix/monads.scm')
| -rw-r--r-- | guix/monads.scm | 67 |
1 files changed, 63 insertions, 4 deletions
diff --git a/guix/monads.scm b/guix/monads.scm index 410fdbecb2..db8b645402 100644 --- a/guix/monads.scm +++ b/guix/monads.scm @@ -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. ;;; @@ -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,11 +54,14 @@ store-lift run-with-store text-file + text-file* package-file package->derivation built-derivations derivation-expression - lower-inputs)) + lower-inputs) + #:replace (imported-modules + compiled-modules)) ;;; Commentary: ;;; @@ -303,14 +307,63 @@ 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")) - "Return as a monadic value in the absolute file name of FILE within the + "Return as a monadic value the absolute file name of FILE within the OUTPUT directory of PACKAGE. When FILE is omitted, return the name of the OUTPUT directory of PACKAGE." (lambda (store) @@ -342,6 +395,12 @@ input list as a monadic value." (define package->derivation (store-lift package-derivation)) +(define imported-modules + (store-lift (@ (guix derivations) imported-modules))) + +(define compiled-modules + (store-lift (@ (guix derivations) compiled-modules))) + (define built-derivations (store-lift build-derivations)) |