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…
Reference in a new issue