forked from cadence/breezewiki
		
	Replace define-runtime-path with custom anytime-path function
This commit is contained in:
		
							parent
							
								
									e0fec5fa9c
								
							
						
					
					
						commit
						453570bdc9
					
				
					 6 changed files with 50 additions and 11 deletions
				
			
		| 
						 | 
					@ -1,5 +1,6 @@
 | 
				
			||||||
text/html                             html
 | 
					text/html                             html
 | 
				
			||||||
text/css                              css
 | 
					text/css                              css
 | 
				
			||||||
 | 
					application/xml                       xml
 | 
				
			||||||
text/xml                              xml
 | 
					text/xml                              xml
 | 
				
			||||||
image/gif                             gif
 | 
					image/gif                             gif
 | 
				
			||||||
image/jpeg                            jpeg
 | 
					image/jpeg                            jpeg
 | 
				
			||||||
| 
						 | 
					@ -25,6 +26,7 @@ application/font-woff2                woff2
 | 
				
			||||||
application/acad                      woff2
 | 
					application/acad                      woff2
 | 
				
			||||||
font/woff2                            woff2
 | 
					font/woff2                            woff2
 | 
				
			||||||
application/font-woff                 woff
 | 
					application/font-woff                 woff
 | 
				
			||||||
 | 
					font/woff                             woff
 | 
				
			||||||
application/x-font-ttf                ttf
 | 
					application/x-font-ttf                ttf
 | 
				
			||||||
application/x-font-truetype           ttf
 | 
					application/x-font-truetype           ttf
 | 
				
			||||||
application/x-truetype-font           ttf
 | 
					application/x-truetype-font           ttf
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1,5 +1,5 @@
 | 
				
			||||||
#lang racket/base
 | 
					#lang racket/base
 | 
				
			||||||
