nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

monads: Move '%store-monad' and related procedures where they belong. 

This turns (guix monads) into a generic module for monads, and moves the
store monad and related monadic procedures in their corresponding
module.

* guix/monads.scm (store-return, store-bind, %store-monad, store-lift,
  text-file, interned-file, package-file, package->derivation,
  package->cross-derivation, origin->derivation, imported-modules,
  compiled, modules, built-derivations, run-with-store): Move to...
* guix/store.scm (store-return, store-bind, %store-monad, store-lift,
  text-file, interned-file): ... here.
  (%guile-for-build): New variable.
  (run-with-store): Moved from monads.scm.  Remove default value for
  #:guile-for-build.
* guix/packages.scm (default-guile): Export.
  (set-guile-for-build): New procedure.
  (package-file, package->derivation, package->cross-derivation,
  origin->derivation): Moved from monads.scm.
* guix/derivations.scm (%guile-for-build): Remove.
  (imported-modules): Rename to...
  (%imported-modules): ... this.
  (compiled-modules): Rename to...
  (%compiled-modules): ... this.
  (built-derivations, imported-modules, compiled-modules): New
  procedures.
* gnu/services/avahi.scm, gnu/services/base.scm, gnu/services/dbus.scm,
  gnu/services/dmd.scm, gnu/services/networking.scm,
  gnu/services/ssh.scm, gnu/services/xorg.scm, gnu/system/install.scm,
  gnu/system/linux-initrd.scm, gnu/system/shadow.scm, guix/download.scm,
  guix/gexp.scm, guix/git-download.scm, guix/profiles.scm,
  guix/svn-download.scm, tests/monads.scm: Adjust imports accordingly.
* guix/monad-repl.scm (default-guile-derivation): New procedure.
  (store-monad-language, run-in-store): Use it.
* build-aux/hydra/gnu-system.scm (qemu-jobs): Add explicit
  'set-guile-for-build' call.
