discovery: Add 'scheme-modules*'.
* guix/self.scm (scheme-modules*): Move to... * guix/discovery.scm (scheme-modules*): ... here. New procedure. Make 'sub-directory' an optional parameter.master
parent
20cbd4f5f4
commit
02fa1d251c
|
@ -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 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -27,6 +27,7 @@
|
||||||
#:use-module (ice-9 ftw)
|
#:use-module (ice-9 ftw)
|
||||||
#:export (scheme-files
|
#:export (scheme-files
|
||||||
scheme-modules
|
scheme-modules
|
||||||
|
scheme-modules*
|
||||||
fold-modules
|
fold-modules
|
||||||
all-modules
|
all-modules
|
||||||
fold-module-public-variables))
|
fold-module-public-variables))
|
||||||
|
@ -115,6 +116,16 @@ name and the exception key and arguments."
|
||||||
(string-append directory "/" sub-directory)
|
(string-append directory "/" sub-directory)
|
||||||
directory))))
|
directory))))
|
||||||
|
|
||||||
|
(define* (scheme-modules* directory #:optional sub-directory)
|
||||||
|
"Return the list of module names found under SUB-DIRECTORY in DIRECTORY.
|
||||||
|
This is a source-only variant that does not try to load files."
|
||||||
|
(let ((prefix (string-length directory)))
|
||||||
|
(map (lambda (file)
|
||||||
|
(file-name->module-name (string-drop file prefix)))
|
||||||
|
(scheme-files (if sub-directory
|
||||||
|
(string-append directory "/" sub-directory)
|
||||||
|
directory)))))
|
||||||
|
|
||||||
(define* (fold-modules proc init path #:key (warn (const #f)))
|
(define* (fold-modules proc init path #:key (warn (const #f)))
|
||||||
"Fold over all the Scheme modules present in PATH, a list of directories.
|
"Fold over all the Scheme modules present in PATH, a list of directories.
|
||||||
Call (PROC MODULE RESULT) for each module that is found."
|
Call (PROC MODULE RESULT) for each module that is found."
|
||||||
|
|
|
@ -206,13 +206,6 @@ list of file-name/file-like objects suitable as inputs to 'imported-files'."
|
||||||
(local-file file #:recursive? #t)))
|
(local-file file #:recursive? #t)))
|
||||||
(find-files (string-append directory "/" sub-directory) pred)))
|
(find-files (string-append directory "/" sub-directory) pred)))
|
||||||
|
|
||||||
(define (scheme-modules* directory sub-directory)
|
|
||||||
"Return the list of module names found under SUB-DIRECTORY in DIRECTORY."
|
|
||||||
(let ((prefix (string-length directory)))
|
|
||||||
(map (lambda (file)
|
|
||||||
(file-name->module-name (string-drop file prefix)))
|
|
||||||
(scheme-files (string-append directory "/" sub-directory)))))
|
|
||||||
|
|
||||||
(define* (sub-directory item sub-directory)
|
(define* (sub-directory item sub-directory)
|
||||||
"Return SUB-DIRECTORY within ITEM, which may be a file name or a file-like
|
"Return SUB-DIRECTORY within ITEM, which may be a file name or a file-like
|
||||||
object."
|
object."
|
||||||
|
|
Reference in New Issue