mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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.
This commit is contained in:
parent
07dbdbd766
commit
a5e2fc7376
9 changed files with 86 additions and 67 deletions
5
gnu.scm
5
gnu.scm
|
@ -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)
|
||||||
|
|
|
@ -23,7 +23,7 @@ (define-module (gnu machine)
|
||||||
#: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?
|
||||||
|
|
|
@ -35,8 +35,9 @@ (define-module (gnu system)
|
||||||
#: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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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 @@ (define-module (guix diagnostics)
|
||||||
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 @@ (define prefix-color
|
||||||
(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 @@ (define (location->string loc)
|
||||||
(($ <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)))
|
||||||
|
|
|
@ -21,9 +21,10 @@ (define-module (guix inferior)
|
||||||
#: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))
|
||||||
|
|
|
@ -37,13 +37,27 @@ (define-module (guix utils)
|
||||||
#: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
|
||||||
|
|
||||||
|
<location>
|
||||||
|
location
|
||||||
|
location?
|
||||||
|
location-file
|
||||||
|
location-line
|
||||||
|
location-column
|
||||||
|
source-properties->location
|
||||||
|
location->source-properties
|
||||||
|
|
||||||
|
&error-location
|
||||||
|
error-location?
|
||||||
|
error-location)
|
||||||
#:export (strip-keyword-arguments
|
#:export (strip-keyword-arguments
|
||||||
default-keyword-arguments
|
default-keyword-arguments
|
||||||
substitute-keyword-arguments
|
substitute-keyword-arguments
|
||||||
|
@ -51,19 +65,6 @@ (define-module (guix utils)
|
||||||
|
|
||||||
current-source-directory
|
current-source-directory
|
||||||
|
|
||||||
<location>
|
|
||||||
location
|
|
||||||
location?
|
|
||||||
location-file
|
|
||||||
location-line
|
|
||||||
location-column
|
|
||||||
source-properties->location
|
|
||||||
location->source-properties
|
|
||||||
|
|
||||||
&error-location
|
|
||||||
error-location?
|
|
||||||
error-location
|
|
||||||
|
|
||||||
&fix-hint
|
&fix-hint
|
||||||
fix-hint?
|
fix-hint?
|
||||||
condition-fix-hint
|
condition-fix-hint
|
||||||
|
@ -834,48 +835,6 @@ (define-syntax current-source-directory
|
||||||
;; 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
|
||||||
|
|
|
@ -26,7 +26,7 @@ (define-module (test-channels)
|
||||||
#: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)
|
||||||
|
|
|
@ -23,7 +23,8 @@ (define-module (test-packages)
|
||||||
#: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)
|
||||||
|
|
Loading…
Reference in a new issue