mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2025-02-08 12:20:35 +01:00
store: Change 'store-lower' to preserve the original procedure's documentation.
* guix/store.scm (preserve-documentation): New procedure. (store-lift, store-lower): Use it.
This commit is contained in:
parent
561fb6c31f
commit
5808dcc27c
1 changed files with 13 additions and 10 deletions
|
@ -862,23 +862,26 @@ be used internally by the daemon's build hook."
|
||||||
(define-alias store-return state-return)
|
(define-alias store-return state-return)
|
||||||
(define-alias store-bind state-bind)
|
(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)
|
(define (store-lift proc)
|
||||||
"Lift PROC, a procedure whose first argument is a connection to the store,
|
"Lift PROC, a procedure whose first argument is a connection to the store,
|
||||||
in the store monad."
|
in the store monad."
|
||||||
(define result
|
(preserve-documentation proc
|
||||||
(lambda args
|
(lambda args
|
||||||
(lambda (store)
|
(lambda (store)
|
||||||
(values (apply proc store args) store))))
|
(values (apply proc store args) store)))))
|
||||||
|
|
||||||
(set-object-property! result 'documentation
|
|
||||||
(procedure-property proc 'documentation))
|
|
||||||
result)
|
|
||||||
|
|
||||||
(define (store-lower proc)
|
(define (store-lower proc)
|
||||||
"Lower PROC, a monadic procedure in %STORE-MONAD, to a \"normal\" procedure
|
"Lower PROC, a monadic procedure in %STORE-MONAD, to a \"normal\" procedure
|
||||||
taking the store as its first argument."
|
taking the store as its first argument."
|
||||||
(lambda (store . args)
|
(preserve-documentation proc
|
||||||
(run-with-store store (apply proc args))))
|
(lambda (store . args)
|
||||||
|
(run-with-store store (apply proc args)))))
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; Store monad operators.
|
;; Store monad operators.
|
||||||
|
|
Loading…
Add table
Reference in a new issue