From b57a9345313455e953cc40c1ad38ff3f97412f9f Mon Sep 17 00:00:00 2001 From: Stephen Chang Date: Tue, 1 Oct 2013 17:10:47 +0000 Subject: [PATCH] fix eval; add recent pastes - render codeblock and eval in separate passes - use scribble interactions instead of interaction-eval-show --- pasterack.rkt | 207 ++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 157 insertions(+), 50 deletions(-) diff --git a/pasterack.rkt b/pasterack.rkt index 034caf6..aa6feb0 100644 --- a/pasterack.rkt +++ b/pasterack.rkt @@ -4,18 +4,21 @@ web-server/dispatch) (require xml xml/path) (require racket/system racket/runtime-path) -(require redis) +(require redis + data/ring-buffer) (provide/contract (start (request? . -> . response?))) -(define-runtime-path tmp-html-file "test.html") -(define-runtime-path tmp-scrbl-file "test.scrbl") +;; (define-runtime-path tmp-html-file "test.html") +;; (define-runtime-path tmp-scrbl-file "test.scrbl") (define-runtime-path htdocs-dir "htdocs") (define-runtime-path here ".") +(define-runtime-path tmp-dir "tmp") +(define ++ string-append) (define +++ string-append) (define pastebin-url "http://www.pasterack.org/") -(define paste-url-base (+++ pastebin-url "pastes/")) +(define paste-url-base (++ pastebin-url "pastes/")) (define racket-docs-url "http://docs.racket-lang.org/") (define racket-lang-url "http://racket-lang.org") (define racket-logo-url "http://racket-lang.org/logo.png") @@ -23,26 +26,74 @@ (define (mk-link url txt) `(a ((href ,url) (onclick ,(+++ "top.location.href=\"" url "\""))) ,txt)) -(define (write-scribble-file code) +(define NUM-RECENT-PASTES 5) +(define recent-pastes (empty-ring-buffer NUM-RECENT-PASTES)) +;; initialize buffer with some pastes +(ring-buffer-push! recent-pastes "4363") +(ring-buffer-push! recent-pastes "4548") +(ring-buffer-push! recent-pastes "8249") +(ring-buffer-push! recent-pastes "9921") +(ring-buffer-push! recent-pastes "7145") + + +;; returns output file name (as path), or #f on fail +(define (write-codeblock-scrbl-file code) + (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 (for-label racket))\n" + "@codeblock{\n~a}") + code)) + #:mode 'text + #:exists 'replace) + tmp-name) +(define (write-eval-scrbl-file code) + (define lang-match (regexp-match #px"^\\#lang ([\\w/]+)\\s*(.*)" code)) + (define code-no-lang (match lang-match [(list _ _ rst) rst] [_ code])) + (define lang (match lang-match [(list _ lang _) lang] [_ "racket"])) + (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 (for-label racket))\n" - "@(require scribble/eval)\n" - "@(define the-eval (make-base-eval))\n" -; "@codeblock[#:line-numbers 0]{\n~a}") - "@codeblock{\n~a}\n") -; "@interaction-eval-show[#:eval the-eval ~a]") - code)) - #:mode 'text - #:exists 'replace)) -(define (compile-scribble-file code) - (write-scribble-file code) - (system (+++ "/home/stchang/pltpkg/racket/bin/scribble --html +m " + (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]") + code-no-lang)) + #:mode 'text + #:exists 'replace) + tmp-name) +#;(define (compile-scribble-file code) + (with-handlers ([exn:fail? (lambda (x) (displayln (exn-message x)) #f)]) + (write-scribble-file code) + (system (+++ "/home/stchang/pltpkg/racket/bin/scribble --html +m " ; "++xref-in setup/xref load-collections-xref " + "--redirect-main " racket-docs-url " " + "--dest " (path->string here) " " + (path->string tmp-scrbl-file))))) +(define (compile-scrbl-file/get-html name) + (and + (system (++ "/home/stchang/pltpkg/racket/bin/scribble --html +m " "--redirect-main " racket-docs-url " " - "--dest " (path->string here) " " - (path->string tmp-scrbl-file)))) + "--dest " (path->string tmp-dir) " " + (path->string (build-path tmp-dir (++ name ".scrbl"))))) + (with-input-from-file (build-path tmp-dir (++ name ".html")) port->bytes))) +(define (compile-eval-scrbl-file/get-html name) + (and + (system (++ "/home/stchang/pltpkg/racket/bin/scribble --html " + "--dest " (path->string tmp-dir) " " + (path->string (build-path tmp-dir (++ name ".scrbl"))))) + (with-input-from-file (build-path tmp-dir (++ name ".html")) port->bytes))) + +(define (generate-paste-html code) + (compile-scrbl-file/get-html (write-codeblock-scrbl-file code))) +(define (generate-eval-html code) + (compile-eval-scrbl-file/get-html (write-eval-scrbl-file code))) + +(define (mk-paste-url paste-num) (++ paste-url-base paste-num)) (define google-analytics-script (+++ "var _gaq = _gaq || [];\n" @@ -72,7 +123,16 @@ (form ((action ,(embed/url process-paste)) (method "post")) (textarea ((rows "20") (cols "79") (name "paste"))) (br) - (input ((type "submit") (value "Submit Paste"))))))))) + (input ((type "submit") (value "Submit Paste")))) + (br) (br) (br) + (h3 "Recent pastes:") + ,@(apply append + (reverse + (for/list ([n NUM-RECENT-PASTES]) + (define paste-num (ring-buffer-ref recent-pastes n)) + (if paste-num + (list (mk-link (mk-paste-url paste-num) paste-num) '(br)) + null))))))))) (send/suspend/dispatch response-generator)) (define (mk-rand-str) @@ -86,48 +146,54 @@ (define bs (request-bindings request)) (cond [(exists-binding? 'paste bs) - (define pastenum (fresh-str)) - (define paste-url (+++ paste-url-base pastenum)) - (define code (extract-binding/single 'paste bs)) - (define html-str - (if (compile-scribble-file code) - (with-input-from-file tmp-html-file port->bytes) - code)) - ;; (car (filter - ;; (lambda (d) (equal? "main" (se-path* '(div #:class) d))) - ;; (se-path*/list '(div) - ;; (xml->xexpr (document-element - ;; (with-input-from-file tmp-html-file read-xml))))))) - (SET pastenum html-str) + (define paste-num (fresh-str)) + (define pasted-code (extract-binding/single 'paste bs)) + (define html-res (generate-paste-html pasted-code)) + (define paste-html-str (or html-res pasted-code)) + (define eval-html-str (and html-res (generate-eval-html pasted-code))) + ;; (if (compile-scribble-file pasted-code) + ;; (with-input-from-file tmp-html-file port->bytes) + ;; code)) + ;; ;; (car (filter + ;; ;; (lambda (d) (equal? "main" (se-path* '(div #:class) d))) + ;; ;; (se-path*/list '(div) + ;; ;; (xml->xexpr (document-element + ;; ;; (with-input-from-file tmp-html-file read-xml))))))) + (define paste-url (mk-paste-url paste-num)) + (ring-buffer-push! recent-pastes paste-num) + (SET/list paste-num (list paste-html-str (or eval-html-str ""))) (response/xexpr `(html () (head () - (script () ,(+++ "top.location.href=\"" paste-url "\""))) + (script () ,(++ "top.location.href=\"" paste-url "\""))) (body ())))] [else (response/xexpr `(html () (head ()) - (body () "ERROR" ,(mk-link pastebin-url "Go Back"))))])) + (body () "ERROR: bad paste" ,(mk-link pastebin-url "Go Back"))))])) + +(define (get-main-div html-bytes) + (with-handlers ([exn:fail? (lambda (x) (bytes->string/utf-8 html-bytes))]) + (car (filter + (lambda (d) (equal? "main" (se-path* '(div #:class) d))) + (se-path*/list '(div) + (xml->xexpr (document-element + (with-input-from-bytes html-bytes read-xml)))))))) (define (serve-paste request pastenum) - (define html-str (GET pastenum)) + (define retrieved-paste (GET/list pastenum)) (cond - [(not html-str) + [(null? retrieved-paste) (response/xexpr `(html() (head ()) (body () ,(format "Paste # ~a doesn't exist." pastenum) (br) ,(mk-link pastebin-url "Go Back"))))] [else -; (compile-scribble-file code) - (define main-div - (with-handlers ([exn:fail? (lambda (x) (bytes->string/utf-8 html-str))]) - (car (filter - (lambda (d) (equal? "main" (se-path* '(div #:class) d))) - (se-path*/list '(div) - (xml->xexpr (document-element - (with-input-from-bytes html-str read-xml)))))))) + (match-define (list code-html eval-html) (GET/list pastenum)) + (define code-main-div (get-main-div code-html)) + (define eval-main-div (get-main-div eval-html)) (define paste-url (string-append paste-url-base pastenum)) (response/xexpr `(html () @@ -147,10 +213,51 @@ ,(mk-link pastebin-url "PasteRack") " Paste # " (a ((href ,paste-url)) ,pastenum) (div ((class "maincolumn")) - ,(match main-div + ,(match code-main-div [`(div ((class "main")) ,ver ,body) - `(div ((class "main")) ,body)] - [_ `(div ,main-div)])))))])) + `(div ((class "main")) + ,body + (p "=>") + ,(match eval-main-div + [`(div ((class "main")) ,ver + (blockquote ,attr1 (table ,attr2 . ,results))) + `(blockquote ,attr1 (table ,attr2 . + ,(filter + 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)) + #f] + ;; multi-line evaled expr + [`(tr () (td () + (table ((cellspacing "0") + (class "RktBlk")) + (tr () (td () (span ((class "stt")) ">" " ") + . ,rst1)) . ,rst))) #f] + ;; void result, skip + [`(tr () (td () (table ,attr (tr () (td ()))))) #f] + ;; fix filename in image link + [`(tr () (td () (p () (img + ((alt "image") ,height + (src ,filename) ,width))))) + `(tr () (td () (p () (img + ((alt "image") ,height + (src ,(++ "/" filename)) ,width)))))] + [x x])) + results))))] + [_ `(div ,eval-main-div)]))] + ;; ;; filter void outputs + ;; ,(filter + ;; (lambda (x) + ;; (match x + ;; ['(p () (span ((class "RktRes")) "#" "<" "void" ">")) #f] + ;; [_ #t])) + ;; results))] + [_ `(div ,code-main-div)])))))])) ;; [`(div ((class "main")) ,ver (p () ,code ,res)) ;; `(div ((class "main")) (p () ,code (div "=>") ,res))])))))])) ;; ,(cons (car main-div) (cons (cadr main-div) (cdddr main-div)))))))])) @@ -174,6 +281,6 @@ #:quit? #f #:listen-ip #f #:port 8000 - #:extra-files-paths (list htdocs-dir) + #:extra-files-paths (list tmp-dir htdocs-dir) #:servlet-path "/" #:servlet-regexp #rx".*")