From 33d48af9cf61e4e22fbef1bdca14e7233d427589 Mon Sep 17 00:00:00 2001 From: Stephen Chang Date: Thu, 3 Oct 2013 03:24:44 -0400 Subject: [PATCH] code cleanup --- pasterack.rkt | 62 ++++++--------------------------------------------- 1 file changed, 7 insertions(+), 55 deletions(-) diff --git a/pasterack.rkt b/pasterack.rkt index 46157b0..51c39cc 100644 --- a/pasterack.rkt +++ b/pasterack.rkt @@ -1,11 +1,9 @@ #lang racket -(require web-server/servlet - web-server/dispatch) +(require web-server/servlet web-server/dispatch) (require xml xml/path) (require racket/system racket/runtime-path) -(require redis - data/ring-buffer) +(require redis data/ring-buffer) (require "pasterack-utils.rkt") (provide/contract (start (request? . -> . response?))) @@ -28,19 +26,6 @@ (define (fresh-str) (let loop () (define str (mk-rand-str)) (if (EXISTS str) (loop) str))) -;; initialize buffer with some pastes -;; (ring-buffer-push! recent-pastes "4557") ; Sierpinski -;; (ring-buffer-push! recent-pastes "9545") ; div0 -;; (ring-buffer-push! recent-pastes "3516") ; circles (test require) -;; (ring-buffer-push! recent-pastes "3289") ; Greek letters -;; (ring-buffer-push! recent-pastes "2531") ; lazy fib -;; (ring-buffer-push! recent-pastes "7747") ; set bang -;; (ring-buffer-push! recent-pastes "2417") ; scribble syntax -;; (ring-buffer-push! recent-pastes "9425") ; big bang (test 1 line, 2 requires) -;; (ring-buffer-push! recent-pastes "9265") ; typed/racket -;; ;(ring-buffer-push! recent-pastes "7239") ; typed/racket -;; (ring-buffer-push! recent-pastes "8937") ; datalog - (define sample-pastes '("4557" ; Sierpinski "9545" ; div1 @@ -51,19 +36,20 @@ "2417" ; scribble syntax "9425" ; big bang (test 2 requires on 1 line) "9265" ; typed/racket -; "7239" ; another typed/racket "8937" ; datalog "2979" ; test limits, and forms in racket but not racket/base "7169" ; racket/gui "5352" ; test 2 specs in 1 require "1216" ; another typed/racket "6813" ; ffi + "5752" ; bs ipsum (as text) )) (define NUM-RECENT-PASTES 32) (define recent-pastes (empty-ring-buffer NUM-RECENT-PASTES)) (for ([p sample-pastes]) (ring-buffer-push! recent-pastes p)) +;; lang regexp patterns (define hashlang-pat #px"^\\#lang ([\\w/-]+)\\s*(.*)") (define weblang-pat #px"^web-server.*") (define scribblelang-pat #px"^scribble/.*") @@ -85,7 +71,7 @@ (define (require-datum? e) (get-require-spec e)) (define (get-require-spec e) (regexp-match require-pat (to-string e))) -;; returns output file name (as path), or #f on fail +;; returns generated pastenum (define (write-codeblock-scrbl-file code) (define tmp-name (mk-rand-str)) (define tmp-scrbl-file (build-path tmp-dir (++ tmp-name ".scrbl"))) @@ -96,42 +82,27 @@ [(TR-lang? lang) (list "racket")] [(web-lang? lang) (list "web-server" "web-server/http")] [else (list lang)])) -; (printf "~v" lang-lst) (define reqs (with-handlers ([exn:fail? (const null)]) ;; read fail = non-sexp syntax (with-input-from-string code-no-lang (lambda () (for/list ([e (in-port)] #:when (require-datum? e)) (second (get-require-spec e))))))) -; (printf "~v" reqs) (flush-output) (with-output-to-file tmp-scrbl-file (lambda () (printf (++ "#lang scribble/manual\n" "@(require (for-label " (string-join (append lang-lst reqs)) "))\n" -; lang " " (apply ++ reqs) -; "@(require (for-label racket" "))\n" "@codeblock|{\n~a}|") code)) #:mode 'text #:exists 'replace) tmp-name) (define (write-eval-scrbl-file code) + ; parse out #lang if it's there, otherwise use racket (define-values (lang code-no-lang) (hashlang-split code)) - ;; parse out #lang if it's there -; (define lang-match (regexp-match #px"^\\#lang ([\\w/]+)\\s*(.*)" code)) - ;; (define-values (code-no-lang lang) - ;; (match lang-match [(list _ lang rst) (values rst lang)] - ;; [_ (values code "racket")])) -; (printf "~v" lang) (flush-output) (define tmp-name (mk-rand-str)) (define tmp-scrbl-file (build-path tmp-dir (++ tmp-name ".scrbl"))) (with-output-to-file tmp-scrbl-file (lambda () - ;; (printf (++ "#lang scribble/manual\n" - ;; "@(require scribble/eval)\n" - ;; "@(define the-eval (make-base-eval" - ;; (if (string=? "racket" lang) "" (++ " #:lang '" lang)) - ;; "))\n" - ;; "@interaction[#:eval the-eval\n~a]") (printf (++ "#lang scribble/manual\n" "@(require scribble/eval racket/sandbox)\n" @@ -149,15 +120,8 @@ " [sandbox-path-permissions '([exists \"/\"])]\n" " [sandbox-eval-limits '(8 64)])\n" " (let ([e (make-evaluator '" lang ")])\n" - ;; " (let ([ns (namespace-anchor->namespace anchor)])\n" - ;; " (call-in-sandbox-context e\n" - ;; " (lambda () (namespace-attach-module ns " - ;; "'file/convertible)))\n" " (call-in-sandbox-context e\n" " (lambda ()\n" - ;; " (unless (namespace-variable-value " - ;; "'pretty-print-handler #t (lambda () #f))\n" - ;; " (namespace-attach-module ns 'racket/pretty))\n" " (current-print (dynamic-require 'racket/pretty " "'pretty-print-handler))))\n" " e)))))\n" @@ -237,17 +201,7 @@ (td ((style "width:8em")) (input ((type "submit") (value "Submit Paste")))) (td (input ((type "checkbox") (name "astext") (value "off"))) - " Submit as text only")))) -; (br) -; (h3 "Recent pastes:") - ;; (table ((style "margin-top:-15px")) - ;; ,@(reverse - ;; (for/list ([pnum recent-pastes] #:when pnum) - ;; (define name (bytes->string/utf-8 (HGET pnum 'name))) - ;; `(tr (td ((style "width:20px"))) - ;; (td ,(mk-link (mk-paste-url pnum) pnum)) - ;; (td ((style "width:2px"))) (td ,name)))))) - )) + " Submit as text only")))))) (div ((style "width:10em;position:relative;float:right"))))))) (send/suspend/dispatch response-generator)) @@ -342,8 +296,6 @@ identity (map (lambda (x) - ;; (printf "~v\n" x) - ;; (flush-output) (match x ;; single-line evaled expr (with ">" prompt), skip [`(tr () (td () (span ((class "stt")) ">" " ") . ,rst))