(define-module (bffe view activity)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-19)
  #:use-module (ice-9 match)
  #:use-module (bffe view util)
  #:use-module ((guix store) #:select (%store-prefix))
  #:export (activity))

(define (activity title state)
  (define categorised-agents
    (let ((categories
           '(("x86_64-linux" "i686-linux")
             ("aarch64-linux" "armhf-linux")
             ("powerpc64le-linux")
             ("riscv64-linux")
             ("i586-gnu"))))
      (map
       (lambda (systems)
         (cons systems
               (sort
                (filter
                 (lambda (agent)
                   (not
                    (null?
                     (lset-intersection
                      string=?
                      (vector->list
                       (assoc-ref agent "requested_systems"))
                      systems))))
                 (vector->list
                  (assoc-ref state "agents")))
                (lambda (a b)
                  (string<? (or (assoc-ref a "name") "")
                            (or (assoc-ref b "name") ""))))))
       categories)))

  (define (abbreviate-derivation drv)
    (let ((base (string-drop
                 drv
                 (+ 1 (string-length (%store-prefix))))))
      (string-drop-right
       (string-drop base (+ 32 1))      ;32 hash part + 1 hyphen
       4)))                             ;.drv

  (define (git-commit-hash-length? str)
    (= (string-length str) 40))

  (layout
   #:title (string-append "Activity — " title)
   #:head
   `((style "
table tr:nth-child(even) {
    background-color: var(--color-bg);
}

.agents {
    display: grid;
    column-gap: 5px;
    row-gap: 5px;
    grid-template-columns: repeat(auto-fill, minmax(355px, 355px));
}

.agent {
    border: 2px solid var(--color-bg-secondary);
    border-radius: var(--border-radius);
    padding: 8px;
}

.agent h4 {
    margin-block-start: 0px;
    font-size: 22px;
}

.agent-load {
    border-width: 0px 12px 0px 0px;
    border-style: solid;
    padding-right: 3px;

    border-radius: 3px;
}

.agent-load-normal {
    border-color: #28a745;
}

.agent-load-medium {
    border-color: orange;
}

.agent-load-high {
    border-color: red;
}

.agent-plan-size {
    float: right;
    clear: right;

    border-radius: 3px;
}

.build-tag {
    display: inline-block;
    padding: .2em .4em .3em;
    font-size: 77%;
    font-weight: 700;
    line-height: 1;
    text-align: center;
    white-space: nowrap;
    vertical-align: baseline;
    border-radius: .25em;

    background-color: var(--color-secondary-accent);
}

.build {
    overflow-x: auto;
    white-space: nowrap;

    padding-top: 3px;
    padding-bottom: 4px;
    margin-bottom: 3px;
}

.build:not(:first-child) {
    border-top: 2px solid var(--color-bg-secondary);
}

.hidden {
    display: none;
}

#recent-activity {
    width: 100%;
    height: 200px;
    overflow-y: scroll;
}

"))
   #:body
   `((main
      (@ (id "main")
         (data-stateid ,(assoc-ref state "state_id")))

      (h2 "Recent activity")
      (table
       (@ (id "recent-activity"))
       (tbody
        (@ (id "recent-activity-body"))))

      (h2 "Agents")
      ,@(append-map
         (match-lambda
           ((systems . agents)
            `((h3 (@ (class "monospace"))
                  ,(string-join systems ", "))

              (div
               (@ (class "agents"))

               ,@(filter-map
                  (lambda (agent)
                    (if (assoc-ref agent "active")
                        (let ((all-builds
                               (vector->list
                                (assoc-ref agent "builds"))))
                          `(div
                            (@ (class "agent")
                               (id
                                ,(string-append
                                  "agent-"
                                  (assoc-ref agent "uuid")))
                               (data-name
                                ,(assoc-ref agent "name")))
                            ,(let ((last-status-update
                                    (assoc-ref
                                     agent
                                     "last_status_update")))
                               (if (and last-status-update
                                        (and=>
                                         (assoc-ref last-status-update
                                                    "timestamp")
                                         (lambda (timestamp)
                                           (let ((seconds
                                                  (time-second
                                                   (time-difference
                                                    (current-time time-utc)
                                                    (date->time-utc
                                                     (string->date
                                                      (string-append timestamp "Z")
                                                      "~Y-~m-~d ~H:~M:~S~z"))))))
                                             (< seconds (* 60 5))))))
                                   (let* ((1min
                                           (assoc-ref
                                            last-status-update
                                            "1min_load_average"))
                                          (cores
                                           (assoc-ref
                                            last-status-update
                                            "processor_count"))
                                          (load-percentage
                                           (/ (* 100 1min)
                                              cores)))
                                     `(span
                                       (@ (style "float: right;")
                                          (id
                                           ,(string-append
                                             "agent-"
                                             (assoc-ref agent "uuid")
                                             "-load"))
                                          (class
                                            ,(string-append
                                              "agent-load "
                                              (cond
                                               ((< load-percentage 150)
                                                "agent-load-normal")
                                               ((< load-percentage 250)
                                                "agent-load-medium")
                                               (else
                                                "agent-load-high"))))
                                          (data-value
                                           ,load-percentage))
                                       "Load: "
                                       ,(number->string
                                         (round load-percentage))
                                       "%"))
                                   `(span
                                     (@ (style "float: right;")
                                        (id
                                         ,(string-append
                                           "agent-"
                                           (assoc-ref agent "uuid")
                                           "-load"))
                                        (class "agent-load-unknown"))
                                     "Status unknown")))
                            (span
                             (@ (class "agent-plan-size")
                                (id
                                 ,(string-append
                                   "agent-"
                                   (assoc-ref agent "uuid")
                                   "-plan-size"))
                                (data-value
                                 ,(assoc-ref
                                   (assoc-ref agent "allocation_plan")
                                   "count")))
                             "Plan size: "
                             ,(assoc-ref
                               (assoc-ref agent "allocation_plan")
                               "count"))
                            (a (@ (href ,(string-append
                                          "/agent/"
                                          (assoc-ref agent "uuid"))))
                               (h4 (@ (style "display: block;"))
                                   ,(assoc-ref agent "name")))
                            (div
                             (@ (class "agent-builds")
                                (id
                                 ,(string-append
                                   "agent-"
                                   (assoc-ref agent "uuid")
                                   "-builds")))
                             ,@(map
                                (lambda (build index)
                                  (let ((tags
                                         (sort
                                          (vector->list
                                           (assoc-ref build "tags"))
                                          (lambda (a b)
                                            (string<?
                                             (assoc-ref a "key")
                                             (assoc-ref b "key"))))))
                                    `(div
                                      (@ (id
                                          ,(string-append
                                            "build-"
                                            (assoc-ref build "uuid")))
                                         (data-derivation
                                          ,(or (assoc-ref build "derivation_name")
                                               (assoc-ref build "derivation-name")))
                                         (class
                                           ,(string-append
                                             "build"
                                             (if (> index 3)
                                                 " hidden"
                                                 ""))))
                                      (a (@ (href
                                             ,(string-append
                                               "/build/"
                                               (assoc-ref build "uuid")))
                                            (style "display: block;"))
                                         (span
                                          (@ (class "monospace"))
                                          ,(abbreviate-derivation
                                            (or (assoc-ref build "derivation_name")
                                                (assoc-ref build "derivation-name")))))
                                      ,@(append-map
                                         (lambda (tag)
                                           `((span
                                              (@ (class "build-tag"))
                                              ,(assoc-ref tag "key")
                                              ": "
                                              ,(let ((val (assoc-ref
                                                           tag "value")))
                                                 (if (git-commit-hash-length? val)
                                                     (string-take val 8)
                                                     val)))
                                             (*ENTITY* nbsp)))
                                         tags))))
                                ;; TODO Sort builds by priority?
                                all-builds
                                (iota (length all-builds))))
                            (span
                             (@ (id ,(string-append
                                      "agent-"
                                      (assoc-ref agent "uuid")
                                      "-plus-x-builds"))
                                (style ,(string-append
                                         (if (> (length all-builds) 4)
                                             "display: block;"
                                             "display: none;")
                                         "margin-top: 10px; text-align: center;")))
                             ,(let ((additional-builds
                                     (- (length all-builds)
                                        4)))
                                (if (= additional-builds 1)
                                    (simple-format #f "Plus ~A other build"
                                                   additional-builds)
                                    (simple-format #f "Plus ~A other builds"
                                                   additional-builds))))
                            (span
                             (@ (id ,(string-append
                                      "agent-"
                                      (assoc-ref agent "uuid")
                                      "-no-allocated-builds"))
                                (style ,(string-append
                                         (if (= 0 (length all-builds))
                                             "display: block;"
                                             "display: none;")
                                         "margin-top: 10px; text-align: center;")))
                             "No allocated builds")))
                        #f))
                  agents)))))
         categorised-agents)

      (script (@ (src "/assets/js/activity.js")))))))