* guix/monads.scm: New file.
* tests/monads.scm: New file.
* Makefile.am (MODULES): Add guix/monads.scm.
(SCM_TESTS): Add tests/monads.scm.
* doc/guix.texi (The Store Monad): New node.
(The Store): Reference it.
(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))))
guix/records.scm \
guix/hash.scm \
guix/utils.scm \
+ guix/monads.scm \
guix/serialization.scm \
guix/nar.scm \
guix/derivations.scm \
tests/packages.scm \
tests/snix.scm \
tests/store.scm \
+ tests/monads.scm \
tests/nar.scm \
tests/union.scm
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
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.}
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
--- /dev/null
+;;; 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 ...))))))))
+
+
+\f
+;;;
+;;; Identity monad.
+;;;
+
+(define (identity-return value)
+ value)
+
+(define (identity-bind mvalue mproc)
+ (mproc mvalue))
+
+(define %identity-monad
+ (monad
+ (bind identity-bind)
+ (return identity-return)))
+
+\f
+;;;
+;;; 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
--- /dev/null
+;;; 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 <>)))
+
+\f
+(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")
+
+\f
+(exit (= (test-runner-fail-count (test-runner-current)) 0))
HCoop / jackhill / guix / guix.git / commitdiff