profiles: Use 'with-extensions'.

* guix/profiles.scm (manual-database)[build]: Use 'with-extensions'.
Remove 'add-to-load-path' call.
* guix/man-db.scm: Use (gdbm) the normal way; remove 'module-autoload!'
call.
This commit is contained in:
Ludovic Courtès 2018-05-28 22:00:11 +02:00
parent 33d8a87104
commit 331ac4cc23
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 31 additions and 35 deletions

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -19,6 +19,7 @@
(define-module (guix man-db) (define-module (guix man-db)
#:use-module (guix zlib) #:use-module (guix zlib)
#:use-module ((guix build utils) #:select (find-files)) #:use-module ((guix build utils) #:select (find-files))
#:use-module (gdbm) ;gdbm-ffi
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -44,9 +45,6 @@
;;; ;;;
;;; Code: ;;; Code:
;; Load 'gdbm-ffi' at run time to simplify the job of 'imported-modules' & co.
(module-autoload! (current-module) '(gdbm) '(gdbm-open GDBM_WRCREAT))
(define-record-type <mandb-entry> (define-record-type <mandb-entry>
(mandb-entry file-name name section synopsis kind) (mandb-entry file-name name section synopsis kind)
mandb-entry? mandb-entry?

View File

@ -1196,41 +1196,39 @@ the entries in MANIFEST."
(define build (define build
(with-imported-modules modules (with-imported-modules modules
#~(begin (with-extensions (list gdbm-ffi) ;for (guix man-db)
(add-to-load-path (string-append #$gdbm-ffi "/share/guile/site/" #~(begin
(effective-version))) (use-modules (guix man-db)
(guix build utils)
(srfi srfi-1)
(srfi srfi-19))
(use-modules (guix man-db) (define (compute-entries)
(guix build utils) (append-map (lambda (directory)
(srfi srfi-1) (let ((man (string-append directory "/share/man")))
(srfi srfi-19)) (if (directory-exists? man)
(mandb-entries man)
'())))
'#$(manifest-inputs manifest)))
(define (compute-entries) (define man-directory
(append-map (lambda (directory) (string-append #$output "/share/man"))
(let ((man (string-append directory "/share/man")))
(if (directory-exists? man)
(mandb-entries man)
'())))
'#$(manifest-inputs manifest)))
(define man-directory (mkdir-p man-directory)
(string-append #$output "/share/man"))
(mkdir-p man-directory) (format #t "Creating manual page database...~%")
(force-output)
(format #t "Creating manual page database...~%") (let* ((start (current-time))
(force-output) (entries (compute-entries))
(let* ((start (current-time)) (_ (write-mandb-database (string-append man-directory
(entries (compute-entries)) "/index.db")
(_ (write-mandb-database (string-append man-directory entries))
"/index.db") (duration (time-difference (current-time) start)))
entries)) (format #t "~a entries processed in ~,1f s~%"
(duration (time-difference (current-time) start))) (length entries)
(format #t "~a entries processed in ~,1f s~%" (+ (time-second duration)
(length entries) (* (time-nanosecond duration) (expt 10 -9))))
(+ (time-second duration) (force-output))))))
(* (time-nanosecond duration) (expt 10 -9))))
(force-output)))))
(gexp->derivation "manual-database" build (gexp->derivation "manual-database" build