monads: Add 'mbegin'.
* guix/monads.scm (mbegin): New macro.
* tests/monads.scm ("mbegin"): New test.
* doc/guix.texi (The Store Monad): Document it.
			
			
This commit is contained in:
		
							parent
							
								
									2e1bafb034
								
							
						
					
					
						commit
						405a9d4ec9
					
				
					 4 changed files with 40 additions and 1 deletions
				
			
		|  | @ -38,6 +38,7 @@ | ||||||
| 
 | 
 | ||||||
|    (eval . (put 'syntax-parameterize 'scheme-indent-function 1)) |    (eval . (put 'syntax-parameterize 'scheme-indent-function 1)) | ||||||
|    (eval . (put 'with-monad 'scheme-indent-function 1)) |    (eval . (put 'with-monad 'scheme-indent-function 1)) | ||||||
|  |    (eval . (put 'mbegin 'scheme-indent-function 1)) | ||||||
|    (eval . (put 'mlet* 'scheme-indent-function 2)) |    (eval . (put 'mlet* 'scheme-indent-function 2)) | ||||||
|    (eval . (put 'mlet 'scheme-indent-function 2)) |    (eval . (put 'mlet 'scheme-indent-function 2)) | ||||||
|    (eval . (put 'run-with-store 'scheme-indent-function 1)) |    (eval . (put 'run-with-store 'scheme-indent-function 1)) | ||||||
|  |  | ||||||
|  | @ -2061,6 +2061,15 @@ Bind the variables @var{var} to the monadic values @var{mval} in | ||||||
| (@pxref{Local Bindings,,, guile, GNU Guile Reference Manual}). | (@pxref{Local Bindings,,, guile, GNU Guile Reference Manual}). | ||||||
| @end deffn | @end deffn | ||||||
| 
 | 
 | ||||||
|  | @deffn {Scheme System} mbegin @var{monad} @var{mexp} ... | ||||||
|  | Bind @var{mexp} and the following monadic expressions in sequence, | ||||||
|  | returning the result of the last expression. | ||||||
|  | 
 | ||||||
|  | This is akin to @code{mlet}, except that the return values of the | ||||||
|  | monadic expressions are ignored.  In that sense, it is analogous to | ||||||
|  | @code{begin}, but applied to monadic expressions. | ||||||
|  | @end deffn | ||||||
|  | 
 | ||||||
| The interface to the store monad provided by @code{(guix monads)} is as | The interface to the store monad provided by @code{(guix monads)} is as | ||||||
| follows. | follows. | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -38,6 +38,7 @@ | ||||||
|             with-monad |             with-monad | ||||||
|             mlet |             mlet | ||||||
|             mlet* |             mlet* | ||||||
|  |             mbegin | ||||||
|             lift1 lift2 lift3 lift4 lift5 lift6 lift7 lift |             lift1 lift2 lift3 lift4 lift5 lift6 lift7 lift | ||||||
|             listm |             listm | ||||||
|             foldm |             foldm | ||||||
|  | @ -171,6 +172,19 @@ form is (VAR -> VAL), bind VAR to the non-monadic value VAL in the same way as | ||||||
|              (let ((var temp) ...) |              (let ((var temp) ...) | ||||||
|                body ...))))))) |                body ...))))))) | ||||||
| 
 | 
 | ||||||
|  | (define-syntax mbegin | ||||||
|  |   (syntax-rules () | ||||||
|  |     "Bind the given monadic expressions in sequence, returning the result of | ||||||
|  | the last one." | ||||||
|  |     ((_ monad mexp) | ||||||
|  |      (with-monad monad | ||||||
|  |        mexp)) | ||||||
|  |     ((_ monad mexp rest ...) | ||||||
|  |      (with-monad monad | ||||||
|  |        (>>= mexp | ||||||
|  |             (lambda (unused-value) | ||||||
|  |               (mbegin monad rest ...))))))) | ||||||
|  | 
 | ||||||
| (define-syntax define-lift | (define-syntax define-lift | ||||||
|   (syntax-rules () |   (syntax-rules () | ||||||
|     ((_ liftn (args ...)) |     ((_ liftn (args ...)) | ||||||
|  |  | ||||||
|  | @ -32,7 +32,7 @@ | ||||||
|   #:use-module (srfi srfi-26) |   #:use-module (srfi srfi-26) | ||||||
|   #:use-module (srfi srfi-64)) |   #:use-module (srfi srfi-64)) | ||||||
| 
 | 
 | ||||||
| ;; Test the (guix store) module. | ;; Test the (guix monads) module. | ||||||
| 
 | 
 | ||||||
| (define %store | (define %store | ||||||
|   (open-connection-for-tests)) |   (open-connection-for-tests)) | ||||||
|  | @ -99,6 +99,21 @@ | ||||||
|          %monads |          %monads | ||||||
|          %monad-run)) |          %monad-run)) | ||||||
| 
 | 
 | ||||||
|  | (test-assert "mbegin" | ||||||
|  |   (every (lambda (monad run) | ||||||
|  |            (with-monad monad | ||||||
|  |              (let* ((been-there? #f) | ||||||
|  |                     (number (mbegin monad | ||||||
|  |                               (return 1) | ||||||
|  |                               (begin | ||||||
|  |                                 (set! been-there? #t) | ||||||
|  |                                 (return 2)) | ||||||
|  |                               (return 3)))) | ||||||
|  |                (and (= (run number) 3) | ||||||
|  |                     been-there?)))) | ||||||
|  |          %monads | ||||||
|  |          %monad-run)) | ||||||
|  | 
 | ||||||
| (test-assert "mlet* + text-file + package-file" | (test-assert "mlet* + text-file + package-file" | ||||||
|   (run-with-store %store |   (run-with-store %store | ||||||
|     (mlet* %store-monad ((guile (package-file %bootstrap-guile "bin/guile")) |     (mlet* %store-monad ((guile (package-file %bootstrap-guile "bin/guile")) | ||||||
|  |  | ||||||
		Reference in a new issue