diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-01-18 17:38:15 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-01-18 17:38:15 +0100 |
commit | 5808dcc27cf7288afcd3fa01c0b9e4669b697765 (patch) | |
tree | 4e1b49a7c58debe69b13445a3fbe519488307742 | |
parent | 561fb6c31fbbc9ae91bc2ce338cefc841b284644 (diff) | |
download | guix-5808dcc27cf7288afcd3fa01c0b9e4669b697765.tar.gz |
store: Change 'store-lower' to preserve the original procedure's documentation.
* guix/store.scm (preserve-documentation): New procedure. (store-lift, store-lower): Use it.
-rw-r--r-- | guix/store.scm | 23 |
1 files changed, 13 insertions, 10 deletions
diff --git a/guix/store.scm b/guix/store.scm index c3a1c57943..63425b3023 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -862,23 +862,26 @@ be used internally by the daemon's build hook." (define-alias store-return state-return) (define-alias store-bind state-bind) +(define (preserve-documentation original proc) + "Return PROC with documentation taken from ORIGINAL." + (set-object-property! proc 'documentation + (procedure-property original 'documentation)) + proc) + (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) - (values (apply proc store args) store)))) - - (set-object-property! result 'documentation - (procedure-property proc 'documentation)) - result) + (preserve-documentation proc + (lambda args + (lambda (store) + (values (apply proc store args) store))))) (define (store-lower proc) "Lower PROC, a monadic procedure in %STORE-MONAD, to a \"normal\" procedure taking the store as its first argument." - (lambda (store . args) - (run-with-store store (apply proc args)))) + (preserve-documentation proc + (lambda (store . args) + (run-with-store store (apply proc args))))) ;; ;; Store monad operators. |