(use-modules (srfi srfi-1)
             (ice-9 match)
             (gnu packages)
             (guix store)
             (guix grafts)
             (guix packages)
             (guix lint)
             (guix utils))

(define %package-table (make-hash-table))
(begin
  (fold-packages (lambda (package result)
                   (let ((id (object-address package)))
                     (hashv-set! %package-table id package)
                     (cons (list (package-name package)
                                 (package-version package)
                                 id)
                           result)))
                 '())
  (peek "%package-table-setup" %package-table))

(define lint-warnings-for-checker
  (lambda (checker-name store)
    (let* ((checker (find (lambda (checker)
                            (eq? (lint-checker-name checker)
                                 checker-name))
                          %local-checkers))
           (check (lint-checker-check checker)))

      (define (process-lint-warning lint-warning)
        (list
         (match (lint-warning-location lint-warning)
           (($ <location> file line column)
            (list (if (string-prefix? "/gnu/store/" file)
                      (string-join (drop (string-split file #\/) 8) "/")
                      file)
                  line
                  column)))
         (let* ((source-locale "en_US.utf8")
                (source-message
                 (begin
                   (setlocale LC_MESSAGES source-locale)
                   (lint-warning-message lint-warning)))
                (messages-by-locale
                 (filter-map
                  (lambda (locale)
                    (catch 'system-error
                      (lambda ()
                        (setlocale LC_MESSAGES locale))
                      (lambda (key . args)
                        (error
                         (simple-format
                          #f
                          "error changing locale to ~A: ~A ~A"
                          locale key args))))
                    (let ((message
                           (lint-warning-message lint-warning)))
                      (setlocale LC_MESSAGES source-locale)
                      (if (string=? message source-message)
                          #f
                          (cons locale message))))
                  '("cs_CZ.utf8"
                    "da_DK.utf8"
                    "de_DE.utf8"
                    "eo_EO.utf8"
                    "es_ES.utf8"
                    "fr_FR.utf8"
                    "hu_HU.utf8"
                    "pl_PL.utf8"
                    "pt_BR.utf8"
                    ;;"sr_SR.utf8"
                    "sv_SE.utf8"
                    "vi_VN.utf8"
                    "zh_CN.utf8"))))
           (cons (cons source-locale source-message)
                 messages-by-locale))))

      (filter
       (match-lambda
         ((package-id . warnings)
          (not (null? warnings))))
       (hash-map->list
        (lambda (package-id package)
          (cons
           package-id
           (catch
             #t
             (lambda ()
               (map process-lint-warning
                    (check package #:store store)))
             (lambda (key . args)
               '()))))
        %package-table)))))

(gc)
(with-store store
  (lint-warnings-for-checker 'derivation store))

(gc)
(with-store store
  (lint-warnings-for-checker 'derivation store))

(gc)
(with-store store
  (lint-warnings-for-checker 'derivation store))

(gc)
(with-store store
  (lint-warnings-for-checker 'derivation store))

(gc)
(with-store store
  (lint-warnings-for-checker 'derivation store))

(gc)
(with-store store
  (lint-warnings-for-checker 'derivation store))

(gc)
(with-store store
  (lint-warnings-for-checker 'derivation store))

(gc)
(with-store store
  (lint-warnings-for-checker 'derivation store))

(gc)
(with-store store
  (lint-warnings-for-checker 'derivation store))

(gc)
(with-store store
  (lint-warnings-for-checker 'derivation store))

(gc)
(with-store store
  (lint-warnings-for-checker 'derivation store))

(gc)
(with-store store
  (lint-warnings-for-checker 'derivation store))

(gc)
(with-store store
  (lint-warnings-for-checker 'derivation store))

(gc)
(with-store store
  (lint-warnings-for-checker 'derivation store))

(gc)
(with-store store
  (lint-warnings-for-checker 'derivation store))

(gc)
(with-store store
  (lint-warnings-for-checker 'derivation store))

(gc)
(with-store store
  (lint-warnings-for-checker 'derivation store))

(gc)
(with-store store
  (lint-warnings-for-checker 'derivation store))

(simple-format #t "finished successfully\n\n")