cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Refactor processing lint warnings

Browse source 
Extract out a function to make the code slightly easier to read.
This commit is contained in:
Christopher Baines 2020-02-01 10:32:49 +01:00
parent 91249f5ee0
commit ee82c2c71d
1 changed files with 44 additions and 42 deletions
Download patch file Download diff file Expand all files Collapse all files

86
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -247,6 +247,48 @@ WHERE job_id = $1"
',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)
;; 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)
@ -255,48 +297,8 @@ WHERE job_id = $1"
(lambda (package-id package)
(cons
package-id
(map
(lambda (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))))
(check package))))
(map process-lint-warning
(check package))))
%package-table)))))
(and