From f220a8384890b2a50f30c62fba56e507333f1a92 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 14 Jan 2015 14:42:10 +0100
Subject: packages: Convert source derivations to monadic style.

* guix/packages.scm (origin->derivation): Take body from
  'package-source-derivation', and change it to monadic style.  Expect
  METHOD to a monadic procedure.
  (package-source-derivation): Define in terms of 'origin->derivation'.
* guix/download.scm (url-fetch): Remove 'store' argument.  Remove
  'guile-for-build' variable.  Turn into a monadic procedure.
* guix/git-download.scm (git-fetch): Likewise.
* guix/svn-download.scm (svn-fetch): Likewise.
* tests/builders.scm (url-fetch*): New procedure.
  Change tests to call 'url-fetch*' instead of 'url-fetch'.
* tests/packages.scm ("package-source-derivation, snippet"): Remove
  'store' parameter of 'fetch' and change it to use 'interned-file'
  instead of 'add-to-store'.
* gnu/packages/bootstrap.scm (bootstrap-origin)[boot]: Remove 'store'
  parameter.
---
 guix/packages.scm | 73 ++++++++++++++++++++++++++++++-------------------------
 1 file changed, 40 insertions(+), 33 deletions(-)

(limited to 'guix/packages.scm')

diff --git a/guix/packages.scm b/guix/packages.scm
index 909aa6d90d..05ba389ad6 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -331,6 +331,7 @@ derivations."
   (let ((distro (resolve-interface '(gnu packages commencement))))
     (module-ref distro 'guile-final)))
 
+;; TODO: Rewrite using %STORE-MONAD and gexps.
 (define* (patch-and-repack store source patches
                            #:key
                            (inputs '())
@@ -476,37 +477,6 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
                                  #:modules modules
                                  #:guile-for-build guile-for-build)))
 
-(define* (package-source-derivation store source
-                                    #:optional (system (%current-system)))
-  "Return the derivation path for SOURCE, a package source, for SYSTEM."
-  (match source
-    (($ <origin> uri method sha256 name () #f)
-     ;; No patches, no snippet: this is a fixed-output derivation.
-     (method store uri 'sha256 sha256 name
-             #:system system))
-    (($ <origin> uri method sha256 name (patches ...) snippet
-        (flags ...) inputs (modules ...) (imported-modules ...)
-        guile-for-build)
-     ;; Patches and/or a snippet.
-     (let ((source (method store uri 'sha256 sha256 name
-                           #:system system))
-           (guile  (match (or guile-for-build (default-guile))
-                     ((? package? p)
-                      (package-derivation store p system
-                                          #:graft? #f)))))
-       (patch-and-repack store source patches
-                         #:inputs inputs
-                         #:snippet snippet
-                         #:flags flags
-                         #:system system
-                         #:modules modules
-                         #:imported-modules modules
-                         #:guile-for-build guile)))
-    ((and (? string?) (? direct-store-path?) file)
-     file)
-    ((? string? file)
-     (add-to-store store (basename file) #t "sha256" file))))
-
 (define (transitive-inputs inputs)
   (let loop ((inputs  inputs)
              (result '()))
@@ -949,5 +919,42 @@ cross-compilation target triplet."
 (define package->cross-derivation
   (store-lift package-cross-derivation))
 
-(define origin->derivation
-  (store-lift package-source-derivation))
+(define patch-and-repack*
+  (store-lift patch-and-repack))
+
+(define* (origin->derivation source
+                             #:optional (system (%current-system)))
+  "When SOURCE is an <origin> object, return its derivation for SYSTEM.  When
+SOURCE is a file name, return either the interned file name (if SOURCE is
+outside of the store) or SOURCE itself (if SOURCE is already a store item.)"
+  (match source
+    (($ <origin> uri method sha256 name () #f)
+     ;; No patches, no snippet: this is a fixed-output derivation.
+     (method uri 'sha256 sha256 name #:system system))
+    (($ <origin> uri method sha256 name (patches ...) snippet
+        (flags ...) inputs (modules ...) (imported-modules ...)
+        guile-for-build)
+     ;; Patches and/or a snippet.
+     (mlet %store-monad ((source (method uri 'sha256 sha256 name
+                                         #:system system))
+                         (guile  (package->derivation (or guile-for-build
+                                                          (default-guile))
+                                                      system
+                                                      #:graft? #f)))
+       (patch-and-repack* source patches
+                          #:inputs inputs
+                          #:snippet snippet
+                          #:flags flags
+                          #:system system
+                          #:modules modules
+                          #:imported-modules modules
+                          #:guile-for-build guile)))
+    ((and (? string?) (? direct-store-path?) file)
+     (with-monad %store-monad
+       (return file)))
+    ((? string? file)
+     (interned-file file (basename file)
+                    #:recursive? #t))))
+
+(define package-source-derivation
+  (store-lower origin->derivation))
-- 
cgit v1.2.3