streamline world

lang/inner-lang-helper.rkt

@@ -0,0 +1,65 @@
+#lang racket/base
+(require (for-syntax racket/base))
+
+(require racket/contract/region)
+
+(provide (all-defined-out) (all-from-out racket/contract/region))
+
+;; A place to stash functions that don't change between compiles of Pollen files.
+
+;; duplicate of contents of project-require.rkt.
+;; Goes faster if it's not in a separate module.
+;; todo: use include? But this one has to be available as syntax
+;; todo: get rid of magic value
+(define-for-syntax (project-require-file? path)
+  (define path-string (path->string path))
+  (equal? (substring path-string (- (string-length path-string) 3) (string-length path-string)) "rkt"))
+
+;; list of all eligible requires in project require directory
+(define-for-syntax (get-project-require-files)
+  (define extras-directory (build-path (current-directory) "pollen-require"))
+  (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? '() files)) 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))
+
+(define-syntax (get-here-path stx)
+  (datum->syntax stx 
+                 '(begin 
+                    ;; This macro might be used in an expression context, 
+                    ;; so we use let, not define.
+                    (let* ([ccr (current-contract-region)] ; trick for getting current module name
+                           [here-path (cond
+                                        ;; if contract-region is called from within submodule,
+                                        ;; you get a list
+                                        ;; in which case, just grab the path from the front
+                                        [(list? ccr) (car ccr)]
+                                        ;; file isn't yet saved in drracket
+                                        ;; 'pollen-lang-module name is applied by reader
+                                        [(equal? 'pollen-lang-module ccr) 'nowhere] 
+                                        [else ccr])])
+                      (path->string here-path)))))
+
+
+

lang/lang-helper.rkt

@@ -1,49 +0,0 @@
-#lang racket/base
-(require (for-syntax racket/base pollen/project-requires))
-
-(require racket/contract/region)
-
-(provide (all-defined-out) (all-from-out racket/contract/region))
-
-     
-
-(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))
-
-(define-syntax (get-here-path stx)
-  (datum->syntax stx 
-                 '(begin 
-                    ;; This macro might be used in an expression context, 
-                    ;; so we use let, not define.
-                    (let* ([ccr (current-contract-region)] ; trick for getting current module name
-                           [here-path (cond
-                                 ;; if contract-region is called from within submodule,
-                                 ;; you get a list
-                                 ;; in which case, just grab the path from the front
-                                 [(list? ccr) (car ccr)]
-                                 ;; file isn't yet saved in drracket
-                                 ;; 'pollen-lang-module name is applied by reader
-                                 [(equal? 'pollen-lang-module ccr) 'nowhere] 
-                                 [else ccr])])
-                      (path->string here-path)))))
-
-
-

main.rkt

@@ -12,18 +12,20 @@
      (λ(x) x) ; post-process function
      () ; prepended exprs
      
-     (require pollen/lang/lang-helper)
+     (require pollen/lang/inner-lang-helper)
-     (require-and-provide-project-require-files)
+     (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))
      
      ;; Build 'inner-here-path and 'inner-here
-     (define inner-here-path (get-here-path))
      (require (only-in racket/path find-relative-path))
      (require (only-in pollen/world PROJECT_ROOT))
-     (define inner-here (path->string (path-replace-suffix (find-relative-path PROJECT_ROOT inner-here-path) "")))
+     (define (here-path->here here-path)
+       (path->string (path-replace-suffix (find-relative-path PROJECT_ROOT here-path) "")))
+     (define inner-here-path (get-here-path))
+     (define inner-here (here-path->here inner-here-path))
      
      (provide (all-defined-out))
      