(require (for-syntax racket/base))
 | 
					(require (for-syntax racket/base syntax/location))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(provide
 | 
					(provide
 | 
				
			||||||
 ; help make a nested if. if/in will gain the same false form of its containing if/out.
 | 
					 ; help make a nested if. if/in will gain the same false form of its containing if/out.
 | 
				
			||||||
| 
						 | 
					@ -7,7 +7,12 @@
 | 
				
			||||||
 ; cond, but values can be defined between conditions
 | 
					 ; cond, but values can be defined between conditions
 | 
				
			||||||
 cond/var
 | 
					 cond/var
 | 
				
			||||||
 ; wrap sql statements into lambdas so they can be executed during migration
 | 
					 ; wrap sql statements into lambdas so they can be executed during migration
 | 
				
			||||||
 wrap-sql)
 | 
					 wrap-sql
 | 
				
			||||||
 | 
					 ; get the name of the file that contains the currently evaluating form
 | 
				
			||||||
 | 
					 this-directory
 | 
				
			||||||
 | 
					 this-file
 | 
				
			||||||
 | 
					 ; replacement for define-runtime-path
 | 
				
			||||||
 | 
					 anytime-path)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(module+ test
 | 
					(module+ test
 | 
				
			||||||
  (require rackunit)
 | 
					  (require rackunit)
 | 
				
			||||||
| 
						 | 
					@ -96,6 +101,16 @@
 | 
				
			||||||
  (check-equal? (if/out #t (if/in #f 'yes) 'no) 'no)
 | 
					  (check-equal? (if/out #t (if/in #f 'yes) 'no) 'no)
 | 
				
			||||||
  (check-equal? (if/out #f (if/in #f 'yes) 'no) 'no))
 | 
					  (check-equal? (if/out #f (if/in #f 'yes) 'no) 'no))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define-syntax (this-directory stx)
 | 
				
			||||||
 | 
					  (datum->syntax stx (syntax-source-directory stx)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define-syntax (this-file stx)
 | 
				
			||||||
 | 
					  (datum->syntax stx (build-path (or (syntax-source-directory stx) 'same) (syntax-source-file-name stx))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(module+ test
 | 
				
			||||||
 | 
					  (require racket/path)
 | 
				
			||||||
 | 
					  (check-equal? (file-name-from-path (this-file)) (build-path "syntax.rkt")))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define-syntax (cond/var stx)
 | 
					(define-syntax (cond/var stx)
 | 
				
			||||||
  (transform/out-cond/var stx))
 | 
					  (transform/out-cond/var stx))
 | 
				
			||||||
(module+ test
 | 
					(module+ test
 | 
				
			||||||
| 
						 | 
					@ -103,7 +118,28 @@
 | 
				
			||||||
                       #'(cond
 | 
					                       #'(cond
 | 
				
			||||||
                           [#f 0]
 | 
					                           [#f 0]
 | 
				
			||||||
                           [#t
 | 
					                           [#t
 | 
				
			||||||
                            (let ([d (* a 2)])
 | 
					                            (let* ([d (* a 2)])
 | 
				
			||||||
                              (cond
 | 
					                              (cond
 | 
				
			||||||
                                [(eq? d 8) d]
 | 
					                                [(eq? d 8) d]
 | 
				
			||||||
                                [#t "not 4"]))])))
 | 
					                                [#t "not 4"]))])))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					;;; Replacement for define-runtime-path that usually works well and doesn't include the files/folder contents into the distribution.
 | 
				
			||||||
 | 
					;;; When running from source, should always work appropriately.
 | 
				
			||||||
 | 
					;;; When running from a distribution, (current-directory) is treated as the root.
 | 
				
			||||||
 | 
					;;; Usage:
 | 
				
			||||||
 | 
					;;;   * to-root : Path-String * relative path from the source file to the project root
 | 
				
			||||||
 | 
					;;;   * to-dest : Path-String * relative path from the root to the desired file/folder
 | 
				
			||||||
 | 
					(define-syntax (anytime-path stx)
 | 
				
			||||||
 | 
					  (define-values (_ to-root to-dest) (apply values (syntax->list stx)))
 | 
				
			||||||
 | 
					  (define source (syntax-source stx))
 | 
				
			||||||
 | 
					  (unless (complete-path? source)
 | 
				
			||||||
 | 
					    (error 'anytime-path "syntax source has no directory: ~v" stx))
 | 
				
			||||||
 | 
					  (datum->syntax
 | 
				
			||||||
 | 
					   stx
 | 
				
			||||||
 | 
					   `(let* ([syntax-to-root (build-path (path-only ,source) ,to-root)]
 | 
				
			||||||
 | 
					           [root (if (directory-exists? syntax-to-root)
 | 
				
			||||||
 | 
					                     ;; running on the same filesystem it was compiled on, i.e. it's running the source code out of a directory, and the complication is the intermediate compilation
 | 
				
			||||||
 | 
					                     syntax-to-root
 | 
				
			||||||
 | 
					                     ;; not running on the same filesystem, i.e. it's a distribution. we assume that the current working directory is where the executable is, and treat this as the root.
 | 
				
			||||||
 | 
					                     (current-directory))])
 | 
				
			||||||
 | 
					      (simple-form-path (build-path root ,to-dest)))))
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -8,8 +8,8 @@
 | 
				
			||||||
         db
 | 
					         db
 | 
				
			||||||
         memo
 | 
					         memo
 | 
				
			||||||
         "static-data.rkt"
 | 
					         "static-data.rkt"
 | 
				
			||||||
         "../lib/url-utils.rkt"
 | 
					 | 
				
			||||||
         "whole-utils.rkt"
 | 
					         "whole-utils.rkt"
 | 
				
			||||||
 | 
					         "../lib/url-utils.rkt"
 | 
				
			||||||
         "../lib/xexpr-utils.rkt"
 | 
					         "../lib/xexpr-utils.rkt"
 | 
				
			||||||
         "../archiver/archiver-database.rkt"
 | 
					         "../archiver/archiver-database.rkt"
 | 
				
			||||||
         "config.rkt")
 | 
					         "config.rkt")
 | 
				
			||||||
| 
						 | 
					@ -42,7 +42,7 @@
 | 
				
			||||||
    [(config-true? 'feature_offline::only)
 | 
					    [(config-true? 'feature_offline::only)
 | 
				
			||||||
     (when (config-true? 'debug)
 | 
					     (when (config-true? 'debug)
 | 
				
			||||||
       (printf "using offline mode for siteinfo ~a~n" wikiname))
 | 
					       (printf "using offline mode for siteinfo ~a~n" wikiname))
 | 
				
			||||||
     (define row (query-maybe-row slc "select sitename, basepage, license_text, license_url from wiki where wikiname = ?"
 | 
					     (define row (query-maybe-row* "select sitename, basepage, license_text, license_url from wiki where wikiname = ?"
 | 
				
			||||||
                                   wikiname))
 | 
					                                   wikiname))
 | 
				
			||||||
     (if row
 | 
					     (if row
 | 
				
			||||||
         (siteinfo^ (vector-ref row 0)
 | 
					         (siteinfo^ (vector-ref row 0)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -2,7 +2,6 @@
 | 
				
			||||||
(require racket/file
 | 
					(require racket/file
 | 
				
			||||||
         racket/path
 | 
					         racket/path
 | 
				
			||||||
         racket/port
 | 
					         racket/port
 | 
				
			||||||
         racket/runtime-path
 | 
					 | 
				
			||||||
         racket/string
 | 
					         racket/string
 | 
				
			||||||
         net/url
 | 
					         net/url
 | 
				
			||||||
         web-server/http
 | 
					         web-server/http
 | 
				
			||||||
| 
						 | 
					@ -11,6 +10,7 @@
 | 
				
			||||||
         (only-in web-server/dispatchers/dispatch next-dispatcher)
 | 
					         (only-in web-server/dispatchers/dispatch next-dispatcher)
 | 
				
			||||||
         "../archiver/archiver.rkt"
 | 
					         "../archiver/archiver.rkt"
 | 
				
			||||||
         "../lib/mime-types.rkt"
 | 
					         "../lib/mime-types.rkt"
 | 
				
			||||||
 | 
					         "../lib/syntax.rkt"
 | 
				
			||||||
         "../lib/xexpr-utils.rkt"
 | 
					         "../lib/xexpr-utils.rkt"
 | 
				
			||||||
         "config.rkt"
 | 
					         "config.rkt"
 | 
				
			||||||
         "log.rkt")
 | 
					         "log.rkt")
 | 
				
			||||||
| 
						 | 
					@ -18,7 +18,7 @@
 | 
				
			||||||
(provide
 | 
					(provide
 | 
				
			||||||
 page-static-archive)
 | 
					 page-static-archive)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define-runtime-path path-archive "../storage/archive")
 | 
					(define path-archive (anytime-path ".." "storage/archive"))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define ((replacer wikiname) whole url)
 | 
					(define ((replacer wikiname) whole url)
 | 
				
			||||||
  (format
 | 
					  (format
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -8,6 +8,7 @@
 | 
				
			||||||
         (only-in web-server/dispatchers/dispatch next-dispatcher)
 | 
					         (only-in web-server/dispatchers/dispatch next-dispatcher)
 | 
				
			||||||
         (prefix-in files: web-server/dispatchers/dispatch-files)
 | 
					         (prefix-in files: web-server/dispatchers/dispatch-files)
 | 
				
			||||||
         "../lib/mime-types.rkt"
 | 
					         "../lib/mime-types.rkt"
 | 
				
			||||||
 | 
					         "../lib/syntax.rkt"
 | 
				
			||||||
         "config.rkt")
 | 
					         "config.rkt")
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(provide
 | 
					(provide
 | 
				
			||||||
| 
						 | 
					@ -17,7 +18,7 @@
 | 
				
			||||||
  (require rackunit))
 | 
					  (require rackunit))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define-runtime-path path-static "../static")
 | 
					(define-runtime-path path-static "../static")
 | 
				
			||||||
(define-runtime-path path-archive "../storage/archive")
 | 
					(define path-archive (anytime-path ".." "storage/archive"))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define hash-ext-mime-type
 | 
					(define hash-ext-mime-type
 | 
				
			||||||
  (hash #".css" #"text/css"
 | 
					  (hash #".css" #"text/css"
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -4,7 +4,7 @@
 | 
				
			||||||
         racket/function
 | 
					         racket/function
 | 
				
			||||||
         racket/list
 | 
					         racket/list
 | 
				
			||||||
         racket/match
 | 
					         racket/match
 | 
				
			||||||
         racket/runtime-path
 | 
					         racket/path
 | 
				
			||||||
         racket/string
 | 
					         racket/string
 | 
				
			||||||
         ; libs
 | 
					         ; libs
 | 
				
			||||||
         (prefix-in easy: net/http-easy)
 | 
					         (prefix-in easy: net/http-easy)
 | 
				
			||||||
| 
						 | 
					@ -38,7 +38,7 @@
 | 
				
			||||||
(module+ test
 | 
					(module+ test
 | 
				
			||||||
  (require rackunit))
 | 
					  (require rackunit))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define-runtime-path path-archive "../storage/archive")
 | 
					(define path-archive (anytime-path ".." "storage/archive"))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (page-wiki-offline req)
 | 
					(define (page-wiki-offline req)
 | 
				
			||||||
  (response-handler
 | 
					  (response-handler
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue