From e87f0591f3117ed61285f33c7cc3548f72e551ad Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 14 Jan 2015 13:34:52 +0100
Subject: 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.
---
 guix/packages.scm | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 55 insertions(+), 3 deletions(-)

(limited to 'guix/packages.scm')

diff --git a/guix/packages.scm b/guix/packages.scm
index 2a9a55e12f..909aa6d90d 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1,5 +1,5 @@
 ;;; 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>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -21,6 +21,7 @@ (define-module (guix packages)
   #:use-module (guix utils)
   #:use-module (guix records)
   #:use-module (guix store)
+  #:use-module (guix monads)
   #:use-module (guix base32)
   #:use-module (guix derivations)
   #:use-module (guix build-system)
@@ -108,7 +109,15 @@ (define-module (guix packages)
             bag-transitive-inputs
             bag-transitive-host-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:
 ;;;
@@ -317,7 +326,8 @@ (define (%standard-patch-inputs)
       ("patch" ,(ref '(gnu packages base) 'patch)))))
 
 (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))))
     (module-ref distro 'guile-final)))
 
@@ -899,3 +909,45 @@ (define* (package-output store package
 `package-derivation', which is costly."
   (let ((drv (package-derivation store package system)))
     (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))
-- 
cgit v1.2.3