@@ -31,24 +33,30 @@
    
    (require 'inner)
    
-   ;; Split out the metas. 
+   ;; Split out the metas.   
-   (require txexpr)   
+   (require (only-in racket/path find-relative-path))
-   (define main-txexpr `(placeholder-root ,@(cdr main-raw))) ;; cdr strips initial linebreak
+   (require (only-in pollen/world PROJECT_ROOT))
-   (define is-meta-element? (λ(x) (and (txexpr? x) (equal? 'meta (car x)))))
+   (define (here-path->here here-path)
-   (define-values (main-without-metas meta-elements) 
+     (path->string (path-replace-suffix (find-relative-path PROJECT_ROOT here-path) "")))
-     (splitf-txexpr main-txexpr is-meta-element?))
-   (define meta-element->assoc (λ(x) (cons (cadr x) (caddr x))))
-   ;; Prepend 'here-path and 'here as metas so they can be overridden by metas embedded in source.
-   (define metas (make-hash (map meta-element->assoc (cons `(meta "here-path" ,inner-here-path) 
-                                                           (cons `(meta "here" ,inner-here) meta-elements)))))
    
+   (require txexpr)   
+   (define (split-metas-to-hash tx)
+     ;; return tx without metas, and meta hash
+     (define is-meta-element? (λ(x) (and (txexpr? x) (equal? 'meta (car x)))))
+     (define-values (main-without-metas meta-elements) 
+       (splitf-txexpr tx is-meta-element?))
+     (define meta-element->assoc (λ(x) (cons (cadr x) (caddr x))))
+     (define metas (make-hash (map meta-element->assoc meta-elements)))
+     (values main-without-metas metas))
+   (define main-txexpr `(placeholder-root ,@(cons `(meta "here" ,inner-here) (cons `(meta "here-path" ,inner-here-path) 
+                                                                                   (cdr main-raw))))) ;; cdr strips initial linebreak
+   (define-values (main-without-metas metas) (split-metas-to-hash main-txexpr))
    
-     
    ;; set up the 'main export
-   (require pollen/decode)
+   (require pollen/decode pollen/world)
    (require (only-in racket/list filter-not))
    (define here-ext (car (regexp-match #px"\\w+$" inner-here-path)))
-   (define wants-decoder? (member here-ext (list "pd" "ptree")))
+   (define wants-decoder? (member here-ext (map to-string DECODABLE_EXTENSIONS)))
    ;(print (cdr main-without-metas))
    (define main (apply (cond
                          [(equal? here-ext "ptree") (λ xs (decode (cons 'ptree-root xs)

project-requires.rkt

@@ -1,4 +1,5 @@
 #lang racket/base
+(require "world.rkt")
 (provide (all-defined-out))
 
 (define (project-require-file? path)
@@ -7,7 +8,7 @@
 
 ;; list of all eligible requires in project require directory
 (define (get-project-require-files)
-  (define extras-directory (build-path (current-directory) "pollen-require"))
+  (define extras-directory (build-path (current-directory) 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))])

server-routes.rkt

@@ -234,7 +234,6 @@
   (request? . -> . response?)
   (define error-text (format "route-404: Can't find ~a" (->string (req->path req))))
   (message error-text)
-  ;`(html ,(slurp (build-path SERVER_EXTRAS_DIR "404.html")))
   (response/xexpr `(html ,error-text)))
 
 
@@ -245,10 +244,3 @@
   (format-as-code (~v (file->xexpr path))))
 
 (define route-xexpr (route-wrapper xexpr))
-
-(module+ main
-  (parameterize ([current-directory (build-path (current-directory) "foobar")])
-    (reset-project-root)
-    ;    (message PROJECT_ROOT)
-    ;    (make-binary-info-page (build-path "foo.gif"))
-    ))

server.rkt

@@ -23,6 +23,9 @@
 
 (message "Ready to rock")
 
+(define MODULE_ROOT (apply build-path (drop-right (explode-path (current-contract-region)) 1)))
+(define SERVER_EXTRAS_DIR (build-path MODULE_ROOT "pollen-server-extras"))
+
 (serve/servlet pollen-servlet
                #:port SERVER_PORT
                #:listen-ip #f

world.rkt

@@ -1,5 +1,4 @@
 #lang racket/base
-(require racket/list racket/contract)
 
 ;; todo: how to make project- or user-specific prefs
 
@@ -8,8 +7,9 @@
 (define POLLEN_VERSION "0.001")
 
 (define PREPROC_SOURCE_EXT 'p)
-(define DECODER_SOURCE_EXT 'pd)
+(define DECODER_SOURCE_EXT 'pm)
 (define PTREE_SOURCE_EXT 'ptree)
+(define DECODABLE_EXTENSIONS (list DECODER_SOURCE_EXT PTREE_SOURCE_EXT))
 
 (define DEFAULT_PTREE "main.ptree")
 (define PTREE_ROOT_NODE 'ptree-root)
@@ -41,15 +41,11 @@
 
 (define COMMAND_FILE "polcom")
 
-(require sugar)
 (define RESERVED_PATHS
-  (map ->path (list COMMAND_FILE EXTRAS_DIR "poldash.css" "compiled")))
+  (map string->path (list COMMAND_FILE (path->string EXTRAS_DIR) "poldash.css" "compiled")))
 
 
 (define PROJECT_ROOT (current-directory))
-(define (reset-project-root) (set! PROJECT_ROOT (current-directory)))
-(define MODULE_ROOT (apply build-path (drop-right (explode-path (current-contract-region)) 1)))
-(define SERVER_EXTRAS_DIR (build-path MODULE_ROOT "pollen-server-extras"))
 
 (define SERVER_PORT 8088)