zilch/cli/zilch-ninja.scm

(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] 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
                          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)
    (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)))

;; 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)
(ca-thread-count max-jobs)

(import
  (scheme base) (scheme file) (scheme read)
  (chicken format) (chicken process) (chicken file)
  (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 128) (srfi 146) (srfi 152))

(define source (and (assoc 'source options) (cdr (assoc 'source options))))

(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))))

(when (and (ninja-build-config-depfile-path config) (file-exists? (ninja-build-config-depfile-path config)))
  (set-ninja-build-config-depfile! config (alist->mapping (make-default-comparator) (call-with-input-file (ninja-build-config-depfile-path config) 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-values (((built export-depfile) (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)
    (when (ninja-build-config-depfile-path config)
     (call-with-output-file (ninja-build-config-depfile-path config) (lambda (p) (write (mapping->alist (export-depfile)) p)))))
   (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)))))