store: Make '%store-monad' an alias for '%state-monad'.
* guix/store.scm (define-alias): New macro. (%store-monad, store-return, store-bind): Define as aliases of the corresponding %STATE-MONAD part. (store-lift, text-file, interned-file): Return STORE as a second value. (run-with-store): Use 'run-with-state'. * guix/packages.scm (set-guile-for-build, package-file): Return STORE as a second value. * guix/monads.scm: Remove part of the module commentary.
This commit is contained in:
parent
81a97734e0
commit
4e190c2803
3 changed files with 20 additions and 31 deletions
|
@ -67,10 +67,6 @@
|
||||||
;;; "Monadic Programming in Scheme" (see
|
;;; "Monadic Programming in Scheme" (see
|
||||||
;;; <http://okmij.org/ftp/Scheme/monad-in-Scheme.html>).
|
;;; <http://okmij.org/ftp/Scheme/monad-in-Scheme.html>).
|
||||||
;;;
|
;;;
|
||||||
;;; The store monad allows us to (1) build sequences of operations in the
|
|
||||||
;;; store, and (2) make the store an implicit part of the execution context,
|
|
||||||
;;; rather than a parameter of every single function.
|
|
||||||
;;;
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
;; Record type for monads manipulated at run time.
|
;; Record type for monads manipulated at run time.
|
||||||
|
|
|
@ -898,7 +898,7 @@ symbolic output name, such as \"out\". Note that this procedure calls
|
||||||
code of derivations to GUILE, a package object."
|
code of derivations to GUILE, a package object."
|
||||||
(lambda (store)
|
(lambda (store)
|
||||||
(let ((guile (package-derivation store guile)))
|
(let ((guile (package-derivation store guile)))
|
||||||
(%guile-for-build guile))))
|
(values (%guile-for-build guile) store))))
|
||||||
|
|
||||||
(define* (package-file package
|
(define* (package-file package
|
||||||
#:optional file
|
#:optional file
|
||||||
|
@ -917,9 +917,10 @@ cross-compilation target triplet."
|
||||||
(let* ((system (or system (%current-system)))
|
(let* ((system (or system (%current-system)))
|
||||||
(drv (compute-derivation store package system))
|
(drv (compute-derivation store package system))
|
||||||
(out (derivation->output-path drv output)))
|
(out (derivation->output-path drv output)))
|
||||||
(if file
|
(values (if file
|
||||||
(string-append out "/" file)
|
(string-append out "/" file)
|
||||||
out))))
|
out)
|
||||||
|
store))))
|
||||||
|
|
||||||
(define package->derivation
|
(define package->derivation
|
||||||
(store-lift package-derivation))
|
(store-lift package-derivation))
|
||||||
|
|
|
@ -852,25 +852,15 @@ be used internally by the daemon's build hook."
|
||||||
;;; Store monad.
|
;;; Store monad.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
;; return:: a -> StoreM a
|
(define-syntax-rule (define-alias new old)
|
||||||
(define-inlinable (store-return value)
|
(define-syntax new (identifier-syntax old)))
|
||||||
"Return VALUE from a monadic function."
|
|
||||||
;; The monadic value is just this.
|
|
||||||
(lambda (store)
|
|
||||||
value))
|
|
||||||
|
|
||||||
;; >>=:: StoreM a -> (a -> StoreM b) -> StoreM b
|
;; The store monad allows us to (1) build sequences of operations in the
|
||||||
(define-inlinable (store-bind mvalue mproc)
|
;; store, and (2) make the store an implicit part of the execution context,
|
||||||
"Bind MVALUE in MPROC."
|
;; rather than a parameter of every single function.
|
||||||
(lambda (store)
|
(define-alias %store-monad %state-monad)
|
||||||
(let* ((value (mvalue store))
|
(define-alias store-return state-return)
|
||||||
(mresult (mproc value)))
|
(define-alias store-bind state-bind)
|
||||||
(mresult store))))
|
|
||||||
|
|
||||||
;; This is essentially a state monad
|
|
||||||
(define-monad %store-monad
|
|
||||||
(bind store-bind)
|
|
||||||
(return store-return))
|
|
||||||
|
|
||||||
(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,
|
||||||
|
@ -878,7 +868,7 @@ in the store monad."
|
||||||
(define result
|
(define result
|
||||||
(lambda args
|
(lambda args
|
||||||
(lambda (store)
|
(lambda (store)
|
||||||
(apply proc store args))))
|
(values (apply proc store args) store))))
|
||||||
|
|
||||||
(set-object-property! result 'documentation
|
(set-object-property! result 'documentation
|
||||||
(procedure-property proc 'documentation))
|
(procedure-property proc 'documentation))
|
||||||
|
@ -898,7 +888,8 @@ taking the store as its first argument."
|
||||||
"Return as a monadic value the absolute file name in the store of the file
|
"Return as a monadic value the absolute file name in the store of the file
|
||||||
containing TEXT, a string."
|
containing TEXT, a string."
|
||||||
(lambda (store)
|
(lambda (store)
|
||||||
(add-text-to-store store name text '())))
|
(values (add-text-to-store store name text '())
|
||||||
|
store)))
|
||||||
|
|
||||||
(define* (interned-file file #:optional name
|
(define* (interned-file file #:optional name
|
||||||
#:key (recursive? #t))
|
#:key (recursive? #t))
|
||||||
|
@ -909,8 +900,9 @@ 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
|
designates a flat file and RECURSIVE? is true, its contents are added, and its
|
||||||
permission bits are kept."
|
permission bits are kept."
|
||||||
(lambda (store)
|
(lambda (store)
|
||||||
(add-to-store store (or name (basename file))
|
(values (add-to-store store (or name (basename file))
|
||||||
recursive? "sha256" file)))
|
recursive? "sha256" file)
|
||||||
|
store)))
|
||||||
|
|
||||||
(define %guile-for-build
|
(define %guile-for-build
|
||||||
;; The derivation of the Guile to be used within the build environment,
|
;; The derivation of the Guile to be used within the build environment,
|
||||||
|
@ -925,7 +917,7 @@ permission bits are kept."
|
||||||
connection."
|
connection."
|
||||||
(parameterize ((%guile-for-build guile-for-build)
|
(parameterize ((%guile-for-build guile-for-build)
|
||||||
(%current-system system))
|
(%current-system system))
|
||||||
(mval store)))
|
(run-with-state mval store)))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|
Reference in a new issue