suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Refactor raco's tool listing code

Browse Source
This commit is contained in:
Jack Firth 2015-09-17 10:30:11 -07:00 committed by Matthew Flatt
parent 9c123172fa
commit c05db1ecf4
1 changed files with 74 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

122
racket/collects/raco/all-tools.rkt
View File

@ -1,58 +1,84 @@
#lang racket/base #lang racket/base
(require setup/getinfo (require setup/getinfo
racket/list) racket/list)
(provide all-tools) (provide all-tools)
(define (log-exn-message-handler exn)
(log-error (exn-message exn))
#f)
(define (get-info/full/skip dir) (define (get-info/full/skip dir)
(with-handlers ([exn:fail? (lambda (exn) (with-handlers ([exn:fail? log-exn-message-handler])
(log-error (exn-message exn))
#f)])
(get-info/full dir))) (get-info/full dir)))
(define (ensure-list v)
(if (list? v) v (list v)))
(define (check-tool-not-registered-twice tools entry dir)
(define tool-name (car entry))
(define previous-tool (hash-ref tools tool-name #f))
(when previous-tool
(eprintf "warning: tool ~s registered twice: ~e and ~e\n"
tool-name
(car previous-tool)
dir)))
(define (valid-raco-commands-spec? entry)
(and (list? entry)
(= (length entry) 4)
(string? (car entry))
(module-path? (cadr entry))
(string? (caddr entry))
(or (not (list-ref entry 3))
(real? (list-ref entry 3)))))
(define (check-valid-raco-commands-spec entry dir)
(unless (valid-raco-commands-spec? entry)
(eprintf "warning: ~s provided bad `raco-commands' spec: ~e\n"
dir
entry)))
(define (get-info-raco-commands full-info-proc)
(ensure-list (full-info-proc 'raco-commands (lambda () null))))
(define (all-tools) (define (all-tools)
(let* ([dirs (find-relevant-directories '(raco-commands) 'all-available)] (define tools (make-hash))
[tools (make-hash)]) (define dirs (find-relevant-directories '(raco-commands) 'all-available))
(for ([i (in-list (filter-map get-info/full/skip dirs))] (define infos (filter-map get-info/full/skip dirs))
[d (in-list dirs)]) (for ([i (in-list infos)]
(let ([entries (let ([l (if i [d (in-list dirs)])
(i 'raco-commands (lambda () null)) (define entries (get-info-raco-commands i))
null)]) (for ([entry (in-list entries)])
(if (list? l) (check-valid-raco-commands-spec entry d)
l (check-tool-not-registered-twice tools entry d)
(list l)))]) (add-tool! tools (convert-entry entry d))))
(for ([entry (in-list entries)]) tools)
(cond
[(and (list? entry) (define (convert-entry tool-entry dir)
(= (length entry) 4) (define tool-mod-path (cadr tool-entry))
(string? (car entry)) (if (non-module-tool-path? tool-mod-path)
(module-path? (cadr entry)) (convert-module-tool-path tool-entry tool-mod-path dir)
(string? (caddr entry)) tool-entry)) ;; module path is absolute already:
(or (not (list-ref entry 3))
(real? (list-ref entry 3)))) (define (non-module-tool-path? tool-mod-path)
(let ([p (hash-ref tools (car entry) #f)]) (or (string? tool-mod-path)
(when p (and (pair? tool-mod-path)
(eprintf (eq? (car tool-mod-path) 'file)
"warning: tool ~s registered twice: ~e and ~e\n" (relative-path? (cadr tool-mod-path)))))
(car entry)
(car p) ;; convert absolute path to relative to "info.rkt":
d))) (define (convert-module-tool-path tool-entry tool-mod-path dir)
(let ([entry (let ([e (cadr entry)]) (define new-path
(if (or (string? e) (build-path dir (if (pair? tool-mod-path)
(and (pair? e) (cadr tool-mod-path)
(eq? (car e) 'file) tool-mod-path)))
(relative-path? (cadr e)))) (list* (car tool-entry)
;; convert absolute path to realive to "info.rkt": new-path
(list* (car entry) (cddr tool-entry)))
(build-path d (if (pair? e)
(cadr e) (define (add-tool! tools tool-entry)
e)) (hash-set! tools (car tool-entry) tool-entry))
(cddr entry))
;; module path is absolute already:
entry))])
(hash-set! tools (car entry) entry))]
[else
(eprintf "warning: ~s provided bad `raco-commands' spec: ~e\n"
d
entry)]))))
tools))