;;; Guix Data Service -- Information about Guix over time
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU Affero General Public License
;;; as published by the Free Software Foundation, either version 3 of
;;; the License, or (at your option) any later version.
;;;
;;; This program 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
;;; Affero General Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public
;;; License along with this program.  If not, see
;;; <http://www.gnu.org/licenses/>.

(define-module (guix-data-service model guix-revision-package-derivation)
  #:use-module (ice-9 match)
  #:use-module (ice-9 threads)
  #:use-module (squee)
  #:use-module (guix-data-service database)
  #:export (insert-guix-revision-package-derivations

            insert-guix-revision-package-derivation-distribution-counts
            backfill-guix-revision-package-derivation-distribution-counts

            get-sql-to-select-package-and-related-derivations-for-revision))

(define (insert-guix-revision-package-derivations
         conn guix-revision-id package-derivation-ids)
  (define insert
    (string-append "INSERT INTO guix_revision_package_derivations "
                   "(revision_id, package_derivation_id) "
                   "VALUES "
                   (string-join (map (lambda (package-derivation-id)
                                       (simple-format
                                        #f "(~A, ~A)"
                                        guix-revision-id
                                        package-derivation-id))
                                     package-derivation-ids)
                                ", ")
                   ";"))

  (exec-query conn insert))

(define (insert-guix-revision-package-derivation-distribution-counts
         conn
         guix-revision-id)
  (define system-ids-and-targets
    (exec-query
     conn
     "
SELECT DISTINCT system_id, target
FROM package_derivations
INNER JOIN guix_revision_package_derivations
  ON package_derivations.id = guix_revision_package_derivations.package_derivation_id
WHERE revision_id = $1"
     (list guix-revision-id)))

  (define (get-count-for-next-level system-id target level-counts)
    (define next-level
      (length level-counts))

    (define query
      (string-append
       (simple-format
        #f
        "
WITH l0 AS (
  SELECT derivation_id
  FROM package_derivations
  INNER JOIN guix_revision_package_derivations
    ON package_derivations.id
        = guix_revision_package_derivations.package_derivation_id
  WHERE revision_id = ~A
    AND system_id = ~A
    AND target = $STR$~A$STR$~A
)"
        guix-revision-id
        system-id
        target
        (if (= next-level 0)
            ""
            (simple-format
             #f
             "
  LIMIT ~A"
             (car level-counts))))
       (if (= next-level 0)
           ""
           (string-join
            (map
             (match-lambda*
               ((level count)
                (simple-format
                 #f
                 ", l~A AS (
  (
    SELECT derivation_outputs.derivation_id
    FROM derivation_outputs WHERE derivation_outputs.id IN (
      SELECT DISTINCT derivation_inputs.derivation_output_id
      FROM l~A
      INNER JOIN derivation_inputs
        ON l~A.derivation_id = derivation_inputs.derivation_id
    )
  ) EXCEPT (~A
  )~A
)"
                 level
                 (- level 1)
                 (- level 1)
                 (string-join
                  (map
                   (lambda (level)
                     (simple-format
                      #f
                      "      SELECT derivation_id FROM l~A"
                      level))
                   (iota level))
                  "
    UNION ALL")
                 (if count
                     (simple-format
                      #f
                      "
  LIMIT ~A"
                      count)
                     ""))))
             (iota (length level-counts) 1)
             (append (cdr level-counts) '(#f)))
            ""))
       (simple-format
        #f
        "
SELECT COUNT(*) FROM l~A"
        (length level-counts))))

    (string->number
     (caar
      (exec-query
       conn
       query))))

  (define (insert-level-count system-id target level count)
    (exec-query
     conn
     "
INSERT INTO guix_revision_package_derivation_distribution_counts
VALUES ($1, $2, $3, $4, $5)"
     (list guix-revision-id
           system-id
           target
           (number->string level)
           (number->string count))))

  (for-each
   (match-lambda
     ((system-id target)

      (let loop ((level-counts '()))
        (let ((level (length level-counts))
              (count (get-count-for-next-level system-id target level-counts)))
          (unless (= count 0)
            (insert-level-count system-id target level count)
            (loop (append level-counts (list count))))))))
   system-ids-and-targets))

(define (backfill-guix-revision-package-derivation-distribution-counts)
  (define revision-ids
    (with-thread-postgresql-connection
     (lambda (conn)
       (map
        car
        (exec-query
         conn
         "
  SELECT id
  FROM guix_revisions
EXCEPT
  SELECT guix_revision_id
  FROM guix_revision_package_derivation_distribution_counts
ORDER BY id DESC")))))

  (n-par-for-each
   4
   (lambda (revision-id)
     (simple-format #t "backfilling guix_revision_package_derivation_distribution_counts for revision ~A\n" revision-id)
     (with-thread-postgresql-connection
      (lambda (conn)
        (with-postgresql-transaction
         conn
         (lambda (conn)
           (insert-guix-revision-package-derivation-distribution-counts
            conn
            revision-id))))))
   revision-ids))

(define* (get-sql-to-select-package-and-related-derivations-for-revision
          conn
          guix-revision-id
          #:key system-id target)
  (define level-counts
    (map
     (match-lambda
       ((level count)
        (list
         (string->number level)
         (string->number count))))
     (exec-query
      conn
      "
SELECT level, distinct_derivations
FROM guix_revision_package_derivation_distribution_counts
WHERE guix_revision_id = $1
  AND system_id = $2
  AND target = $3
ORDER BY level ASC"
      (list guix-revision-id
            (number->string system-id)
            target))))

  (define (query level-counts)
    (string-append
     (simple-format
      #f
      "
WITH l0 AS (
  SELECT derivation_id
  FROM package_derivations
  INNER JOIN guix_revision_package_derivations
    ON package_derivations.id
        = guix_revision_package_derivations.package_derivation_id
  WHERE revision_id = ~A
    AND system_id = ~A
    AND target = $STR$~A$STR$
  LIMIT ~A
)"
      guix-revision-id
      system-id
      target
      (cdr (car level-counts)))
     (string-join
      (map
       (match-lambda*
         ((level count)
          (simple-format
           #f
           ", l~A AS (
  (
    SELECT derivation_outputs.derivation_id
    FROM derivation_outputs WHERE derivation_outputs.id IN (
      SELECT DISTINCT derivation_inputs.derivation_output_id
      FROM l~A
      INNER JOIN derivation_inputs
        ON l~A.derivation_id = derivation_inputs.derivation_id
    )
  ) EXCEPT (~A
  )~A
)"
           level
           (- level 1)
           (- level 1)
           (string-join
            (map
             (lambda (level)
               (simple-format
                #f
                "      SELECT derivation_id FROM l~A"
                level))
             (iota level))
            "
    UNION ALL")
           (simple-format
            #f
            "
  LIMIT ~A"
            count))))
       (iota (- (length level-counts) 1) 1)
       (cdr (map cdr level-counts)))
      "")
     ", all_derivations AS (
  SELECT *
  FROM l0"
     (string-join
      (map (lambda (level)
             (simple-format #f "  UNION (SELECT * FROM l~A)" level))
           (iota (- (length level-counts) 1) 1))
      "\n")
     "
)"))

  (if level-counts
      (query level-counts)
      #f))