#!@GUILE@ --no-auto-compile
-*- scheme -*-
-*- geiser-scheme-implementation: guile -*-
!#
;;; Guix Data Service -- Information about Guix over time
;;; 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 guix-data-service.
;;;
;;; guix-data-service 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.
;;;
;;; guix-data-service 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 guix-data-service.  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)
             (guix-qa-frontpage database)
             (guix-qa-frontpage manage-builds)
             (guix-qa-frontpage git-repository)
             (guix-qa-frontpage manage-patch-branches)
             (guix-qa-frontpage 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 '("database") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'database
                              arg
                              result)))
        (option '("submit-builds") #f #f
                (lambda (opt name _ result)
                  (alist-cons 'submit-builds #t result)))
        (option '("manage-patch-branches") #f #f
                (lambda (opt name _ result)
                  (alist-cons 'manage-patch-branches #t result)))))

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

    (assets-directory  . ,(let ((install-dir
                                 "@prefix@/share/guix-qa-frontpage/assets")
                                (dev-dir
                                 (string-append (getcwd) "/assets")))
                            (if (file-exists? install-dir)
                                install-dir
                                dev-dir)))
    (database . ,(string-append (getcwd)
                                "/guix_qa_frontpage.db"))
    (submit-builds . #f)
    (manage-patch-branches . #f)))

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

  (parameterize
      ((%git-repository-location (string-append (getcwd) "/guix.git")))
    (let* ((metrics-registry (make-metrics-registry
                              #:namespace
                              "guixqafrontpage"))
           (database
            (setup-database (assq-ref opts 'database)
                            metrics-registry))

           (patch-issues-to-show 200))

      (start-refresh-patch-branches-data-thread
       database
       #:number-of-series-to-refresh
       (+ patch-issues-to-show 50))
      (start-refresh-non-patch-branches-data-thread database)

      (when (assq-ref opts 'submit-builds)
        (start-submit-patch-builds-thread database
                                          "http://127.0.0.1:8746"
                                          "https://data.qa.guix.gnu.org"
                                          #:series-count
                                          patch-issues-to-show)
        (start-submit-branch-builds-thread database
                                           "http://127.0.0.1:8746"
                                           "https://data.qa.guix.gnu.org")
        (start-submit-master-branch-system-tests-thread database
                                                        "http://127.0.0.1:8746"
                                                        "https://data.qa.guix.gnu.org"))

      (when (assq-ref opts 'manage-patch-branches)
        (start-manage-patch-branches-thread database
                                            #:series-count patch-issues-to-show))

      (start-guix-qa-frontpage-web-server
       (assq-ref opts 'port)
       (assq-ref opts 'host)
       (assq-ref opts 'assets-directory)
       database
       metrics-registry
       #:controller-args `(#:patch-issues-to-show ,patch-issues-to-show)))))