You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
pollen/project.rkt

47 lines
1.8 KiB
Racket

#lang racket/base
(require "world.rkt" sugar/define sugar/coerce)
(define (complete-paths? x) (and (list? x) (andmap complete-path? x)))
11 years ago
(define/contract+provide (get-directory-require-files source-path) ; keep contract local to ensure coercion
(coerce/path? . -> . (or/c #f complete-paths?))
(define (dirname path)
(let-values ([(dir name dir?) (split-path path)])
dir))
(define (find-upward filename-to-find)
(parameterize ([current-directory (dirname (->complete-path source-path))])
(let loop ([dir (current-directory)][path (string->path filename-to-find)])
(and dir ; dir is #f when it hits the top of the filesystem
(let ([completed-path (path->complete-path path)])
(if (file-exists? completed-path)
(simplify-path completed-path)
(loop (dirname dir) (build-path 'up path))))))))
(define require-filenames (list world:directory-require))
(define not-false? (λ(x) x))
(define possible-requires (filter not-false? (map find-upward require-filenames)))
(and (not (null? possible-requires)) possible-requires))
11 years ago
(define+provide/contract (require+provide-directory-require-files here-path #:provide [provide #t])
11 years ago
(coerce/path? . -> . (or/c list? void?))
(define (put-file-in-require-form file)
`(file ,(path->string file)))
(define directory-require-files (get-directory-require-files here-path))
(if directory-require-files
(let ([files-in-require-form (map put-file-in-require-form directory-require-files)])
`(begin
(require ,@files-in-require-form)
11 years ago
,@(if provide
(list `(provide (all-from-out ,@files-in-require-form)))
null)))
11 years ago
'(begin)))
11 years ago
(define+provide (require-directory-require-files here-path)
(require+provide-directory-require-files here-path #:provide #f))