#!@GUILE@ --no-auto-compile
-*- scheme -*-
-*- geiser-scheme-implementation: guile -*-
!#
;;; bffe - Build farm front-end
;;; Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;;
;;; This file is part of bffe.
;;;
;;; bffe is free software; you can redistribute it and/or modify it under the
;;; terms of the GNU General Public License as published by the Free Software
;;; Foundation; either version 3 of the License, or (at your option) any later
;;; version.
;;;
;;; bffe is distributed in the hope that it will be useful, but WITHOUT ANY
;;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
;;; FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
;;; details.
;;;
;;; You should have received a copy of the GNU General Public License along
;;; with the bffe.  If not, see <http://www.gnu.org/licenses/>.

(use-modules (srfi srfi-1)
             (srfi srfi-37)
             (ice-9 match)
             (ice-9 textual-ports)
             (system repl server)
             (system repl repl)
             (gcrypt pk-crypto)
             (guix pki)
             (prometheus)
             (bffe server))

(define %options
  ;; Specifications of the command-line options
  (list (option '("repl") #f #t
                (lambda (opt name arg result)
                  (alist-cons 'repl #t (alist-delete 'repl result))))
        (option '("pid-file") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'pid-file
                              arg
                              result)))
        (option '("port") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'port
                              (string->number arg)
                              (alist-delete 'port result))))
        (option '("host") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'host
                              arg
                              (alist-delete 'host result))))
        (option '("title") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'title
                              arg
                              result)))
        (option '("template-directory") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'template-directory
                              arg
                              result)))))

(define %default-options
  ;; Alist of default option values
  `((port              . 8767)
    (host              . "0.0.0.0")

    (assets-directory  . ,(let ((install-dir
                                 "@prefix@/share/bffe/assets")
                                (dev-dir
                                 (string-append (getcwd) "/assets")))
                            (if (file-exists? install-dir)
                                install-dir
                                dev-dir)))
    (title . "Build farm")
    (template-directory . ,(let ((install-dir
                                  "@prefix@/share/bffe/templates")
                                 (dev-dir
                                  (string-append (getcwd) "/templates")))
                             (if (file-exists? install-dir)
                                 install-dir
                                 dev-dir)))))

(define (parse-options args)
  (args-fold
   args %options
   (lambda (opt name arg result)
     (error "unrecognized option" name))
   (lambda (arg result)
     (error "extraneous argument" arg))
   %default-options))

(setvbuf (current-output-port) 'line)
(setvbuf (current-error-port) 'line)

(let ((opts (parse-options (cdr (program-arguments)))))
  (let ((pid-file (assq-ref opts 'pid-file)))
    (when pid-file
      (call-with-output-file pid-file
        (lambda (port)
          (simple-format port "~A\n" (getpid))))))

  ;; Provide some visual space between the startup output and the
  ;; server starting
  (simple-format #t "\n\nStarting the server on http://~A:~A/\n\n"
                 (assq-ref opts 'host)
                 (assq-ref opts 'port))

  (let* ((metrics-registry (make-metrics-registry
                            #:namespace
                            "bffe")))

    (start-bffe-web-server
     (assq-ref opts 'port)
     (assq-ref opts 'host)
     (assq-ref opts 'assets-directory)
     metrics-registry
     #:controller-args
     (list (assq-ref opts 'title)
           (assq-ref opts 'template-directory)))))