From 42c0cc59d385ebf22d2ac8137ed6262c9ef2f8a7 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 13 Mar 2014 20:05:00 -0700 Subject: [PATCH] simplify project-requires to one file; make pollen sources importable --- lang/inner-lang-helper.rkt | 107 ------------------------------------- lang/reader-base.rkt | 11 +++- main.rkt | 29 ++++------ project-requires.rkt | 31 ++++++----- render.rkt | 6 +-- world.rkt | 4 +- 6 files changed, 41 insertions(+), 147 deletions(-) delete mode 100644 lang/inner-lang-helper.rkt diff --git a/lang/inner-lang-helper.rkt b/lang/inner-lang-helper.rkt deleted file mode 100644 index 08af589..0000000 --- a/lang/inner-lang-helper.rkt +++ /dev/null @@ -1,107 +0,0 @@ -#lang racket/base -(require (for-syntax racket/base pollen/project-requires)) - -(provide (all-defined-out)) - -;; A place to stash functions that don't change between compiles of Pollen files. - -(define-for-syntax (put-file-in-require-form file) - `(file ,(path->string file))) - -(define-for-syntax (do-project-require-file-syntax stx #:provide? [provide? #f]) - (define project-require-files (get-project-require-files)) - (if project-require-files - (let ([files-in-require-form (map put-file-in-require-form project-require-files)]) - (datum->syntax stx `(begin - (require ,@files-in-require-form) - ,@(if provide? - (list `(provide (all-from-out ,@files-in-require-form))) - '())))) - ; if no files to import, do nothing - #'(begin))) - -(define-syntax (require-and-provide-project-require-files stx) - (do-project-require-file-syntax stx #:provide? #t)) - -(define-syntax (require-project-require-files stx) - (do-project-require-file-syntax stx)) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; -; Copied out from racket/contract/private/base to avoid import -; Importing racket/contract/region is slow -; Used to be called current-contract-region -; -(require racket/stxparam syntax/location) - -(define-syntax-parameter current-file-path - (λ (stx) - (if (eq? (syntax-local-context) 'expression) - (let* ([ctxt (syntax-local-lift-context)] - [id (hash-ref (make-hasheq) ctxt #f)]) - (with-syntax ([id (or id - (let ([id (syntax-local-lift-expression - (syntax/loc stx (quote-module-name)))]) - (hash-set! (make-hasheq) ctxt (syntax-local-introduce id)) - id))]) - #'id)) - (quasisyntax/loc stx (#%expression #,stx))))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; -; Copied out from racket/path to avoid import -; -(define (pollen-find-relative-path directory filename #:more-than-root? [more-than-root? #f]) - - (define (do-explode-path who orig-path) - (define l (explode-path orig-path)) - (for ([p (in-list l)]) - (when (not (path-for-some-system? p)) - (raise-argument-error who - "(and/c path-for-some-system? simple-form?)" - orig-path))) - l) - - (let ([dir (do-explode-path 'find-relative-path directory)] - [file (do-explode-path 'find-relative-path filename)]) - (if (and (equal? (car dir) (car file)) - (or (not more-than-root?) - (not (eq? 'unix (path-convention-type directory))) - (null? (cdr dir)) - (null? (cdr file)) - (equal? (cadr dir) (cadr file)))) - (let loop ([dir (cdr dir)] - [file (cdr file)]) - (cond [(null? dir) (if (null? file) filename (apply build-path file))] - [(null? file) (apply build-path/convention-type - (path-convention-type filename) - (map (lambda (x) 'up) dir))] - [(equal? (car dir) (car file)) - (loop (cdr dir) (cdr file))] - [else - (apply build-path (append (map (lambda (x) 'up) dir) file))])) - filename))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - - - -(define-syntax (get-here-path stx) - #'(begin - (let* ([cfp (current-file-path)] - [here-path (cond - ;; file isn't yet saved in drracket - ;; 'pollen-lang-module name is applied by reader - [(or (equal? 'pollen-lang-module cfp) - (and (list? cfp) (equal? (car cfp) 'pollen-lang-module))) - "unsaved-file"] - ;; if current-file-path is called from within submodule, you get a list - ;; in which case, just grab the path from the front - [(list? cfp) (path->string (car cfp))] - [else (path->string cfp)])]) - here-path))) - - diff --git a/lang/reader-base.rkt b/lang/reader-base.rkt index 14a9896..06dc90f 100644 --- a/lang/reader-base.rkt +++ b/lang/reader-base.rkt @@ -1,30 +1,37 @@ #lang racket/base -(require (only-in scribble/reader make-at-reader) pollen/world) +(require (only-in scribble/reader make-at-reader) pollen/world racket/path pollen/project-requires) (provide make-reader-with-mode (all-from-out pollen/world)) + (define read-inner (make-at-reader #:command-char world:expression-delimiter #:syntax? #t #:inside? #t)) + (define (make-custom-read custom-read-syntax-proc) (λ(p) (syntax->datum (custom-read-syntax-proc (object-name p) p)))) + (define (make-custom-read-syntax reader-mode) (λ (path-string p) (define file-contents (read-inner path-string p)) (datum->syntax file-contents `(module pollen-lang-module pollen (define reader-mode ',reader-mode) + (define here-path ,(path->string path-string)) + (define here ,(path->string (path-replace-suffix (find-relative-path (world:current-project-root) path-string) ""))) + ,(require+provide-project-require-files path-string) ,@file-contents) file-contents))) + (define-syntax-rule (make-reader-with-mode mode) (begin (define reader-mode mode) (define custom-read-syntax (make-custom-read-syntax reader-mode)) (define custom-read (make-custom-read custom-read-syntax)) - (provide (rename-out [custom-read read] [custom-read-syntax read-syntax])))) + (provide (rename-out [custom-read read] [custom-read-syntax read-syntax])))) \ No newline at end of file diff --git a/main.rkt b/main.rkt index 2e79423..164b0b0 100644 --- a/main.rkt +++ b/main.rkt @@ -11,24 +11,13 @@ doc-raw ; id of export (λ(x) x) ; post-process function () ; prepended exprs - - (require pollen/lang/inner-lang-helper) - (require-and-provide-project-require-files) ; only works if current-directory is set correctly - + ;; Change behavior of undefined identifiers with #%top - (require pollen/top) - (provide (all-from-out pollen/top)) - - ;; Get project values - (require pollen/world) - (provide (all-from-out pollen/world)) - - ;; Build 'inner-here-path and 'inner-here - (define (here-path->here here-path) - (path->string (path-replace-suffix (pollen-find-relative-path (world:current-project-root) here-path) ""))) - (define inner-here-path (get-here-path)) - (define inner-here (here-path->here inner-here-path)) + ;; Get project values from world + (require pollen/top pollen/world) + (provide (all-from-out pollen/top pollen/world)) + ;; for anything defined in pollen source file (provide (all-defined-out)) body-exprs ...) @@ -39,7 +28,7 @@ (define parser-mode (if (equal? reader-mode world:reader-mode-auto) (let* ([file-ext-pattern (pregexp "\\w+$")] - [here-ext (string->symbol (car (regexp-match file-ext-pattern inner-here-path)))]) + [here-ext (string->symbol (car (regexp-match file-ext-pattern here-path)))]) (cond [(equal? here-ext world:pagemap-source-ext) world:reader-mode-pagemap] [(equal? here-ext world:markup-source-ext) world:reader-mode-markup] @@ -64,8 +53,8 @@ (apply (compose1 (dynamic-require 'markdown 'parse-markdown) string-append) doc-raw) doc-raw)]) `(placeholder-root - ,@(cons (meta 'here: inner-here) - (cons (meta 'here-path: inner-here-path) + ,@(cons (meta 'here: here) + (cons (meta 'here-path: here-path) ;; cdr strips initial linebreak, but make sure doc-raw isn't blank (if (and (list? doc-raw) (> 0 (length doc-raw))) (cdr doc-raw) doc-raw)))))) @@ -87,7 +76,7 @@ (provide metas doc ;; hide the exports that were only for internal use. - (except-out (all-from-out 'inner) inner-here inner-here-path doc-raw #%top)) + (except-out (all-from-out 'inner) doc-raw #%top)) ;; for output in DrRacket (module+ main diff --git a/project-requires.rkt b/project-requires.rkt index 09268ee..2802352 100644 --- a/project-requires.rkt +++ b/project-requires.rkt @@ -1,18 +1,23 @@ #lang racket/base -(require "world.rkt") -(provide (all-defined-out)) +(require "world.rkt" sugar/define/contract sugar/coerce/contract) -(define (project-require-file? path) - (define path-string (path->string path)) - (define racket-ext "rkt") - (equal? (substring path-string (- (string-length path-string) (string-length racket-ext)) (string-length path-string)) racket-ext)) +(define/contract+provide (get-project-require-files source-path) ; keep contract local to ensure coercion + (coerce/path? . -> . (or/c #f (listof path?))) + (define possible-requires (list (simplify-path (build-path source-path 'up world:pollen-require)))) + (and (andmap file-exists? possible-requires) possible-requires)) -;; list of all eligible requires in project require directory -(define (get-project-require-files) - (define extras-directory (build-path (world:current-project-root) world:extras-dir)) - (and (directory-exists? extras-directory) - ;; #:build? option returns complete paths (instead of just file names) - (let ([files (filter project-require-file? (directory-list extras-directory #:build? #t))]) - (and (not (equal? null files)) files)))) \ No newline at end of file +(define+provide/contract (require+provide-project-require-files here-path) + (coerce/path? . -> . list?) + (define (put-file-in-require-form file) + `(file ,(path->string file))) + (define project-require-files (get-project-require-files here-path)) + + (if project-require-files + (let ([files-in-require-form (map put-file-in-require-form project-require-files)]) + `(begin + (require ,@files-in-require-form) + ,@(list `(provide (all-from-out ,@files-in-require-form))))) + (void))) + diff --git a/render.rkt b/render.rkt index 7daa21d..5cd5e93 100644 --- a/render.rkt +++ b/render.rkt @@ -77,8 +77,8 @@ (file-proc source-or-output-path)) -(define (project-requires-changed?) - (define project-require-files (get-project-require-files)) +(define (project-requires-changed? source-path) + (define project-require-files (get-project-require-files source-path)) (define rerequire-results (and project-require-files (map file-needed-rerequire? project-require-files))) (define requires-changed? (and rerequire-results (ormap (λ(x) x) rerequire-results))) (when requires-changed? @@ -94,7 +94,7 @@ (or (not (file-exists? output-path)) (modification-date-expired? source-path template-path) (and (not (null-source? source-path)) (file-needed-rerequire? source-path)) - (and (world:check-project-requires-in-render?) (project-requires-changed?)))) + (and (world:check-project-requires-in-render?) (project-requires-changed? source-path)))) (define/contract+provide (render-to-file-if-needed source-path [template-path #f] [maybe-output-path #f] #:force [force #f]) diff --git a/world.rkt b/world.rkt index 9a8f3d5..b731d14 100644 --- a/world.rkt +++ b/world.rkt @@ -35,7 +35,7 @@ (define main-pollen-export 'doc) ; don't forget to change fallback template too (define meta-pollen-export 'metas) -(define extras-dir (string->path "pollen-require")) +(define pollen-require "pollen-require.rkt") (define missing-file-boilerplace "#lang pollen\n\n") @@ -50,7 +50,7 @@ (define command-file "polcom") (define reserved-paths - (map string->path (list command-file (path->string extras-dir) "poldash.css" "compiled"))) + (map string->path (list command-file "poldash.css" "compiled"))) (define current-project-root (make-parameter (current-directory)))