From 462a3fa36cddeb683df765b2982f76712f6c40f0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 12 Jan 2015 23:26:52 +0100 Subject: monads: Rewrite 'text-file*' using gexps. * guix/monads.scm (text-file*): Move to... * guix/gexp.scm (text-file*): ... here. Rewrite using gexps. * tests/monads.scm ("text-file*"): Move to... * tests/gexp.scm ("text-file*"): ... here. --- guix/monads.scm | 53 +---------------------------------------------------- 1 file changed, 1 insertion(+), 52 deletions(-) (limited to 'guix/monads.scm') diff --git a/guix/monads.scm b/guix/monads.scm index 65683e65de..63c9cd8cfd 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 +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès ;;; ;;; 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 -- cgit v1.2.3