zilch-cli-ninja: add subcommands for extracting source and running diff

Change-Id: I6a6a6964eb887c7a56b4a150196403fac5066bec

cli/zilch-ninja.scm

@@ -8,13 +8,26 @@
 (define (print-help msg)
   (when msg
     (write-string (string-append msg "\n\n") (current-error-port)))
-  (write-string "Usage: zilch-cli-ninja [OPTION] [TARGET...]
+  (write-string "Usage: zilch-cli-ninja [OPTION] SUBCOMMAND ...
 Processes a Ninja build based on the configuration in the passed-in
 config file (or zilch.scm, if not set), and reproducibly builds either
 to final build, or to specific Ninja targets.
 
+Supported commands:
+  build [TARGET]          Build the full drv, or specific targets from
+                          its Ninja file.
+  source [DIR]            Extract the source of the derivation to DIR
+                          (or src, if unspecified), ready for Zilch.
+  diff                    Print the difference between the original and
+                          modified sources as found in either `src' or
+                          the directory selected by --source.
+
+Arguments:
   -h, --help              Print this help message.
   -f, --config-file PATH  Path to the Zilch config file.
+  -s, --source DIR        Override the input source for builds. Doesn't
+                          reconfigure the build, so changes to the
+                          build system will not apply.
   -j, --max-jobs COUNT    The maximum amount of builds to run. Defaults
                           to the amount of cores.
   -v, --verbose           Increase the verbosity configured in the Nix
@@ -29,21 +42,25 @@ to final build, or to specific Ninja targets.
     (config-file #t #\f)
     (max-jobs #t #\j)
     (verbose #f #\v)
+    (source #t #\s)
     (print-build-logs #f #\L))
   (list->vector (cdr (command-line)))
   print-help))
 
 (when (assoc 'help options) (print-help #f))
 
+(when (null? args)
+  (print-help "No subcommand"))
+
 ; Set up the logger.
 (define (set-print-logs val) #f)
 (let ((prev-error-handler (current-exception-handler))) (current-exception-handler (lambda data (set-print-logs #t) (apply prev-error-handler data))))
-; (when (terminal-port? (current-error-port))
-;  (let-values (((new-out new-err statusbar-set-print-logs logger) (statusbar-logger (current-output-port) (current-error-port) (assoc 'print-build-logs options))))
-;    (current-output-port new-out)
-;    (current-error-port new-err)
-;    (set! set-print-logs statusbar-set-print-logs)
-;    (*logger* logger)))
+(when (terminal-port? (current-error-port))
+ (let-values (((new-out new-err statusbar-set-print-logs logger) (statusbar-logger (current-output-port) (current-error-port) (assoc 'print-build-logs options))))
+   (current-output-port new-out)
+   (current-error-port new-err)
+   (set! set-print-logs statusbar-set-print-logs)
+   (*logger* logger)))
 
 ;; Flags passed to the nix daemon:
 (define max-jobs (if (assoc 'max-jobs options) (string->number (cdr (assoc 'max-jobs options))) (get-cpu-count)))
@@ -56,7 +73,7 @@ to final build, or to specific Ninja targets.
 
 (import
   (scheme base) (scheme file) (scheme read)
-  (chicken format)
+  (chicken format) (chicken process)
   (zilch lang ninja) (zilch lang ninja build)
   (zilch lang ninja nixpkgs)
   (zilch lang ninja config)
@@ -65,19 +82,38 @@ to final build, or to specific Ninja targets.
   (zilch zexpr)
   (srfi 152))
 
-(define config-path (if (assoc 'config-file options) (cdr (assoc 'config-file options)) "zilch.scm"))
-(define config (parse-ninja-config (call-with-input-file config-path read)))
+(define source (and (assoc 'source options) (cdr (assoc 'source options))))
 
-(if (null? args)
- (let ((built (build-nixpkgs-drv-reproducibly config)))
-  (for-each
-   (lambda (output-and-path)
-    (store-path-realised (cdr output-and-path))
-    (printf "~A\t-> ~S\n" (car output-and-path) (cdr output-and-path)))
-   built))
- (let-values (((_ _ _ edge-ref defaults) (setup-ninja-environment config)))
-  (for-each
-   (lambda (target)
-    (define built-target (edge-ref target))
-    (printf "~A\t-> ~S\n" target (store-path-realised (force (built-edge-out-drv (cdr built-target))))))
-   args)))
+(define config-path (if (assoc 'config-file options) (cdr (assoc 'config-file options)) "zilch.scm"))
+(define config (parse-ninja-config `(override-source: ,source ,@(call-with-input-file config-path read))))
+
+(cond
+ ((string=? (car args) "source")
+  (let*-values
+   (((_ configured-drv _ _ _) (setup-ninja-environment config))
+    ((realised) (store-path-realised configured-drv))
+    ((path) (if (null? (cdr args)) "src" (cadr args))))
+   (system* (string-append "cp -rf --no-preserve=ownership " realised "/src " (qs path)))
+   (system* (string-append "chmod -R u+rw " (qs path)))))
+ ((string=? (car args) "build")
+  (if (null? (cdr args))
+   (let ((built (build-nixpkgs-drv-reproducibly config)))
+    (for-each
+     (lambda (output-and-path)
+      (store-path-realised (cdr output-and-path))
+      (printf "~A\t-> ~S\n" (car output-and-path) (cdr output-and-path)))
+     built))
+   (let-values (((_ _ _ edge-ref defaults) (setup-ninja-environment config)))
+    (for-each
+     (lambda (target)
+      (define built-target (edge-ref target))
+      (printf "~A\t-> ~S\n" target (store-path-realised (force (built-edge-out-drv (cdr built-target))))))
+     (cdr args)))))
+ ((string=? (car args) "diff")
+  (let*-values
+   (((_ configured-drv _ _ _) (setup-ninja-environment config))
+    ((realised) (store-path-realised configured-drv))
+    ((path) (or source "src")))
+   (process-execute "git" (list "diff" "--no-index" "--" (string-append realised "/src") path))))
+ (else
+  (print-help (string-append "Unknown subcommand " (car args)))))