simplify project-requires to one file; make pollen sources importable

lang/inner-lang-helper.rkt

@@ -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)))
-
-

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]))))

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)
+     ;; Get project values from world
-     (provide (all-from-out pollen/top))
+     (require pollen/top pollen/world)
-     
+     (provide (all-from-out pollen/top pollen/world))
-     ;; 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))
      
+     ;; 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: here) 
-                 (cons (meta 'here-path: inner-here-path) 
+                 (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

project-requires.rkt

@@ -1,18 +1,23 @@
 #lang racket/base
-(require "world.rkt")
+(require "world.rkt" sugar/define/contract sugar/coerce/contract)
-(provide (all-defined-out))
 
 
-(define (project-require-file? path)
+(define/contract+provide (get-project-require-files source-path) ; keep contract local to ensure coercion
-  (define path-string (path->string path))
+  (coerce/path? . -> . (or/c #f (listof path?)))
-  (define racket-ext "rkt")
+  (define possible-requires (list (simplify-path (build-path source-path 'up world:pollen-require))))
-  (equal? (substring path-string (- (string-length path-string) (string-length racket-ext)) (string-length path-string)) racket-ext))
+  (and (andmap file-exists? possible-requires) possible-requires))
 
 
-;; list of all eligible requires in project require directory
+(define+provide/contract (require+provide-project-require-files here-path)
-(define (get-project-require-files)
+  (coerce/path? . -> . list?)
-  (define extras-directory (build-path (world:current-project-root) world:extras-dir))
+  (define (put-file-in-require-form file)
-  (and (directory-exists? extras-directory)
+    `(file ,(path->string file)))
-       ;; #:build? option returns complete paths (instead of just file names)
+  (define project-require-files (get-project-require-files here-path))
-       (let ([files (filter project-require-file? (directory-list extras-directory #:build? #t))])
+  
-         (and (not (equal? null files)) files))))
+  (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)))
+

render.rkt

@@ -77,8 +77,8 @@
   (file-proc source-or-output-path))
 
 
-(define (project-requires-changed?)
+(define (project-requires-changed? source-path)
-  (define project-require-files (get-project-require-files))
+  (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])

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)))