zilch-cli-ninja: initialize

Change-Id: I6a6a6964ba06a7bf26e46010d9d0920e28f63e50

cli/cli.egg

@@ -1,11 +1,13 @@
 ((version "0.0.1")
  (synopsis "meow")
  (author "puck")
- (dependencies r7rs zilch zilch-lang-go zilch-lang-rust)
+ (dependencies r7rs zilch zilch-lang-go zilch-lang-rust zilch-lang-ninja)
  (component-options 
   (csc-options "-X" "r7rs" "-R" "r7rs" "-optimize-level" "3" "-C" "-D_GNU_SOURCE"))
  (components
   (program zilch-cli-go
    (source "zilch-go.scm"))
   (program zilch-cli-rust
-   (source "zilch-rust.scm"))))
+   (source "zilch-rust.scm"))
+  (program zilch-cli-ninja
+   (source "zilch-ninja.scm"))))

cli/default.nix

@@ -8,6 +8,7 @@ eggDerivation {
     (pkgs.callPackage ../core {})
     (pkgs.callPackage ../lang/go {})
     (pkgs.callPackage ../lang/rust {})
+    (pkgs.callPackage ../lang/ninja {})
   ];
 
   preBuild = ''

cli/zilch-ninja.scm

@@ -0,0 +1,81 @@
+(import (scheme base) (scheme write) (zilch statusbar) (zilch nix daemon) (zilch magic) (zilch lib getopt) (scheme process-context) (chicken process-context) (srfi 146) (chicken port) (chicken foreign) (chicken condition))
+(foreign-declare "#include <sched.h>")
+
+(define get-cpu-count
+  (foreign-lambda* int ()
+    "cpu_set_t set; sched_getaffinity(0, sizeof(set), &set); C_return(CPU_COUNT(&set));"))
+
+(define (print-help msg)
+  (when msg
+    (write-string (string-append msg "\n\n") (current-error-port)))
+  (write-string "Usage: zilch-cli-ninja [OPTION] [TARGET...]
+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.
+
+  -h, --help              Print this help message.
+  -f, --config-file PATH  Path to the Zilch config file.
+  -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
+                          daemon.
+  -L, --print-build-logs  Print derivation logs as they come in.
+" (current-error-port))
+  (exit (or (not msg) 1)))
+
+(define-values (options args)
+ (getopt
+  '((help #f #\h)
+    (config-file #t #\f)
+    (max-jobs #t #\j)
+    (verbose #f #\v)
+    (print-build-logs #f #\L))
+  (list->vector (cdr (command-line)))
+  print-help))
+
+(when (assoc 'help options) (print-help #f))
+
+; 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)))
+
+;; Flags passed to the nix daemon:
+(define max-jobs (if (assoc 'max-jobs options) (string->number (cdr (assoc 'max-jobs options))) (get-cpu-count)))
+(define verbosity 3)
+(for-each (lambda (val) (when (eq? (car val) 'verbose) (set! verbosity (+ 1 verbosity)))) options)
+(write-string (string-append "Connected to Nix daemon, version " (daemon-link-daemon-version (*daemon*)) "\n") (current-error-port))
+
+(daemon-wop-set-options (*daemon*) verbosity max-jobs #t)
+(import
+  (scheme base) (scheme file) (scheme read)
+  (chicken format)
+  (zilch lang ninja) (zilch lang ninja build)
+  (zilch lang ninja nixpkgs)
+  (zilch lang ninja config)
+  (zilch magic) (zilch nixpkgs) (zilch vfs)
+  (zilch nix drv)
+  (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)))
+
+(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)))