(use-modules (ice-9 match)
             (guix inferior)
             (guix channels)
             (guix store))

(define (all-inferior-lint-warnings inf store)
  (define locales
    '("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"))

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

         (define lint-checker-requires-store?-defined?
           (defined? 'lint-checker-requires-store?
             (resolve-module '(guix lint))))

         (define (process-lint-warning lint-warning)
           (list
            (match (lint-warning-location lint-warning)
              (($ <location> file line column)
               (list (if (string-prefix? "/gnu/store/" file)
                         ;; Convert a string like
                         ;; /gnu/store/53xh0mpigin2rffg31s52x5dc08y0qmr-guix-module-union/share/guile/site/2.2/gnu/packages/xdisorg.scm
                         ;;
                         ;; This happens when the checker uses
                         ;; package-field-location.
                         (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))))
                     (list ,@locales))))
              (cons (cons source-locale source-message)
                    messages-by-locale))))

         (filter
          (match-lambda
            ((package-id . warnings)
             (not (null? warnings)))
            (a
             (error (simple-format #f "NO MATCH FOR ~A\n" a))))
          (hash-map->list
           (lambda (package-id package)
             (cons
              package-id
              (catch
                #t
                (lambda ()
                  (map process-lint-warning
                       (if (and lint-checker-requires-store?-defined?
                                (lint-checker-requires-store? checker))

                           (check package #:store store)
                           (check package))))
                (lambda (key . args)
                  '()))))
           %package-table)))))

  (inferior-eval '(use-modules (srfi srfi-1)
                               (guix lint)) inf)
  (inferior-packages inf)
  (let ((checkers
         (inferior-eval
          '(begin
             (map (lambda (checker)
                    (list (lint-checker-name checker)
                          (lint-checker-description checker)
                          (if (memq checker %network-dependent-checkers)
                              #t
                              #f)))
                  %all-checkers))
          inf)))
    (map
     (match-lambda
       ((name description network-dependent?)
        (cons
         (list name description network-dependent?)
         (if network-dependent?
             '()
             (inferior-eval-with-store inf store (lint-warnings-for-checker
                                                  name))))))
     checkers)))

(let* ((channel
        (channel
         (name 'guix)
         (commit "d523eb5c9c2659cbbaf4eeef3691234ae527ee6a")
         (url "https://git.savannah.gnu.org/git/guix.git")))
       (inferior
        (inferior-for-channels (list channel)))
       (result
        (with-store store
          (all-inferior-lint-warnings inferior store)
          ;; Running all-inferior-lint-warnings once doesn't seem to always
          ;; produce the crash, so just run it again
          (all-inferior-lint-warnings inferior store))))
  (peek "RESULT" result))