me
/
guix
Archived
1
0
Fork 0
Code

utils: Move <location> and '&error-location' to (guix diagnostics). 

* guix/utils.scm (<location>, source-properties->location)
(location->source-properties, &error-location): Move to...
* guix/diagnostics.scm: ... here.
* gnu.scm: Adjust imports accordingly.
* gnu/machine.scm: Likewise.
* gnu/system.scm: Likewise.
* gnu/tests.scm: Likewise.
* guix/inferior.scm: Likewise.
* tests/channels.scm: Likewise.
* tests/packages.scm: Likewise.
master
Ludovic Courtès 2020-07-24 22:58:08 +02:00
parent 07dbdbd766
commit a5e2fc7376
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
9 changed files with 86 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gnu.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Joshua S. Grant <jgrant@parenthetical.io> ;;; Copyright © 2015 Joshua S. Grant <jgrant@parenthetical.io>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; ;;;
@ -20,7 +20,8 @@
(define-module (gnu) (define-module (gnu)
#:use-module (guix i18n) #:use-module (guix i18n)
#:use-module (guix utils) #:use-module ((guix utils) #:select (&fix-hint))
#:use-module (guix diagnostics)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (srfi srfi-35) #:use-module (srfi srfi-35)
#:use-module (ice-9 match) #:use-module (ice-9 match)

2
gnu/machine.scm
View File

@ -23,7 +23,7 @@
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix store) #:use-module (guix store)
#:use-module ((guix utils) #:select (source-properties->location)) #:use-module ((guix diagnostics) #:select (source-properties->location))
#:use-module (srfi srfi-35) #:use-module (srfi srfi-35)
#:export (environment-type #:export (environment-type
environment-type? environment-type?

5
gnu/system.scm
View File

@ -35,8 +35,9 @@
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix profiles) #:use-module (guix profiles)
#:use-module (guix ui) #:use-module ((guix utils) #:select (substitute-keyword-arguments))
#:use-module (guix utils) #:use-module (guix i18n)
#:use-module (guix diagnostics)
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
#:use-module (gnu packages cross-base) #:use-module (gnu packages cross-base)

2
gnu/tests.scm
View File

