diff options
| -rw-r--r-- | .dir-locals.el | 8 | ||||
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | doc/guix.texi | 149 | ||||
| -rw-r--r-- | guix/monads.scm | 306 | ||||
| -rw-r--r-- | tests/monads.scm | 163 |
5 files changed, 624 insertions, 4 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index fc41d430b4..b55ec7590e 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -16,7 +16,13 @@ (eval . (put 'package 'scheme-indent-function 1)) (eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1)) (eval . (put 'with-error-handling 'scheme-indent-function 0)) - (eval . (put 'with-mutex 'scheme-indent-function 1)))) + (eval . (put 'with-mutex 'scheme-indent-function 1)) + + (eval . (put 'syntax-parameterize 'scheme-indent-function 1)) + (eval . (put 'with-monad 'scheme-indent-function 1)) + (eval . (put 'mlet* 'scheme-indent-function 2)) + (eval . (put 'mlet 'scheme-indent-function 2)) + (eval . (put 'run-with-store 'scheme-indent-function 1)))) (emacs-lisp-mode . ((indent-tabs-mode . nil))) (texinfo-mode . ((indent-tabs-mode . nil) (fill-column . 72)))) diff --git a/Makefile.am b/Makefile.am index 7dc79e26e4..22a3b0824d 100644 --- a/Makefile.am +++ b/Makefile.am @@ -40,6 +40,7 @@ MODULES = \ guix/records.scm \ guix/hash.scm \ guix/utils.scm \ + guix/monads.scm \ guix/serialization.scm \ guix/nar.scm \ guix/derivations.scm \ @@ -107,6 +108,7 @@ SCM_TESTS = \ tests/packages.scm \ tests/snix.scm \ tests/store.scm \ + tests/monads.scm \ tests/nar.scm \ tests/union.scm diff --git a/doc/guix.texi b/doc/guix.texi index 196237611e..ceb8046aca 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -914,9 +914,10 @@ This chapter describes all these APIs in turn, starting from high-level package definitions. @menu -* Defining Packages:: Defining new packages. -* The Store:: Manipulating the package store. -* Derivations:: Low-level interface to package derivations. +* Defining Packages:: Defining new packages. +* The Store:: Manipulating the package store. +* Derivations:: Low-level interface to package derivations. +* The Store Monad:: Purely functional interface to the store. @end menu @node Defining Packages @@ -1133,6 +1134,11 @@ derivation paths), and return when the worker is done building them. Return @code{#t} on success. @end deffn +Note that the @code{(guix monads)} module provides a monad as well as +monadic versions of the above procedures, with the goal of making it +more convenient to work with code that accesses the store (@pxref{The +Store Monad}). + @c FIXME @i{This section is currently incomplete.} @@ -1272,6 +1278,143 @@ Packages}). For this reason, Guix modules that are meant to be used in the build stratum are kept in the @code{(guix build @dots{})} name space. +@node The Store Monad +@section The Store Monad + +@cindex monad + +The procedures that operate on the store described in the previous +sections all take an open connection to the build daemon as their first +argument. Although the underlying model is functional, they either have +side effects or depend on the current state of the store. + +The former is inconvenient: the connection to the build daemon has to be +carried around in all those functions, making it impossible to compose +functions that do not take that parameter with functions that do. The +latter can be problematic: since store operations have side effects +and/or depend on external state, they have to be properly sequenced. + +@cindex monadic values +@cindex monadic functions +This is where the @code{(guix monads)} module comes in. This module +provides a framework for working with @dfn{monads}, and a particularly +useful monad for our uses, the @dfn{store monad}. Monads are a +construct that allows two things: associating ``context'' with values +(in our case, the context is the store), and building sequences of +computations (here computations includes accesses to the store.) Values +in a monad---values that carry this additional context---are called +@dfn{monadic values}; procedures that return such values are called +@dfn{monadic procedures}. + +Consider this ``normal'' procedure: + +@example +(define (profile.sh store) + ;; Return the name of a shell script in the store that + ;; initializes the 'PATH' environment variable. + (let* ((drv (package-derivation store coreutils)) + (out (derivation->output-path drv))) + (add-text-to-store store "profile.sh" + (format #f "export PATH=~a/bin" out)))) +@end example + +Using @code{(guix monads)}, it may be rewritten as a monadic function: + +@example +(define (profile.sh) + ;; Same, but return a monadic value. + (mlet %store-monad ((bin (package-file coreutils "bin"))) + (text-file "profile.sh" + (string-append "export PATH=" bin)))) +@end example + +There are two things to note in the second version: the @code{store} +parameter is now implicit, and the monadic value returned by +@code{package-file}---a wrapper around @code{package-derivation} and +@code{derivation->output-path}---is @dfn{bound} using @code{mlet} +instead of plain @code{let}. + +Calling the monadic @code{profile.sh} has no effect. To get the desired +effect, one must use @code{run-with-store}: + +@example +(run-with-store (open-connection) (profile.sh)) +@result{} /nix/store/...-profile.sh +@end example + +The main syntactic forms to deal with monads in general are described +below. + +@deffn {Scheme Syntax} with-monad @var{monad} @var{body} ... +Evaluate any @code{>>=} or @code{return} forms in @var{body} as being +in @var{monad}. +@end deffn + +@deffn {Scheme Syntax} return @var{val} +Return a monadic value that encapsulates @var{val}. +@end deffn + +@deffn {Scheme Syntax} >>= @var{mval} @var{mproc} +@dfn{Bind} monadic value @var{mval}, passing its ``contents'' to monadic +procedure @var{mproc}@footnote{This operation is commonly referred to as +``bind'', but that name denotes an unrelated procedure in Guile. Thus +we use this somewhat cryptic symbol inherited from the Haskell +language.}. +@end deffn + +@deffn {Scheme Syntax} mlet @var{monad} ((@var{var} @var{mval}) ...) @ + @var{body} ... +@deffnx {Scheme Syntax} mlet* @var{monad} ((@var{var} @var{mval}) ...) @ + @var{body} ... +Bind the variables @var{var} to the monadic values @var{mval} in +@var{body}. The form (@var{var} -> @var{val}) binds @var{var} to the +``normal'' value @var{val}, as per @code{let}. + +@code{mlet*} is to @code{mlet} what @code{let*} is to @code{let} +(@pxref{Local Bindings,,, guile, GNU Guile Reference Manual}). +@end deffn + +The interface to the store monad provided by @code{(guix monads)} is as +follows. + +@defvr {Scheme Variable} %store-monad +The store monad. Values in the store monad encapsulate accesses to the +store. When its effect is needed, a value of the store monad must be +``evaluated'' by passing it to the @code{run-with-store} procedure (see +below.) +@end defvr + +@deffn {Scheme Procedure} run-with-store @var{store} @var{mval} [#:guile-for-build] [#:system (%current-system)] +Run @var{mval}, a monadic value in the store monad, in @var{store}, an +open store connection. +@end deffn + +@deffn {Monadic Procedure} text-file @var{name} @var{text} +Return as a monadic value the absolute file name in the store of the file +containing @var{text}. +@end deffn + +@deffn {Monadic Procedure} package-file @var{package} [@var{file}] @ + [#:system (%current-system)] [#:output "out"] Return as a monadic +value in the absolute file name of @var{file} within the @var{output} +directory of @var{package}. When @var{file} is omitted, return the name +of the @var{output} directory of @var{package}. +@end deffn + +@deffn {Monadic Procedure} derivation-expression @var{name} @var{system} @ + @var{exp} @var{inputs} [#:outputs '("out")] [#:hash #f] @ + [#:hash-algo #f] [#:env-vars '()] [#:modules '()] @ + [#:references-graphs #f] [#:guile-for-build #f] +Monadic version of @code{build-expression->derivation} +(@pxref{Derivations}). +@end deffn + +@deffn {Monadic Procedure} package->derivation @var{package} [@var{system}] +Monadic version of @code{package-derivation} (@pxref{Defining +Packages}). +@end deffn + + @c ********************************************************************* @node Utilities @chapter Utilities diff --git a/guix/monads.scm b/guix/monads.scm new file mode 100644 index 0000000000..7862b0bce2 --- /dev/null +++ b/guix/monads.scm @@ -0,0 +1,306 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix monads) + #:use-module (guix records) + #:use-module (guix store) + #:use-module (guix derivations) + #:use-module (guix packages) + #:use-module (ice-9 match) + #:use-module (srfi srfi-26) + #:export (;; Monads. + monad + monad? + monad-bind + monad-return + + ;; Syntax. + >>= + return + with-monad + mlet + mlet* + lift1 lift2 lift3 lift4 lift5 lift6 lift7 lift + listm + foldm + mapm + sequence + anym + + ;; Concrete monads. + %identity-monad + + %store-monad + store-bind + store-return + store-lift + run-with-store + text-file + package-file + package->derivation + built-derivations + derivation-expression)) + +;;; Commentary: +;;; +;;; This module implements the general mechanism of monads, and provides in +;;; particular an instance of the "store" monad. The API was inspired by that +;;; of Racket's "better-monads" module (see +;;; <http://planet.racket-lang.org/package-source/toups/functional.plt/1/1/planet-docs/better-monads-guide/index.html>). +;;; The implementation and use case were influenced by Oleg Kysielov's +;;; "Monadic Programming in Scheme" (see +;;; <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: + +(define-record-type* <monad> monad make-monad + monad? + (bind monad-bind) + (return monad-return)) ; TODO: Add 'plus' and 'zero' + +(define-syntax-parameter >>= + ;; The name 'bind' is already taken, so we choose this (obscure) symbol. + (lambda (s) + (syntax-violation '>>= ">>= (bind) used outside of 'with-monad'" s))) + +(define-syntax-parameter return + (lambda (s) + (syntax-violation 'return "return used outside of 'with-monad'" s))) + +(define-syntax with-monad + (lambda (s) + "Evaluate BODY in the context of MONAD, and return its result." + (syntax-case s () + ((_ monad body ...) + #'(syntax-parameterize ((>>= (identifier-syntax + (monad-bind monad))) + (return (identifier-syntax + (monad-return monad)))) + body ...))))) + +(define-syntax mlet* + (syntax-rules (->) + "Bind the given monadic values MVAL to the given variables VAR. When the +form is (VAR -> VAL), bind VAR to the non-monadic value VAL in the same way as +'let'." + ;; Note: the '->' symbol corresponds to 'is:' in 'better-monads.rkt'. + ((_ monad () body ...) + (with-monad monad body ...)) + ((_ monad ((var mval) rest ...) body ...) + (with-monad monad + (>>= mval + (lambda (var) + (mlet* monad (rest ...) + body ...))))) + ((_ monad ((var -> val) rest ...) body ...) + (let ((var val)) + (mlet* monad (rest ...) + body ...))))) + +(define-syntax mlet + (lambda (s) + (syntax-case s () + ((_ monad ((var mval ...) ...) body ...) + (with-syntax (((temp ...) (generate-temporaries #'(var ...)))) + #'(mlet* monad ((temp mval ...) ...) + (let ((var temp) ...) + body ...))))))) + +(define-syntax define-lift + (syntax-rules () + ((_ liftn (args ...)) + (define (liftn proc monad) + "Lift PROC to MONAD---i.e., return a monadic function in MONAD." + (lambda (args ...) + (with-monad monad + (return (proc args ...)))))))) + +(define-lift lift1 (a)) +(define-lift lift2 (a b)) +(define-lift lift3 (a b c)) +(define-lift lift4 (a b c d)) +(define-lift lift5 (a b c d e)) +(define-lift lift6 (a b c d e f)) +(define-lift lift7 (a b c d e f g)) + +(define (lift nargs proc monad) + "Lift PROC, a procedure that accepts NARGS arguments, to MONAD---i.e., +return a monadic function in MONAD." + (lambda args + (with-monad monad + (return (apply proc args))))) + +(define (foldm monad mproc init lst) + "Fold MPROC over LST, a list of monadic values in MONAD, and return a +monadic value seeded by INIT." + (with-monad monad + (let loop ((lst lst) + (result init)) + (match lst + (() + (return result)) + ((head tail ...) + (mlet* monad ((item head) + (result (mproc item result))) + (loop tail result))))))) + +(define (mapm monad mproc lst) + "Map MPROC over LST, a list of monadic values in MONAD, and return a monadic +list." + (foldm monad + (lambda (item result) + (mlet monad ((item (mproc item))) + (return (cons item result)))) + '() + (reverse lst))) + +(define-inlinable (sequence monad lst) + "Turn the list of monadic values LST into a monadic list of values, by +evaluating each item of LST in sequence." + ;; FIXME: 'mapm' binds from right to left. + (with-monad monad + (mapm monad return lst))) + +(define (anym monad proc lst) + "Apply PROC to the list of monadic values LST; return the first value, +lifted in MONAD, for which PROC returns true." + (with-monad monad + (let loop ((lst lst)) + (match lst + (() + (return #f)) + ((head tail ...) + (mlet monad ((value head)) + (or (and=> (proc value) return) + head + (loop tail)))))))) + +(define-syntax listm + (lambda (s) + "Return a monadic list in MONAD from the monadic values MVAL." + (syntax-case s () + ((_ monad mval ...) + (with-syntax (((val ...) (generate-temporaries #'(mval ...)))) + #'(mlet monad ((val mval) ...) + (return (list val ...)))))))) + + + +;;; +;;; Identity monad. +;;; + +(define (identity-return value) + value) + +(define (identity-bind mvalue mproc) + (mproc mvalue)) + +(define %identity-monad + (monad + (bind identity-bind) + (return identity-return))) + + +;;; +;;; Store monad. +;;; + +;; return:: a -> StoreM a +(define (store-return value) + "Return VALUE from a monadic function." + ;; The monadic value is just this. + (lambda (store) + value)) + +;; >>=:: StoreM a -> (a -> StoreM b) -> StoreM b +(define (store-bind mvalue mproc) + (lambda (store) + (let* ((value (mvalue store)) + (mresult (mproc value))) + (mresult store)))) + +(define %store-monad + (monad + (return store-return) + (bind store-bind))) + + +(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) + (apply proc store args)))) + + (set-object-property! result 'documentation + (procedure-property proc 'documentation)) + result) + +;;; +;;; Store monad operators. +;;; + +(define* (text-file name text) + "Return as a monadic value the absolute file name in the store of the file +containing TEXT." + (lambda (store) + (add-text-to-store store name text '()))) + +(define* (package-file package + #:optional file + #:key (system (%current-system)) (output "out")) + "Return as a monadic value in the absolute file name of FILE within the +OUTPUT directory of PACKAGE. When FILE is omitted, return the name of the +OUTPUT directory of PACKAGE." + (lambda (store) + (let* ((drv (package-derivation store package system)) + (out (derivation->output-path drv output))) + (if file + (string-append out "/" file) + out)))) + +(define derivation-expression + (store-lift build-expression->derivation)) + +(define package->derivation + (store-lift package-derivation)) + +(define built-derivations + (store-lift build-derivations)) + +(define* (run-with-store store mval + #:key + (guile-for-build (%guile-for-build)) + (system (%current-system))) + "Run MVAL, a monadic value in the store monad, in STORE, an open store +connection." + (parameterize ((%guile-for-build (or guile-for-build + (package-derivation store + (@ (gnu packages base) + guile-final) + system))) + (%current-system system)) + (mval store))) + +;;; monads.scm end here diff --git a/tests/monads.scm b/tests/monads.scm new file mode 100644 index 0000000000..9570c208b2 --- /dev/null +++ b/tests/monads.scm @@ -0,0 +1,163 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (test-monads) + #:use-module (guix store) + #:use-module (guix monads) + #:use-module (guix derivations) + #:use-module ((guix packages) + #:select (package-derivation %current-system)) + #:use-module (gnu packages) + #:use-module (gnu packages bootstrap) + #:use-module (ice-9 match) + #:use-module (rnrs io ports) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-64)) + +;; Test the (guix store) module. + +(define %store + (open-connection)) + +;; Make sure we build everything by ourselves. +(set-build-options %store #:use-substitutes? #f) + +(define %monads + (list %identity-monad %store-monad)) + +(define %monad-run + (list identity + (cut run-with-store %store <>))) + + +(test-begin "monads") + +;; The 3 "monad laws": <http://www.haskell.org/haskellwiki/Monad_laws>. + +(test-assert "left identity" + (every (lambda (monad run) + (let ((number (random 777))) + (with-monad monad + (define (f x) + (return (* (1+ number) 2))) + + (= (run (>>= (return number) f)) + (run (f number)))))) + %monads + %monad-run)) + +(test-assert "right identity" + (every (lambda (monad run) + (with-monad monad + (let ((number (return (random 777)))) + (= (run (>>= number return)) + (run number))))) + %monads + %monad-run)) + +(test-assert "associativity" + (every (lambda (monad run) + (with-monad monad + (define (f x) + (return (+ 1 x))) + (define (g x) + (return (* 2 x))) + + (let ((number (return (random 777)))) + (= (run (>>= (>>= number f) g)) + (run (>>= number (lambda (x) (>>= (f x) g)))))))) + %monads + %monad-run)) + +(test-assert "lift" + (every (lambda (monad run) + (let ((f (lift1 1+ monad))) + (with-monad monad + (let ((number (random 777))) + (= (run (>>= (return number) f)) + (1+ number)))))) + %monads + %monad-run)) + +(test-assert "mlet* + text-file + package-file" + (run-with-store %store + (mlet* %store-monad ((guile (package-file %bootstrap-guile "bin/guile")) + (file (text-file "monadic" guile))) + (return (equal? (call-with-input-file file get-string-all) + guile))) + #:guile-for-build (package-derivation %store %bootstrap-guile))) + +(test-assert "mlet* + derivation-expression" + (run-with-store %store + (mlet* %store-monad ((guile (package-file %bootstrap-guile "bin/guile")) + (gdrv (package->derivation %bootstrap-guile)) + (exp -> `(let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (symlink ,guile + (string-append out "/guile-rocks")))) + (drv (derivation-expression "rocks" (%current-system) + exp `(("g" ,gdrv)))) + (out -> (derivation->output-path drv)) + (built? (built-derivations (list drv)))) + (return (and built? + (equal? guile + (readlink (string-append out "/guile-rocks")))))) + #:guile-for-build (package-derivation %store %bootstrap-guile))) + +(test-assert "mapm" + (every (lambda (monad run) + (with-monad monad + (equal? (run (mapm monad (lift1 1+ monad) (map return (iota 10)))) + (map 1+ (iota 10))))) + %monads + %monad-run)) + +(test-assert "sequence" + (every (lambda (monad run) + (let* ((input (iota 100)) + (order '())) + (define (frob i) + ;; The side effect here is used to keep track of the order in + ;; which monadic values are bound. + (set! order (cons i order)) + i) + + (and (equal? input + (run (sequence monad + (map (lift1 frob monad) input)))) + + ;; Make sure this is from left to right. + (equal? order (reverse input))))) + %monads + %monad-run)) + +(test-assert "listm" + (every (lambda (monad run) + (run (with-monad monad + (let ((lst (listm monad + (return 1) (return 2) (return 3)))) + (mlet monad ((lst lst)) + (return (equal? '(1 2 3) lst))))))) + %monads + %monad-run)) + +(test-end "monads") + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) |