summaryrefslogtreecommitdiff
path: root/guix/monads.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-01-14 13:34:52 +0100
committerLudovic Courtès <ludo@gnu.org>2015-01-14 13:34:52 +0100
commite87f0591f3117ed61285f33c7cc3548f72e551ad (patch)
treefcfbd9ee742721b4d30ddc2b863436f5bd0c17c2 /guix/monads.scm
parent1ed194646b22600e002ab8050905fd428d3036fc (diff)
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.
Diffstat (limited to 'guix/monads.scm')
-rw-r--r--guix/monads.scm137
1 files changed, 1 insertions, 136 deletions
diff --git a/guix/monads.scm b/guix/monads.scm
index 20fee79602..7fec3d5168 100644
--- a/guix/monads.scm
+++ b/guix/monads.scm
@@ -17,9 +17,6 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix monads)
- #:use-module (guix store)
- #:use-module (guix derivations)
- #:use-module (guix packages)
#:use-module ((system syntax)
#:select (syntax-local-binding))
#:use-module (ice-9 match)
@@ -49,22 +46,7 @@
anym
;; Concrete monads.
- %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))
+ %identity-monad))
;;; Commentary:
;;;
@@ -309,121 +291,4 @@ lifted in MONAD, for which PROC returns true."
(bind identity-bind)
(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