(import (scheme base) (scheme write) (zilch statusbar) (zilch nix daemon) (zilch lib getopt) (scheme process-context) (chicken process-context) (srfi 146) (chicken port))
(define (print-help msg)
  (when msg
    (write-string (string-append msg "\n\n") (current-error-port)))
  (write-string "Usage: zilch-cli-go [OPTION] [PACKAGE...]
Process the given module (or the current directory, if unspecified) and
output derivations for each package given on the command line (or all
executables in the module, if unspecified)

  -h, --help              Print this help message.
  -b, --build             Build the store paths, rather than show their
                          derivations.
  -L, --print-build-logs  Print derivation logs as they come in.
  -m, --module-dir DIR    The directory to use as root module.
  -r, --replace DIR       Replace the module specified by the go.mod
                          with this source directory, rather than using
                          the upstream module. Can be specified more
                          than once.

   --debug                Crash on the first error, rather than
                          continuing with the next package.
" (current-error-port))
  (exit (or (not msg) 1)))

(define-values (options args)
 (getopt
  '((help #f #\h)
    (module-dir #t #\m)
    (print-build-logs #f #\L)
    (build #f #\b)
    (replace #t #\r)
    (debug #f))
  (list->vector (cdr (command-line)))
  print-help))
(when (assoc 'help options) (print-help #f))

(define module-dir (if (assoc 'module-dir options) (cdr (assoc 'module-dir options)) (current-directory)))

(define (set-print-logs val) #f)

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

(define do-build (assoc 'build options))
(define do-debug (assoc 'debug options))

(import
  (scheme file) (chicken file) (chicken format)
  (zilch magic)
  (zilch lang go mod) (zilch lang go vfs) (zilch lang go)
  (zilch nix drv)
  (zilch lang go))

(unless (file-exists? (string-append module-dir "/go.mod"))
  (set-print-logs #t)
  (fprintf (current-error-port) "Refusing to use directory ~S as it contains no go.mod.\n" module-dir)
  (exit 1))
(define vfs (vfs-from-directory module-dir))
(define replaces '())
(for-each
  (lambda (kv)
    (when (eq? (car kv) 'replace)
      (unless (file-exists? (string-append (cdr kv) "/go.mod"))
        (set-print-logs #t)
        (fprintf (current-error-port) "Refusing to use directory ~S as it contains no go.mod.\n" (cdr kv))
        (exit 1))
      (set! replaces (cons (vfs-from-directory (cdr kv)) replaces))))
  options)

(define-values (module-name collected-requires) (collect-requirements-for-module vfs replaces))
(define-values (find-package find-packages-for-module) (collect-packages-from-requires collected-requires))

(define (print-package-info package-name skip-if-not-bin)
  (define-values (package err)
    (call-with-current-continuation
      (lambda (cc)
        (if do-debug
          (values (find-package package-name) #f)
          (with-exception-handler (lambda (err) (cc #f err)) (lambda () (values (find-package package-name) #f)))))))
  (if err
    (write-string (string-append package-name "\tskipped: " (error-object-message err) "\n"))
    (begin
      (if (string=? (go-package-name package) "main")
        (let ((linked (go-package-link package)))
          (write-string (string-append package-name "\t"))
          (store-path-materialize linked)
          (if do-build
            (begin
              (store-path-build linked)
              (write-string (store-path-realisation linked)))
            (write-string (derivation-path (store-path-drv linked))))
          (newline))
        (unless skip-if-not-bin
          (write-string (string-append package-name "\tnot a binary\n")))))))

(if (eqv? args '())
   (for-each
     (lambda (package) (print-package-info package #t))
     (find-packages-for-module module-name))
   (for-each
     (lambda (package) (print-package-info package #f))
     args))