(define-module (loadavg ui)
  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
  #:use-module (ice-9 rdelim)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-1)
  #:use-module (ssh session)
  #:use-module (ssh auth)
  #:use-module (ssh popen)
  #:use-module ((guix ui) #:select (colorize-string))
  #:autoload   (ice-9 ftw)  (scandir)
  #:use-module ((guix ui) #:select (G_ leave))
  #:use-module (loadavg config)
  #:export (loadavg-main))

(define (show-bug-report-information)
  ;; TRANSLATORS: The placeholder indicates the bug-reporting address for this
  ;; package.  Please add another line saying "Report translation bugs to
  ;; ...\n" with the address for translation bugs (typically your translation
  ;; team's web or email address).
  (format #t (G_ "
Report bugs to: ~a.") %loadavg-bug-report-address)
  (format #t (G_ "
~a home page: <~a>") %loadavg-package-name %loadavg-home-page-url)
  (newline))

(define (show-loadavg-usage)
  (format (current-error-port)
          "Try `loadavg --help' for more information.~%")
  (exit 1))

(define (command-files)
  "Return the list of source files that define LOADAVG sub-commands."
  (define directory
    (and=> (search-path %load-path "loadavg.scm")
           (compose (cut string-append <> "/loadavg/scripts")
                    dirname)))

  (define dot-scm?
    (cut string-suffix? ".scm" <>))

  (if directory
      (scandir directory dot-scm?)
      '()))

(define (commands)
  "Return the list of LOADAVG command names."
  (map (compose (cut string-drop-right <> 4)
                basename)
       (command-files)))

(define (show-loadavg-help)
  (format
    #t
    "Usage: loadavg COMMAND ARGS...\nRun COMMAND with ARGS.\n")
  (newline)
  (format
    #t
    "COMMAND must be one of the sub-commands listed below:\n")
  (newline)
  (format
    #t
    "~{   ~a~%~}"
    (sort (commands) string<?))
  (show-bug-report-information))

(define program-name
  ;; Name of the command-line program currently executing, or #f.
  (make-parameter #f))

(define (run-loadavg-command command . args)
  "Run COMMAND with the given ARGS.  Report an error when COMMAND is not
found."
  (define module
    (catch 'misc-error
      (lambda ()
        (resolve-interface `(loadavg scripts ,command)))
      (lambda -
        (format (current-error-port)
                "loadavg: ~a: command not found~%" command)
        (show-loadavg-usage))))

  (let ((command-main (module-ref module
                                  (symbol-append 'loadavg- command))))
    (parameterize ((program-name command))
      ;; Disable canonicalization so we don't don't stat unreasonably.
      (with-fluids ((%file-port-name-canonicalization #f))
        (dynamic-wind
          (const #f)
          (lambda ()
            (apply command-main args))
          (lambda ()
            ;; Abuse 'exit-hook' (which is normally meant to be used by the
            ;; REPL) to run things like profiling hooks upon completion.
            (run-hook exit-hook)))))))

(define (run-loadavg . args)
  "Run the 'loadavg' command defined by command line ARGS."
  ;; The default %LOAD-EXTENSIONS includes the empty string, which doubles the
  ;; number of 'stat' calls per entry in %LOAD-PATH.  Shamelessly remove it.
  (set! %load-extensions '(".scm"))

  (match args
    (()
     (format (current-error-port) "loadavg: missing command name~%")
     (show-loadavg-usage))
    ((or ("-h") ("--help"))
     (show-loadavg-help))
    ((command args ...)
     (apply run-loadavg-command (string->symbol command) args))))

(define (loadavg-main arg0 . args)
  (apply run-loadavg args))


;;;
;;; main
;;;

(define* (main #:optional (args (command-line)))
  (exit (apply loadavg-main args)))