Archived
1
0
Fork 0

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:
Ludovic Courtès 2015-01-17 23:19:13 +01:00
parent 81a97734e0
commit 4e190c2803
3 changed files with 20 additions and 31 deletions

View file

@ -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.

View file

@ -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))

View file

@ -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)))
;;; ;;;