@ -20,7 +20,7 @@
(define-module (gnu tests) (define-module (gnu tests)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix utils) #:use-module (guix diagnostics)
#:use-module (guix records) #:use-module (guix records)
#:use-module ((guix ui) #:select (warn-about-load-error)) #:use-module ((guix ui) #:select (warn-about-load-error))
#:use-module (gnu bootloader) #:use-module (gnu bootloader)

60
guix/diagnostics.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,8 +19,9 @@
(define-module (guix diagnostics) (define-module (guix diagnostics)
#:use-module (guix colors) #:use-module (guix colors)
#:use-module (guix i18n) #:use-module (guix i18n)
#:autoload (guix utils) (<location>) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-35)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (warning #:export (warning
@ -28,8 +29,20 @@
report-error report-error
leave leave
<location>
location
location?
location-file
location-line
location-column
source-properties->location
location->source-properties
location->string location->string
&error-location
error-location?
error-location
guix-warning-port guix-warning-port
program-name)) program-name))
@ -162,6 +175,45 @@ messages."
(program-name) (program-name) (program-name) (program-name)
(prefix-color prefix))))) (prefix-color prefix)))))
;; A source location.
(define-record-type <location>
(make-location file line column)
location?
(file location-file) ; file name
(line location-line) ; 1-indexed line
(column location-column)) ; 0-indexed column
(define (location file line column)
"Return the <location> object for the given FILE, LINE, and COLUMN."
(and line column file
(make-location file line column)))
(define (source-properties->location loc)
"Return a location object based on the info in LOC, an alist as returned
by Guile's `source-properties', `frame-source', `current-source-location',
etc."
;; In accordance with the GCS, start line and column numbers at 1. Note
;; that unlike LINE and `port-column', COL is actually 1-indexed here...
(match loc
((('line . line) ('column . col) ('filename . file)) ;common case
(and file line col
(make-location file (+ line 1) col)))
(#f
#f)
(_
(let ((file (assq-ref loc 'filename))
(line (assq-ref loc 'line))
(col (assq-ref loc 'column)))
(location file (and line (+ line 1)) col)))))
(define (location->source-properties loc)
"Return the source property association list based on the info in LOC,
a location object."
`((line . ,(and=> (location-line loc) 1-))
(column . ,(location-column loc))
(filename . ,(location-file loc))))
(define (location->string loc) (define (location->string loc)
"Return a human-friendly, GNU-standard representation of LOC." "Return a human-friendly, GNU-standard representation of LOC."
(match loc (match loc
@ -169,6 +221,10 @@ messages."
(($ <location> file line column) (($ <location> file line column)
(format #f "~a:~a:~a" file line column)))) (format #f "~a:~a:~a" file line column))))
(define-condition-type &error-location &error
error-location?
(location error-location)) ;<location>
(define guix-warning-port (define guix-warning-port
(make-parameter (current-warning-port))) (make-parameter (current-warning-port)))

3
guix/inferior.scm
View File

@ -21,9 +21,10 @@
#:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (srfi srfi-35) #:use-module (srfi srfi-35)
#:use-module ((guix diagnostics)
#:select (source-properties->location))
#:use-module ((guix utils) #:use-module ((guix utils)
#:select (%current-system #:select (%current-system
source-properties->location
call-with-temporary-directory call-with-temporary-directory
version>? version-prefix? version>? version-prefix?
cache-directory)) cache-directory))

59
guix/utils.scm
View File

@ -37,19 +37,14 @@
#:use-module (guix memoization) #:use-module (guix memoization)
#:use-module ((guix build utils) #:select (dump-port mkdir-p delete-file-recursively)) #:use-module ((guix build utils) #:select (dump-port mkdir-p delete-file-recursively))
#:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync)) #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync))
#:use-module (guix diagnostics) ;<location>, &error-location, etc.
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:use-module ((ice-9 iconv) #:prefix iconv:) #:use-module ((ice-9 iconv) #:prefix iconv:)
#:use-module (system foreign) #:use-module (system foreign)
#:re-export (memoize) ; for backwards compatibility #:re-export (memoize ;for backwards compatibility
#:export (strip-keyword-arguments
default-keyword-arguments
substitute-keyword-arguments
ensure-keyword-arguments
current-source-directory
<location> <location>
location location
@ -62,7 +57,13 @@
&error-location &error-location
error-location? error-location?
error-location error-location)
#:export (strip-keyword-arguments
default-keyword-arguments
substitute-keyword-arguments
ensure-keyword-arguments
current-source-directory
&fix-hint &fix-hint
fix-hint? fix-hint?
@ -834,48 +835,6 @@ be determined."
;; raising an error would upset Geiser users ;; raising an error would upset Geiser users
#f)))))) #f))))))
;; A source location.
(define-record-type <location>
(make-location file line column)
location?
(file location-file) ; file name
(line location-line) ; 1-indexed line
(column location-column)) ; 0-indexed column
(define (location file line column)
"Return the <location> object for the given FILE, LINE, and COLUMN."
(and line column file
(make-location file line column)))
(define (source-properties->location loc)
"Return a location object based on the info in LOC, an alist as returned
by Guile's `source-properties', `frame-source', `current-source-location',
etc."
;; In accordance with the GCS, start line and column numbers at 1. Note
;; that unlike LINE and `port-column', COL is actually 1-indexed here...
(match loc
((('line . line) ('column . col) ('filename . file)) ;common case
(and file line col
(make-location file (+ line 1) col)))
(#f
#f)
(_
(let ((file (assq-ref loc 'filename))
(line (assq-ref loc 'line))
(col (assq-ref loc 'column)))
(location file (and line (+ line 1)) col)))))
(define (location->source-properties loc)
"Return the source property association list based on the info in LOC,
a location object."
`((line . ,(and=> (location-line loc) 1-))
(column . ,(location-column loc))
(filename . ,(location-file loc))))
(define-condition-type &error-location &error
error-location?
(location error-location)) ;<location>
(define-condition-type &fix-hint &condition (define-condition-type &fix-hint &condition
fix-hint? fix-hint?
(hint condition-fix-hint)) ;string (hint condition-fix-hint)) ;string

2
tests/channels.scm
View File

@ -26,7 +26,7 @@
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix sets) #:use-module (guix sets)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module ((guix utils) #:use-module ((guix diagnostics)
#:select (error-location? error-location location-line)) #:select (error-location? error-location location-line))
#:use-module ((guix build utils) #:select (which)) #:use-module ((guix build utils) #:select (which))
#:use-module (git) #:use-module (git)

3
tests/packages.scm
View File

@ -23,7 +23,8 @@
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix grafts) #:use-module (guix grafts)
#:use-module ((guix gexp) #:select (local-file local-file-file)) #:use-module ((guix gexp) #:select (local-file local-file-file))
#:use-module ((guix utils) #:use-module (guix utils)
#:use-module ((guix diagnostics)
;; Rename the 'location' binding to allow proper syntax ;; Rename the 'location' binding to allow proper syntax
;; matching when setting the 'location' field of a package. ;; matching when setting the 'location' field of a package.
#:renamer (lambda (name) #:renamer (lambda (name)