(zilch magic): make store-path-open more magic

This resolves store paths that aren't obvious; and adds
store-path-realised for external use of the mechanisms.

core/src/magic.sld

@@ -6,7 +6,7 @@
     (scheme base) (scheme file)
     (zilch lib hash) (zilch nix daemon) (zilch nix drv) (zilch nix path)
     (zilch zexpr)
-    (srfi 132)
+    (srfi 128) (srfi 132) (srfi 146) (srfi 152)
     (chicken base) (chicken format) socket)
 
   (export
@@ -18,7 +18,7 @@
     store-path-path store-path-build store-path-materialize store-path-realisation
     store-path-for-text store-path-for-fod store-path-for-drv
     store-path-for-impure-drv store-path-for-ca-drv store-path-for-ca-drv*
-    store-path-open
+    store-path-realised store-path-open
    
     zilch-magic-counters)
 
@@ -172,39 +172,72 @@
      (for-each (lambda (item) (when (eq? (member item left) #f) (set! left (cons item left)))) right)
      (list-sort string<? left))
 
+   (define (resolve-upstream-output-placeholders path drv-context)
+     (define known-placeholders (mapping (make-default-comparator)))
+     ; Returns #t if placeholder was replaced
+     (define (replace-placeholder placeholder replacement start-index)
+       (define index (string-contains path placeholder start-index))
+       (if index
+         (begin
+           (set! path (string-replace path replacement index (+ index (string-length placeholder))))
+           (replace-placeholder placeholder replacement (+ index (string-length replacement))))
+         (> start-index 0)))
+
+     (define context-to-build '())
+     (define drv-output-map #f)
+
+     (define (process-output output-name output drv)
+       (define needs-building #f)
+       (when (and (derivation-output-placeholder? output) (string-contains path (derivation-output-path output)))
+         (unless drv-output-map
+           (set! drv-output-map (daemon-wop-query-derivation-output-map (*daemon*) (derivation-path drv))))
+         (unless (assoc output-name drv-output-map)
+           (daemon-wop-build-paths (*daemon*) (vector (string-append (derivation-path drv) "!" output-name)))
+           (set! drv-output-map (daemon-wop-query-derivation-output-map (*daemon*) (derivation-path drv))))
+         (let* ((known-path (cdr (assoc output-name drv-output-map)))
+                (is-replaced (replace-placeholder (derivation-output-path output) known-path 0)))
+           (when (and is-replaced (not (file-exists? known-path)))
+             (set! needs-building #t))))
+       (when (or needs-building (not (or (derivation-output-placeholder? output) (file-exists? (derivation-output-path output)))))
+         (set! context-to-build (cons (string-append (derivation-path drv) "!" output-name) context-to-build))))
+     (for-each
+       (lambda (drv-outputs)
+         (set! drv-output-map #f)
+         (for-each
+           (lambda (output-name)
+             (process-output output-name (cdr (assoc output-name (derivation-outputs (car drv-outputs)))) (car drv-outputs)))
+           (cdr drv-outputs)))
+       drv-context)
+     (values path context-to-build))
+
+   (define (zexp-ctx-has-placeholder drv-context)
+     (if (null? drv-context)
+       #f
+       (let ((drv (caar drv-context))
+             (outputs (cdar drv-context))
+             (has-placeholder #f))
+         (for-each (lambda (output) (set! has-placeholder (or has-placeholder (derivation-output-placeholder? (cdr (assoc output (derivation-outputs drv))))))) outputs)
+         (or has-placeholder (zexp-ctx-has-placeholder (cdr drv-context))))))
+
+   (define (store-path-realised path)
+     (define ctx (zexp-unwrap (zexp (zexp-unquote path))))
+     (define val (zexp-evaluation-value ctx))
+     (define to-build '())
+     (if (string? val)
+       (let-values (((resolved resolved-to-build) (resolve-upstream-output-placeholders val (zexp-evaluation-drvs ctx))))
+         (set! val resolved)
+         (set! to-build resolved-to-build))
+       (when (zexp-ctx-has-placeholder (zexp-evaluation-drvs ctx))
+         (error "store-path-realised: expression has dependencies on placeholder context, but isn't a string" (list path val))))
+     (when (and (string? val) (not (file-exists? val)) (not (null? to-build)))
+       (daemon-wop-build-paths (*daemon*) (list->vector to-build)))
+     val)
+
    ;; Ensures the `<store-path>` exists, then opens an input port to allow reading from it.
    (define (store-path-open path)
      (increment-counter 2)
-     (if (store-path? path)
+     (define output-path (store-path-realised path))
-      (let ((out-path (store-path-realisation path)))
+     (open-input-file output-path))
-       (unless (and out-path (file-exists? out-path)) (store-path-materialize path) (store-path-build path))
-       (unless out-path (set! out-path (store-path-realisation path)))
-       (open-input-file out-path))
-      (let* ((ctx (zexp-unwrap (zexp (zexp-unquote path)))) (val (zexp-evaluation-value ctx)))
-
-       ; TODO(puck): big hack to make file->store work
-       (for-each
-        (lambda (drv)
-         (for-each
-          (lambda (output)
-           (when (and (string=? (string-append (derivation-output-path (cdr output)) "/-") val)
-                      (not (or (not (derivation-output-hash (cdr output)))
-                               (bytevector? (derivation-output-hash (cdr output))))))
-            (daemon-wop-build-paths (*daemon*) (vector (string-append (derivation-path (car drv)) "!" (car output))))
-            (set! val (string-append (cdr (assoc (car output) (daemon-wop-query-derivation-output-map (*daemon*) (derivation-path (car drv))))) "/-"))))
-          (derivation-outputs (car drv))))
-        (zexp-evaluation-drvs ctx))
-
-       (unless (file-exists? val)
-        (for-each
-         (lambda (path)
-          (for-each
-           (lambda (output)
-            (daemon-wop-build-paths (*daemon*) (vector (string-append (derivation-path (car path)) "!" output))))
-           (cdr path)))
-         (zexp-evaluation-drvs ctx)))
-
-       (open-input-file val))))
 
    (zexp-add-unquote-handler
      (lambda (val)