aboutsummaryrefslogtreecommitdiff
path: root/guix-data-service/model/lint-warning-message.scm
blob: 85183a3297d12115f93c76a59b7cf5fe70cd9d0d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
(define-module (guix-data-service model lint-warning-message)
  #:use-module (ice-9 match)
  #:use-module (squee)
  #:use-module (guix-data-service database)
  #:use-module (guix-data-service model utils)
  #:export (lint-warning-message-data->lint-warning-message-ids

            lint-warning-message-data->lint-warning-message-set-id))

(define (lint-warning-message-data->lint-warning-message-ids conn
                                                             messages-by-locale)
  (insert-missing-data-and-return-all-ids
   conn
   "lint_warning_messages"
   '(locale message)
   (map (match-lambda
          ((locale . message)
           (list locale message)))
        messages-by-locale)))

(define (insert-lint-warning-message-set conn lint-message-ids)
  (let ((query
         (string-append
          "INSERT INTO lint_warning_message_sets (message_ids) VALUES "
          (string-append
           "('{"
           (string-join
            (map number->string
                 (sort lint-message-ids <))
            ", ")
           "}')")
          " RETURNING id")))

    (match (exec-query conn query)
      (((id)) id))))

(define (lint-warning-message-data->lint-warning-message-set-id
         conn
         messages-by-locale)

  (let* ((lint-warning-message-ids
          (lint-warning-message-data->lint-warning-message-ids
           conn messages-by-locale))
         (lint-message-set-id
          (exec-query
           conn
           (string-append
            "SELECT id FROM lint_warning_message_sets "
            "WHERE message_ids = ARRAY["
            (string-join (map number->string lint-warning-message-ids) ", ")
            "]"))))

    (string->number
     (match lint-message-set-id
       (((id)) id)
       (()
        (insert-lint-warning-message-set conn lint-warning-message-ids))))))