ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-23 21:17:11 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add (guix monads).

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2013-10-03 22:45:25 +02:00
parent c8957c77d6
commit b860f38244
5 changed files with 624 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
.dir-locals.el
View file

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

2
Makefile.am
View file

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

149
doc/guix.texi
View file

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

306
guix/monads.scm Normal file
View file

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

163
tests/monads.scm Normal file
View file

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