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.

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