diff options
Diffstat (limited to 'guix/store.scm')
-rw-r--r-- | guix/store.scm | 86 |
1 files changed, 85 insertions, 1 deletions
diff --git a/guix/store.scm b/guix/store.scm index 571cc060d3..d3e94625a7 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,6 +20,7 @@ #:use-module (guix utils) #:use-module (guix config) #:use-module (guix serialization) + #:use-module (guix monads) #:autoload (guix base32) (bytevector->base32-string) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) @@ -94,6 +95,15 @@ register-path + %store-monad + store-bind + store-return + store-lift + run-with-store + %guile-for-build + text-file + interned-file + %store-prefix store-path? direct-store-path? @@ -836,6 +846,80 @@ be used internally by the daemon's build hook." ;;; +;;; Store monad. +;;; + +;; return:: a -> StoreM a +(define-inlinable (store-return value) + "Return VALUE from a monadic function." + ;; The monadic value is just this. + (lambda (store) + value)) + +;; >>=:: StoreM a -> (a -> StoreM b) -> StoreM b +(define-inlinable (store-bind mvalue mproc) + "Bind MVALUE in MPROC." + (lambda (store) + (let* ((value (mvalue store)) + (mresult (mproc value))) + (mresult store)))) + +;; This is essentially a state monad +(define-monad %store-monad + (bind store-bind) + (return store-return)) + +(define (store-lift proc) + "Lift PROC, a procedure whose first argument is a connection to the store, +in the store monad." + (define result + (lambda args + (lambda (store) + (apply proc store args)))) + + (set-object-property! result 'documentation + (procedure-property proc 'documentation)) + result) + +;; +;; Store monad operators. +;; + +(define* (text-file name text) + "Return as a monadic value the absolute file name in the store of the file +containing TEXT, a string." + (lambda (store) + (add-text-to-store store name text '()))) + +(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 %guile-for-build + ;; The derivation of the Guile to be used within the build environment, + ;; when using 'gexp->derivation' and co. + (make-parameter #f)) + +(define* (run-with-store store mval + #:key + (guile-for-build (%guile-for-build)) + (system (%current-system))) + "Run MVAL, a monadic value in the store monad, in STORE, an open store +connection." + (parameterize ((%guile-for-build guile-for-build) + (%current-system system)) + (mval store))) + + +;;; ;;; Store paths. ;;; |