Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
137 lines (117 sloc) 4.86 KB
#lang scheme/base
;; code to generate basic files and folders needed for a project
(require "util.scm"
(only-in mzlib/file normalize-path))
(provide generate-project)
(define (generate-project cmd-line-args-vec)
(match cmd-line-args-vec
((vector project-path)
(generate-project-from-path project-path))
(else (e "You must provide exactly one argument to generate--a path to a new project directory."))))
(define (generate-project-from-path fresh-project-path)
(if (directory-exists? fresh-project-path)
(e "The directory ~A already exists." fresh-project-path)
(begin (ensure-existence-of-dir! fresh-project-path)
(ensure-existence-of-dir! (build-path fresh-project-path "data"))
(ensure-existence-of-dir! (build-path fresh-project-path "uploaded-files"))
(ensure-existence-of-dir! (build-path fresh-project-path "htdocs"))
(ensure-existence-of-dir! (build-path fresh-project-path "htdocs/css"))
(ensure-existence-of-dir! (build-path fresh-project-path "htdocs/js"))
(ensure-existence-of-dir! (build-path fresh-project-path "htdocs/i"))
(generate-basic-scm-files fresh-project-path)
(generate-script-dir fresh-project-path)
(generate-htdocs-files fresh-project-path))))
(define (generate-basic-scm-files project-path)
;; serve.scm
#:dir-must-exist #t
(build-path project-path "serve.scm")
`(require ,(expr-for-lp-require "leftparen.scm")
(make-raw "")
(make-raw "")
'(serve my-app)
;; app.scm
#:dir-must-exist #t
(build-path project-path "app.scm")
(make-raw "#lang scheme/base\n")
`(require ,(expr-for-lp-require "leftparen.scm"))
(make-raw "")
'(define-app my-app
(index-page (url "/")))
;; main.scm
#:dir-must-exist #t
(build-path project-path "main.scm")
(make-raw "#lang scheme/base\n")
`(require ,(expr-for-lp-require "leftparen.scm")
(make-raw "")
'(define-page (index-page req)
"Hello, World!")
;; settings-localhost.scm
#:dir-must-exist #t
(build-path project-path "settings-localhost.scm")
`(require ,(expr-for-lp-require "settings.scm"))
(make-raw "")
'(setting-set! *PORT* 8765)
(make-raw ";; use #f if you want to listen to all incoming IPs:")
'(setting-set! *LISTEN_IP* "")
'(setting-set! *WEB_APP_URL* "http://localhost:8765/")
(define (generate-script-dir project-path)
(ensure-existence-of-dir! project-path #:must-previously-exist #t)
;; script/server
(build-path project-path "script/server")
;; we double-quote the executable name in case it's a path with, e.g., spaces:
(make-raw (format "\"~A\" -r serve.scm $1" (find-system-path 'exec-file))))
(define (generate-htdocs-files project-path)
(ensure-existence-of-dir! project-path #:must-previously-exist #t)
(build-path project-path "htdocs/page-not-found.html")
(make-raw "<html><body>Page not found.</body></html>")))
(define-struct raw (str))
(define (generate-file-with-expressions path-to-file
#:dir-must-exist (dir-must-exist #f)
. expressions)
#:must-previously-exist dir-must-exist
(lambda ()
(for-each (lambda (e)
(if (raw? e) (write-string (raw-str e)) (write e))
(write-string "\n")) expressions)
(define (ensure-existence-of-dir! dir-path #:must-previously-exist (must-exist #f))
(when (file-exists? dir-path)
(e "A file called ~A instead of a directory was found." dir-path))
(if must-exist
(if (directory-exists? dir-path)
(e "The directory ~A cannot be found." dir-path))
(or (directory-exists? dir-path)
(begin (make-directory dir-path)
(display (format "Created directory ~A\n" dir-path))))))
;; it's an error if filename in path already exists
(define (with-output-to-file-in-dir path-to-file thunk
#:must-previously-exist (must-exist #f))
(receive (path filename is-dir) (split-path path-to-file)
(ensure-existence-of-dir! path #:must-previously-exist must-exist)
(with-output-to-file (build-path path filename) thunk #:mode 'text #:exists 'error)))
(define (expr-for-lp-require filename-rel-to-lib-root)
`(planet ,filename-rel-to-lib-root ("vegashacker" "leftparen.plt"
Something went wrong with that request. Please try again.