* guix/scripts/archive.scm (derivation-from-expression): Likewise.
* guix/scripts/build.scm (options/resolve-packages): Likewise.
* guix/scripts/environment.scm (guix-environment): Likewise.
* guix/scripts/system.scm (guix-system): Likewise.
* doc/guix.texi (The Store Monad): Adjust module names accordingly.
This commit is contained in:
Ludovic Courtès 2015-01-14 13:34:52 +01:00
parent 1ed194646b
commit e87f0591f3
27 changed files with 285 additions and 228 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
build-aux/hydra/gnu-system.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -147,14 +147,18 @@ system.")
(if (member system '("x86_64-linux" "i686-linux")) (if (member system '("x86_64-linux" "i686-linux"))
(list (->job 'qemu-image (list (->job 'qemu-image
(run-with-store store (run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(system-qemu-image (demo-os) (system-qemu-image (demo-os)
#:disk-image-size #:disk-image-size
(* 1400 MiB)))) ; 1.4 GiB (* 1400 MiB))))) ; 1.4 GiB
(->job 'usb-image (->job 'usb-image
(run-with-store store (run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(system-disk-image installation-os (system-disk-image installation-os
#:disk-image-size #:disk-image-size
(* 800 MiB))))) (* 800 MiB))))))
'())) '()))
(define job-name (define job-name

11
doc/guix.texi
View File

@ -2194,8 +2194,8 @@ scheme@@(guile-user)>
Note that non-monadic values cannot be returned in the Note that non-monadic values cannot be returned in the
@code{store-monad} REPL. @code{store-monad} REPL.
The main syntactic forms to deal with monads in general are described The main syntactic forms to deal with monads in general are provided by
below. the @code{(guix monads)} module and are described below.
@deffn {Scheme Syntax} with-monad @var{monad} @var{body} ... @deffn {Scheme Syntax} with-monad @var{monad} @var{body} ...
Evaluate any @code{>>=} or @code{return} forms in @var{body} as being Evaluate any @code{>>=} or @code{return} forms in @var{body} as being
@ -2235,8 +2235,8 @@ monadic expressions are ignored. In that sense, it is analogous to
@code{begin}, but applied to monadic expressions. @code{begin}, but applied to monadic expressions.
@end deffn @end deffn
The interface to the store monad provided by @code{(guix monads)} is as The main interface to the store monad, provided by the @code{(guix
follows. store)} module, is as follows.
@defvr {Scheme Variable} %store-monad @defvr {Scheme Variable} %store-monad
The store monad. Values in the store monad encapsulate accesses to the The store monad. Values in the store monad encapsulate accesses to the
@ -2278,6 +2278,9 @@ The example below adds a file to the store, under two different names:
@end deffn @end deffn
The @code{(guix packages)} module exports the following package-related
monadic procedures:
@deffn {Monadic Procedure} package-file @var{package} [@var{file}] @ @deffn {Monadic Procedure} package-file @var{package} [@var{file}] @
[#:system (%current-system)] [#:target #f] @ [#:system (%current-system)] [#:target #f] @
[#:output "out"] Return as a monadic [#:output "out"] Return as a monadic

3
gnu/services/avahi.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -21,6 +21,7 @@
#:use-module (gnu system shadow) #:use-module (gnu system shadow)
#:use-module (gnu packages avahi) #:use-module (gnu packages avahi)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix store)
#:use-module (guix gexp) #:use-module (guix gexp)
#:export (avahi-service)) #:export (avahi-service))

3
gnu/services/base.scm
View File

@ -17,8 +17,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services base) (define-module (gnu services base)
#:use-module ((guix store) #:use-module (guix store)
#:select (%store-prefix))
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (gnu services networking) #:use-module (gnu services networking)
#:use-module (gnu system shadow) ; 'user-account', etc. #:use-module (gnu system shadow) ; 'user-account', etc.

3
gnu/services/dbus.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -21,6 +21,7 @@
#:use-module (gnu system shadow) #:use-module (gnu system shadow)
#:use-module (gnu packages glib) #:use-module (gnu packages glib)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix store)
#:use-module (guix gexp) #:use-module (guix gexp)
#:export (dbus-service)) #:export (dbus-service))

4
gnu/services/dmd.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -18,7 +18,9 @@
(define-module (gnu services dmd) (define-module (gnu services dmd)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix derivations) ;imported-modules, etc.
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)

3
gnu/services/networking.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -25,6 +25,7 @@
#:use-module (gnu packages messaging) #:use-module (gnu packages messaging)
#:use-module (gnu packages ntp) #:use-module (gnu packages ntp)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:export (%facebook-host-aliases #:export (%facebook-host-aliases

5
gnu/services/ssh.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -18,10 +18,11 @@
(define-module (gnu services ssh) (define-module (gnu services ssh)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (gnu services) #:use-module (gnu services)
#:use-module (gnu system linux) ; 'pam-service' #:use-module (gnu system linux) ; 'pam-service'
#:use-module (gnu packages lsh) #:use-module (gnu packages lsh)
#:use-module (guix monads)
#:export (lsh-service)) #:export (lsh-service))
;;; Commentary: ;;; Commentary:

3
gnu/services/xorg.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -30,6 +30,7 @@
#:use-module (gnu packages admin) #:use-module (gnu packages admin)
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)

3
gnu/system/install.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,6 +19,7 @@
(define-module (gnu system install) (define-module (gnu system install)
#:use-module (gnu) #:use-module (gnu)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module ((guix store) #:select (%store-prefix)) #:use-module ((guix store) #:select (%store-prefix))
#:use-module (gnu packages admin) #:use-module (gnu packages admin)

3
gnu/system/linux-initrd.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -18,6 +18,7 @@
(define-module (gnu system linux-initrd) (define-module (gnu system linux-initrd)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix store)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module ((guix store) #:use-module ((guix store)

3
gnu/system/shadow.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,6 +19,7 @@
(define-module (gnu system shadow) (define-module (gnu system shadow)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module ((gnu system file-systems) #:use-module ((gnu system file-systems)
#:select (%tty-gid)) #:select (%tty-gid))

37
guix/derivations.scm
View File

@ -28,6 +28,7 @@
#:use-module (ice-9 vlist) #:use-module (ice-9 vlist)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix monads)
#:use-module (guix hash) #:use-module (guix hash)
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (guix records) #:use-module (guix records)
@ -84,11 +85,16 @@
map-derivation map-derivation
%guile-for-build built-derivations
imported-modules imported-modules
compiled-modules compiled-modules
build-expression->derivation build-expression->derivation
imported-files) imported-files)
;; Re-export it from here for backward compatibility.
#:re-export (%guile-for-build)
#:replace (build-derivations)) #:replace (build-derivations))
;;; ;;;
@ -895,11 +901,6 @@ recursively."
;;; Guile-based builders. ;;; Guile-based builders.
;;; ;;;
(define %guile-for-build
;; The derivation of the Guile to be used within the build environment,
;; when using `build-expression->derivation'.
(make-parameter #f))
(define (parent-directories file-name) (define (parent-directories file-name)
"Return the list of parent dirs of FILE-NAME, in the order in which an "Return the list of parent dirs of FILE-NAME, in the order in which an
`mkdir -p' implementation would make them." `mkdir -p' implementation would make them."
@ -956,7 +957,7 @@ system, imported, and appears under FINAL-PATH in the resulting store path."
;; up looking for the same files over and over again. ;; up looking for the same files over and over again.
(memoize search-path)) (memoize search-path))
(define* (imported-modules store modules (define* (%imported-modules store modules
#:key (name "module-import") #:key (name "module-import")
(system (%current-system)) (system (%current-system))
(guile (%guile-for-build)) (guile (%guile-for-build))
@ -975,7 +976,7 @@ search path."
(imported-files store files #:name name #:system system (imported-files store files #:name name #:system system
#:guile guile))) #:guile guile)))
(define* (compiled-modules store modules (define* (%compiled-modules store modules
#:key (name "module-import-compiled") #:key (name "module-import-compiled")
(system (%current-system)) (system (%current-system))
(guile (%guile-for-build)) (guile (%guile-for-build))
@ -983,7 +984,7 @@ search path."
"Return a derivation that builds a tree containing the `.go' files "Return a derivation that builds a tree containing the `.go' files
corresponding to MODULES. All the MODULES are built in a context where corresponding to MODULES. All the MODULES are built in a context where
they can refer to each other." they can refer to each other."
(let* ((module-drv (imported-modules store modules (let* ((module-drv (%imported-modules store modules
#:system system #:system system
#:guile guile #:guile guile
#:module-path module-path)) #:module-path module-path))
@ -1218,13 +1219,13 @@ ALLOWED-REFERENCES, and LOCAL-BUILD?."
(filter-map source-path inputs))) (filter-map source-path inputs)))
(mod-drv (and (pair? modules) (mod-drv (and (pair? modules)
(imported-modules store modules (%imported-modules store modules
#:guile guile-drv #:guile guile-drv
#:system system))) #:system system)))
(mod-dir (and mod-drv (mod-dir (and mod-drv
(derivation->output-path mod-drv))) (derivation->output-path mod-drv)))
(go-drv (and (pair? modules) (go-drv (and (pair? modules)
(compiled-modules store modules (%compiled-modules store modules
#:guile guile-drv #:guile guile-drv
#:system system))) #:system system)))
(go-dir (and go-drv (go-dir (and go-drv
@ -1255,3 +1256,17 @@ ALLOWED-REFERENCES, and LOCAL-BUILD?."
#:references-graphs references-graphs #:references-graphs references-graphs
#:allowed-references allowed-references #:allowed-references allowed-references
#:local-build? local-build?))) #:local-build? local-build?)))
;;;
;;; Monadic interface.
;;;
(define built-derivations
(store-lift build-derivations))
(define imported-modules
(store-lift %imported-modules))
(define compiled-modules
(store-lift %compiled-modules))

4
guix/download.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr> ;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -21,7 +21,7 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module ((guix store) #:select (derivation-path? add-to-store)) #:use-module (guix store)
#:use-module ((guix build download) #:prefix build:) #:use-module ((guix build download) #:prefix build:)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix gexp) #:use-module (guix gexp)

7
guix/gexp.scm
View File

@ -17,12 +17,9 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix gexp) (define-module (guix gexp)
#:use-module ((guix store) #:use-module (guix store)
#:select (direct-store-path?))
#:use-module (guix monads) #:use-module (guix monads)
#:use-module ((guix derivations) #:use-module (guix derivations)
#:select (derivation? derivation->output-path
%guile-for-build derivation))
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)

3
guix/git-download.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -18,6 +18,7 @@
(define-module (guix git-download) (define-module (guix git-download)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix packages) #:use-module (guix packages)

24
guix/monad-repl.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,6 +19,8 @@
(define-module (guix monad-repl) (define-module (guix monad-repl)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (ice-9 pretty-print) #:use-module (ice-9 pretty-print)
#:use-module (system repl repl) #:use-module (system repl repl)
#:use-module (system repl common) #:use-module (system repl common)
@ -54,20 +56,30 @@
#:make-default-environment #:make-default-environment
(language-make-default-environment scheme)))) (language-make-default-environment scheme))))
(define* (default-guile-derivation store #:optional (system (%current-system)))
"Return the derivation of the default "
(package-derivation store (default-guile) system))
(define (store-monad-language) (define (store-monad-language)
"Return a compiler language for the store monad." "Return a compiler language for the store monad."
(let ((store (open-connection))) (let* ((store (open-connection))
(guile (or (%guile-for-build)
(default-guile-derivation store))))
(monad-language %store-monad (monad-language %store-monad
(cut run-with-store store <>) (cut run-with-store store <>
#:guile-for-build guile)
'store-monad))) 'store-monad)))
(define-meta-command ((run-in-store guix) repl (form)) (define-meta-command ((run-in-store guix) repl (form))
"run-in-store EXP "run-in-store EXP
Run EXP through the store monad." Run EXP through the store monad."
(let ((value (with-store store (with-store store
(run-with-store store (repl-eval repl form))))) (let* ((guile (or (%guile-for-build)
(default-guile-derivation store)))
(value (run-with-store store (repl-eval repl form)
#:guile-for-build guile)))
(run-hook before-print-hook value) (run-hook before-print-hook value)
(pretty-print value))) (pretty-print value))))
(define-meta-command ((enter-store-monad guix) repl) (define-meta-command ((enter-store-monad guix) repl)
"enter-store-monad "enter-store-monad

137
guix/monads.scm
View File

@ -17,9 +17,6 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix monads) (define-module (guix monads)
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module ((system syntax) #:use-module ((system syntax)
#:select (syntax-local-binding)) #:select (syntax-local-binding))
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -49,22 +46,7 @@
anym anym
;; Concrete monads. ;; Concrete monads.
%identity-monad %identity-monad))
%store-monad
store-bind
store-return
store-lift
run-with-store
text-file
interned-file
package-file
origin->derivation
package->derivation
package->cross-derivation
built-derivations)
#:replace (imported-modules
compiled-modules))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -309,121 +291,4 @@ lifted in MONAD, for which PROC returns true."
(bind identity-bind) (bind identity-bind)
(return identity-return)) (return identity-return))
;;;
;;; Store monad.
;;;
;; return:: a -> StoreM a
(define-inlinable (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-inlinable (store-bind mvalue mproc)
"Bind MVALUE in MPROC."
(lambda (store)
(let* ((value (mvalue store))
(mresult (mproc value)))
(mresult store))))
(define-monad %store-monad
(bind store-bind)
(return store-return))
(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, a string."
(lambda (store)
(add-text-to-store store name text '())))
(define* (interned-file file #:optional name
#:key (recursive? #t))
"Return the name of FILE once interned in the store. Use NAME as its store
name, or the basename of FILE if NAME is omitted.
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
permission bits are kept."
(lambda (store)
(add-to-store store (or name (basename file))
recursive? "sha256" file)))
(define* (package-file package
#:optional file
#:key
system (output "out") target)
"Return as a monadic value 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. When TARGET is true, use it as a
cross-compilation target triplet."
(lambda (store)
(define compute-derivation
(if target
(cut package-cross-derivation <> <> target <>)
package-derivation))
(let* ((system (or system (%current-system)))
(drv (compute-derivation store package system))
(out (derivation->output-path drv output)))
(if file
(string-append out "/" file)
out))))
(define package->derivation
(store-lift package-derivation))
(define package->cross-derivation
(store-lift package-cross-derivation))
(define origin->derivation
(store-lift package-source-derivation))
(define imported-modules
(store-lift (@ (guix derivations) imported-modules)))
(define compiled-modules
(store-lift (@ (guix derivations) compiled-modules)))
(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."
(define (default-guile)
;; Lazily resolve 'guile-final'. This module must not refer to (gnu …)
;; modules directly, to avoid circular dependencies, hence this hack.
(module-ref (resolve-interface '(gnu packages commencement))
'guile-final))
(parameterize ((%guile-for-build (or guile-for-build
(package-derivation store
(default-guile)
system)))
(%current-system system))
(mval store)))
;;; monads.scm end here ;;; monads.scm end here

58
guix/packages.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -21,6 +21,7 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix build-system) #:use-module (guix build-system)
@ -108,7 +109,15 @@
bag-transitive-inputs bag-transitive-inputs
bag-transitive-host-inputs bag-transitive-host-inputs
bag-transitive-build-inputs bag-transitive-build-inputs
bag-transitive-target-inputs)) bag-transitive-target-inputs
default-guile
set-guile-for-build
package-file
package->derivation
package->cross-derivation
origin->derivation))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -317,7 +326,8 @@ corresponds to the arguments expected by `set-path-environment-variable'."
("patch" ,(ref '(gnu packages base) 'patch))))) ("patch" ,(ref '(gnu packages base) 'patch)))))
(define (default-guile) (define (default-guile)
"Return the default Guile package for SYSTEM." "Return the default Guile package used to run the build code of
derivations."
(let ((distro (resolve-interface '(gnu packages commencement)))) (let ((distro (resolve-interface '(gnu packages commencement))))
(module-ref distro 'guile-final))) (module-ref distro 'guile-final)))
@ -899,3 +909,45 @@ symbolic output name, such as \"out\". Note that this procedure calls
`package-derivation', which is costly." `package-derivation', which is costly."
(let ((drv (package-derivation store package system))) (let ((drv (package-derivation store package system)))
(derivation->output-path drv output))) (derivation->output-path drv output)))
;;;
;;; Monadic interface.
;;;
(define (set-guile-for-build guile)
"This monadic procedure changes the Guile currently used to run the build
code of derivations to GUILE, a package object."
(lambda (store)
(let ((guile (package-derivation store guile)))
(%guile-for-build guile))))
(define* (package-file package
#:optional file
#:key
system (output "out") target)
"Return as a monadic value 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. When TARGET is true, use it as a
cross-compilation target triplet."
(lambda (store)
(define compute-derivation
(if target
(cut package-cross-derivation <> <> target <>)
package-derivation))
(let* ((system (or system (%current-system)))
(drv (compute-derivation store package system))
(out (derivation->output-path drv output)))
(if file
(string-append out "/" file)
out))))
(define package->derivation
(store-lift package-derivation))
(define package->cross-derivation
(store-lift package-cross-derivation))
(define origin->derivation
(store-lift package-source-derivation))

3
guix/profiles.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014 Alex Kost <alezost@gmail.com> ;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;;; ;;;
@ -25,6 +25,7 @@
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix store)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)

7
guix/scripts/archive.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -170,7 +170,10 @@ derivation of a package."
(package-name p)))) (package-name p))))
(package-derivation store p system))) (package-derivation store p system)))
((? procedure? proc) ((? procedure? proc)
(run-with-store store (proc) #:system system)))) (run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(proc)) #:system system))))
(define (options->derivations+files store opts) (define (options->derivations+files store opts)
"Given OPTS, the result of 'args-fold', return a list of derivations to "Given OPTS, the result of 'args-fold', return a list of derivations to

12
guix/scripts/build.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -347,12 +347,18 @@ packages."
((? package? p) ((? package? p)
`(argument . ,p)) `(argument . ,p))
((? procedure? proc) ((? procedure? proc)
(let ((drv (run-with-store store (proc) #:system system))) (let ((drv (run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(proc))
#:system system)))
`(argument . ,drv))) `(argument . ,drv)))
((? gexp? gexp) ((? gexp? gexp)
(let ((drv (run-with-store store (let ((drv (run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(gexp->derivation "gexp" gexp (gexp->derivation "gexp" gexp
#:system system)))) #:system system)))))
`(argument . ,drv))))) `(argument . ,drv)))))
(opt opt)) (opt opt))
opts)) opts))

5
guix/scripts/environment.scm
View File

@ -232,7 +232,10 @@ packages."
(command (assoc-ref opts 'exec)) (command (assoc-ref opts 'exec))
(inputs (packages->transitive-inputs (inputs (packages->transitive-inputs
(pick-all (options/resolve-packages opts) 'package))) (pick-all (options/resolve-packages opts) 'package)))
(drvs (run-with-store store (build-inputs inputs opts)))) (drvs (run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(build-inputs inputs opts)))))
(cond ((assoc-ref opts 'dry-run?) (cond ((assoc-ref opts 'dry-run?)
#t) #t)
((assoc-ref opts 'search-paths) ((assoc-ref opts 'search-paths)

6
guix/scripts/system.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -553,6 +553,8 @@ Build the operating system declared in FILE according to ACTION.\n"))
(set-build-options-from-command-line store opts) (set-build-options-from-command-line store opts)
(run-with-store store (run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(perform-action action os (perform-action action os
#:dry-run? dry? #:dry-run? dry?
#:use-substitutes? (assoc-ref opts 'substitutes?) #:use-substitutes? (assoc-ref opts 'substitutes?)
@ -564,7 +566,7 @@ Build the operating system declared in FILE according to ACTION.\n"))
(_ #f)) (_ #f))
opts) opts)
#:grub? grub? #:grub? grub?
#:target target #:device device) #:target target #:device device))
#:system system)))) #:system system))))
;;; system.scm ends here ;;; system.scm ends here

86
guix/store.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -20,6 +20,7 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix config) #:use-module (guix config)
#:use-module (guix serialization) #:use-module (guix serialization)
#:use-module (guix monads)
#:autoload (guix base32) (bytevector->base32-string) #:autoload (guix base32) (bytevector->base32-string)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
@ -94,6 +95,15 @@
register-path register-path
%store-monad
store-bind
store-return
store-lift
run-with-store
%guile-for-build
text-file
interned-file
%store-prefix %store-prefix
store-path? store-path?
direct-store-path? direct-store-path?
@ -834,6 +844,80 @@ be used internally by the daemon's build hook."
;; Failed to run %GUIX-REGISTER-PROGRAM. ;; Failed to run %GUIX-REGISTER-PROGRAM.
#f))) #f)))
;;;
;;; Store monad.
;;;
;; return:: a -> StoreM a
(define-inlinable (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-inlinable (store-bind mvalue mproc)
"Bind MVALUE in MPROC."
(lambda (store)
(let* ((value (mvalue store))
(mresult (mproc value)))
(mresult store))))
;; This is essentially a state monad
(define-monad %store-monad
(bind store-bind)
(return store-return))
(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, a string."
(lambda (store)
(add-text-to-store store name text '())))
(define* (interned-file file #:optional name
#:key (recursive? #t))
"Return the name of FILE once interned in the store. Use NAME as its store
name, or the basename of FILE if NAME is omitted.
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
permission bits are kept."
(lambda (store)
(add-to-store store (or name (basename file))
recursive? "sha256" file)))
(define %guile-for-build
;; The derivation of the Guile to be used within the build environment,
;; when using 'gexp->derivation' and co.
(make-parameter #f))
(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 guile-for-build)
(%current-system system))
(mval store)))
;;; ;;;
;;; Store paths. ;;; Store paths.

3
guix/svn-download.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in> ;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -20,6 +20,7 @@
(define-module (guix svn-download) (define-module (guix svn-download)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (ice-9 match) #:use-module (ice-9 match)

3
tests/monads.scm
View File

@ -21,8 +21,7 @@
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module ((guix packages) #:use-module (guix packages)
#:select (package-derivation %current-system))
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages bootstrap) #:use-module (gnu packages bootstrap)
#:use-module ((gnu packages base) #:select (coreutils)) #:use-module ((gnu packages base) #:select (coreutils))