diff options
Diffstat (limited to 'guix/monads.scm')
| -rw-r--r-- | guix/monads.scm | 73 |
1 files changed, 1 insertions, 72 deletions
diff --git a/guix/monads.scm b/guix/monads.scm index 65683e65de..20fee79602 100644 --- a/guix/monads.scm +++ b/guix/monads.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -57,7 +57,6 @@ store-lift run-with-store text-file - text-file* interned-file package-file origin->derivation @@ -357,56 +356,6 @@ 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)))) - - ;; TODO: Rewrite using 'gexp->derivation'. - (mlet %store-monad ((inputs (lower-inputs 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 @@ -440,26 +389,6 @@ cross-compilation target triplet." (string-append out "/" file) out)))) -(define (lower-inputs inputs) - "Turn any package from INPUTS into a derivation; return the corresponding -input list as a monadic value." - ;; XXX: This procedure is bound to disappear with 'derivation-expression'. - (with-monad %store-monad - (sequence %store-monad - (map (match-lambda - ((name (? package? package) sub-drv ...) - (mlet %store-monad ((drv (package->derivation package))) - (return `(,name ,drv ,@sub-drv)))) - ((name (? string? file)) - (return `(,name ,file))) - (tuple - (return tuple))) - inputs)))) - -(define derivation-expression - ;; XXX: This procedure is superseded by 'gexp->derivation'. - (store-lift build-expression->derivation)) - (define package->derivation (store-lift package-derivation)) |