Changeset 20807 in project


Ignore:
Timestamp:
10/11/10 15:32:26 (8 years ago)
Author:
syn
Message:

hyde: serve pages directly from memory and static files from the `source-dir' instead of re-compiling and copying the whole site on each request

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/hyde/trunk/hyde.scm

    r20555 r20807  
    185185             (equal? "html" (pathname-extension referer))))))
    186186
     187(define (file-extension->mime-type ext)
     188  (alist-ref (or ext "") (mime-type-map) string-ci=? (default-mime-type)))
     189
     190(define (page-by-path path)
     191  (let* ((path (if (string=? "" (car path))
     192                   path
     193                   (cons "" path)))
     194         (path (string-join path "/"))
     195         (path (if (string=? "" path) "/" path))
     196         (page (find (lambda (page)
     197                       (string=? (page-path (cdr page)) path))
     198                     (pages))))
     199    (and page (cdr page))))
     200
     201(define (send-page page)
     202  (print-page-paths page)
     203  (send-response body: (parameterize ((current-page page))
     204                         (wrap-with-layouts (read-page page)))
     205                 headers: `((content-type ,(file-extension->mime-type
     206                                            (pathname-extension (page-path page)))))))
     207
    187208(define (serve)
    188   (root-path (output-dir))
     209  (root-path (source-dir))
    189210 
    190   (let ((m (make-mutex)))
    191     (vhost-map `((".*" .
    192                   ,(lambda (continue)
    193                      (condition-case (mutex-lock! m)
    194                          ((abandoned-mutex-exception) #t))
    195                      (if (requested-page-fresh-enough?)
    196                          (continue)
    197                          (begin
    198                            (compile-pages)
    199                            (newline)
    200                            (continue)))
    201 
    202                      (mutex-unlock! m))))))
     211  (vhost-map `((".*" .
     212                ,(lambda (continue)
     213                   (with-pages
     214                    (lambda ()
     215                      (let* ((path (cdr (uri-path (request-uri (current-request)))))
     216                             (page (page-by-path path)))
     217
     218                        (case (and page (page-type page))
     219                          ((dynamic) (send-page page))
     220
     221                          ((directory)
     222                           (call/cc (lambda (break)
     223                                      (for-each (lambda (index-file)
     224                                                  (let* ((index-path (append path (list index-file)))
     225                                                         (index-page (page-by-path index-path)))
     226
     227                                                    (when index-page
     228                                                      (send-page index-page)
     229                                                      (break index-page))))
     230                                                (index-files))
     231
     232                                      (continue))))
     233
     234                          (else (continue))))))))))
    203235
    204236  (print (format "spiffy serving hyde on port ~A" (server-port)))
     
    218250
    219251(define (make-access-path path #!optional page-vars)
    220   (make-pathname "/" (pathname-relative-from (output-dir) (make-output-path path page-vars))))
     252  (let ((path (pathname-relative-from (output-dir) (make-output-path path page-vars))))
     253    (if (string=? path ".")
     254        "/"
     255        (make-pathname "/" path))))
    221256
    222257(define (call-with-returning value proc)
     
    269304
    270305(define (classify-path path)
    271   (let ((source-path (pathname-relative-from (source-dir) path)))
     306  (let* ((source-path (pathname-relative-from (source-dir) path))
     307         (source-path (if (string=? "." source-path) "" source-path)))
    272308    (cons source-path
    273           (cond ((translator-for path) =>
     309          (cond ((directory? path)
     310                 (make-page type: 'directory
     311                            source-path: source-path
     312                            path: (make-access-path path)
     313                            reader: (lambda () (directory path))
     314                            writer: (lambda () (create-directory (make-output-path path)))))
     315                ((translator-for path) =>
    274316                 (lambda (translator)
    275317                   (let* ((translate (car translator))
    276318                          (translator-page-vars (cdr translator))
    277                           (page-vars (or (with-input-from-file path read) '()))
     319                          (local-page-vars (or (with-input-from-file path read) '()))
    278320                          (page (make-page type: 'dynamic
    279321                                           source-path: source-path
    280                                            path: (make-access-path path page-vars)
    281                                            vars: page-vars))
    282                           (page-vars (append page-vars (default-page-vars-for page) translator-page-vars))
    283                           (page (update-page page vars: page-vars))
     322                                           vars: (append local-page-vars translator-page-vars)))
     323                          (page (update-page page path: (make-access-path path (page-vars page))))
     324                          (page (update-page page vars: (append local-page-vars
     325                                                                (default-page-vars-for page)
     326                                                                translator-page-vars)))
    284327                          (reader (let ((contents #f))
    285328                                    (lambda ()
    286                                       (if contents
    287                                           contents
    288                                           (begin
    289                                             (set! contents (compile-page-by-extension path translate page))
    290                                             contents)))))
     329                                      (unless contents
     330                                        (set! contents (compile-page-by-extension path translate page)))
     331                                      contents)))
    291332                          (writer (lambda ()
    292333                                    (with-output-to-file (make-output-path path page-vars)
     
    295336                                          (display (wrap-with-layouts (reader)))))))))
    296337                     (update-page page writer: writer reader: reader))))
    297                 ((directory? path)
    298                  (make-page type: 'directory
    299                             source-path: source-path
    300                             path: (make-access-path path)
    301                             reader: (lambda () (directory path))
    302                             writer: (lambda () (create-directory (make-output-path path)))))
    303338                (else (make-page type: 'static
    304339                                 source-path: source-path
     
    307342                                 writer: (lambda () (file-copy path (make-output-path path) #t))))))))
    308343
     344(define (print-page-paths page)
     345  (display "* ")
     346  (display (page-source-path page))
     347  (print " -> " (substring (page-path page) 1)))
     348
    309349(define (compile-page page)
    310350  (unless (eq? 'directory (page-type page))
    311     (display "* ")
    312     (display (page-source-path page))
    313     (print " -> " (substring (page-path page) 1)))
     351    (print-page-paths page))
    314352  (write-page page))
    315353
    316354(define (exclude-file? file)
    317355  (not (any (cut irregex-search <> file) (excluded-paths))))
     356
     357(define (with-pages thunk)
     358  (parameterize ((pages '()))
     359    (prepare-compilation)
     360    (thunk)))
     361
     362(define (prepare-compilation)
     363  (pages (list (classify-path (source-dir))))
     364
     365  (find-files (source-dir)
     366              exclude-file?
     367              (lambda (file _)
     368                (pages (cons (classify-path file) (pages))))))
    318369
    319370(define (compile-pages)
     
    323374    (create-directory (output-dir)))
    324375
    325   (parameterize ((pages '()))
    326 
    327     (print "preparing compilation")
    328  
    329     (find-files (source-dir)
    330                 exclude-file?
    331                 (lambda (file _)
    332                   (pages (cons (classify-path file) (pages)))))
    333 
    334     (print "compiling pages")
    335 
    336     (for-each (compose compile-page cdr) (reverse (pages)))))
     376  (print "preparing compilation")
     377  (with-pages
     378   (lambda ()
     379     (print "compiling pages")
     380     (for-each (compose compile-page cdr) (reverse (pages))))))
    337381
    338382(define (translate/sxml)
Note: See TracChangeset for help on using the changeset viewer.