From 78d0aad87d1bda301ed27c10685769eb30e57943 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 22 Apr 2014 13:47:25 -0700 Subject: [PATCH] http.server.responses: adding , use it. --- basis/furnace/actions/actions.factor | 2 +- basis/furnace/furnace-tests.factor | 2 +- basis/furnace/sessions/sessions-tests.factor | 4 ++-- basis/http/server/responses/responses-docs.factor | 11 ++++++++--- basis/http/server/responses/responses.factor | 7 +++++-- basis/http/server/static/static.factor | 4 ++-- basis/tools/deploy/deploy-tests.factor | 2 +- basis/xmode/code2html/responder/responder.factor | 2 +- extra/fastcgi/fastcgi.factor | 2 +- extra/webapps/benchmark/benchmark.factor | 2 +- extra/webapps/fjsc/fjsc.factor | 9 ++++++--- extra/webapps/mason/counter/counter.factor | 2 +- extra/webapps/mason/docs-update/docs-update.factor | 2 +- extra/webapps/mason/grids/grids.factor | 4 ++-- .../mason/increment-counter/increment-counter.factor | 2 +- extra/webapps/mason/make-release/make-release.factor | 2 +- extra/webapps/mason/report/report.factor | 2 +- .../webapps/mason/status-update/status-update.factor | 2 +- extra/webapps/pastebin/pastebin.factor | 4 ++-- unmaintained/cont-responder/callbacks-tests.factor | 2 +- unmaintained/tangle/tangle.factor | 6 +++--- 21 files changed, 43 insertions(+), 32 deletions(-) diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor index 19491acfc3..e01fb9e6e7 100644 --- a/basis/furnace/actions/actions.factor +++ b/basis/furnace/actions/actions.factor @@ -113,7 +113,7 @@ M: action modify-form TUPLE: page-action < action template ; : ( path -- response ) - resolve-template-path "text/html" ; + resolve-template-path ; : ( -- page ) page-action new-action diff --git a/basis/furnace/furnace-tests.factor b/basis/furnace/furnace-tests.factor index 6fe2633031..ca1faa7729 100644 --- a/basis/furnace/furnace-tests.factor +++ b/basis/furnace/furnace-tests.factor @@ -14,7 +14,7 @@ C: base-path-check-responder M: base-path-check-responder call-responder* 2drop "$funny-dispatcher" resolve-base-path - "text/plain" ; + ; [ ] [ diff --git a/basis/furnace/sessions/sessions-tests.factor b/basis/furnace/sessions/sessions-tests.factor index 1ac3dbd51a..5e9e10591f 100644 --- a/basis/furnace/sessions/sessions-tests.factor +++ b/basis/furnace/sessions/sessions-tests.factor @@ -20,7 +20,7 @@ M: foo init-session* drop 0 "x" sset ; M: foo call-responder* 2drop "x" [ 1 + ] schange - "x" sget number>string "text/html" ; + "x" sget number>string ; : url-responder-mock-test ( -- string ) [ @@ -47,7 +47,7 @@ M: foo call-responder* : ( -- action ) - [ [ ] "text/plain" exit-with ] >>display ; + [ [ ] exit-with ] >>display ; [ "auth-test.db" temp-file delete-file ] ignore-errors diff --git a/basis/http/server/responses/responses-docs.factor b/basis/http/server/responses/responses-docs.factor index 3ca276695a..d4bbd4c986 100644 --- a/basis/http/server/responses/responses-docs.factor +++ b/basis/http/server/responses/responses-docs.factor @@ -8,7 +8,13 @@ HELP: HELP: { $values { "body" "a response body" } { "response" response } } -{ $description "Creates a plain text response." } ; +{ $description "Creates a response with content type " { $snippet "text/plain" } "." } ; + +HELP: +{ $values { "body" "a response body" } { "response" response } } +{ $description "Creates a response with content type " { $snippet "text/html" } "." } ; + +{ } related-words HELP: { $values { "code" integer } { "message" string } { "response" response } } @@ -26,9 +32,8 @@ ARTICLE: "http.server.responses" "Canned HTTP responses" { $subsections + } - -{ $vocab-link "furnace.json" } " implements " { $link } "." $nl "For errors:" { $subsections <304> diff --git a/basis/http/server/responses/responses.factor b/basis/http/server/responses/responses.factor index db7f9618b3..9bade222ff 100644 --- a/basis/http/server/responses/responses.factor +++ b/basis/http/server/responses/responses.factor @@ -14,7 +14,10 @@ IN: http.server.responses : ( body -- response ) "text/plain" ; - + +: ( body -- response ) + "text/html" ; + : trivial-response-body ( code message -- ) @@ -26,7 +29,7 @@ IN: http.server.responses : ( code message -- response ) 2dup [ trivial-response-body ] with-string-writer - "text/html" + swap >>message swap >>code ; diff --git a/basis/http/server/static/static.factor b/basis/http/server/static/static.factor index 294c3d7a0d..01b085e1ae 100644 --- a/basis/http/server/static/static.factor +++ b/basis/http/server/static/static.factor @@ -71,7 +71,7 @@ TUPLE: file-responder root hook special index-names allow-listings ; : list-directory ( directory -- response ) file-responder get allow-listings>> [ - directory>html "text/html" + directory>html ] [ drop <403> ] if ; @@ -105,7 +105,7 @@ M: file-responder call-responder* ( path responder -- response ) index-names>> adjoin ; : serve-fhtml ( path -- response ) - "text/html" ; + ; : enable-fhtml ( responder -- responder ) [ serve-fhtml ] "application/x-factor-server-page" pick special>> set-at diff --git a/basis/tools/deploy/deploy-tests.factor b/basis/tools/deploy/deploy-tests.factor index e71b4a8a39..95e64f3b96 100644 --- a/basis/tools/deploy/deploy-tests.factor +++ b/basis/tools/deploy/deploy-tests.factor @@ -71,7 +71,7 @@ http.server.responses http.server.static io.servers ; SINGLETON: quit-responder M: quit-responder call-responder* - 2drop stop-this-server "Goodbye" "text/html" ; + 2drop stop-this-server "Goodbye" ; : add-quot-responder ( responder -- responder ) quit-responder "quit" add-responder ; diff --git a/basis/xmode/code2html/responder/responder.factor b/basis/xmode/code2html/responder/responder.factor index 39ff627b84..74ef3ece83 100644 --- a/basis/xmode/code2html/responder/responder.factor +++ b/basis/xmode/code2html/responder/responder.factor @@ -12,5 +12,5 @@ IN: xmode.code2html.responder _ utf8 [ _ file-name input-stream get htmlize-stream ] with-file-reader - ] "text/html" + ] ] ; diff --git a/extra/fastcgi/fastcgi.factor b/extra/fastcgi/fastcgi.factor index 50cf02f131..7c4da7d50a 100644 --- a/extra/fastcgi/fastcgi.factor +++ b/extra/fastcgi/fastcgi.factor @@ -209,7 +209,7 @@ ENUM: fcgi-protocol-status TUPLE: test-responder ; C: test-responder -M: test-responder call-responder* 2drop test-output "text/html" ; +M: test-responder call-responder* 2drop test-output ; : do-it ( -- ) main-responder set diff --git a/extra/webapps/benchmark/benchmark.factor b/extra/webapps/benchmark/benchmark.factor index 2291d34186..02af19e419 100644 --- a/extra/webapps/benchmark/benchmark.factor +++ b/extra/webapps/benchmark/benchmark.factor @@ -9,7 +9,7 @@ IN: webapps.benchmark : ( -- action ) - [ "Hello, world!" "text/plain" ] >>display ; + [ "Hello, world!" ] >>display ; TUPLE: benchmark < dispatcher ; diff --git a/extra/webapps/fjsc/fjsc.factor b/extra/webapps/fjsc/fjsc.factor index 52227ade16..67e27fc63f 100644 --- a/extra/webapps/fjsc/fjsc.factor +++ b/extra/webapps/fjsc/fjsc.factor @@ -33,12 +33,15 @@ TUPLE: fjsc < dispatcher ; over "/" head? [ "/" append ] unless swap append ; +: ( body -- content ) + "application/javascript" ; + : do-compile-url ( url -- response ) [ absolute-url http-get nip 'expression' parse fjsc-compile write "();" write ] with-string-writer - "application/javascript" ; + ; : v-local ( string -- string ) dup "http:" head? [ "Unable to compile code from remote sites" throw ] when ; @@ -55,10 +58,10 @@ TUPLE: fjsc < dispatcher ; [ validate-compile-url "url" value do-compile-url ] >>display ; : do-compile ( code -- response ) - [ + [ 'expression' parse fjsc-compile write ] with-string-writer - "application/javascript" ; + ; : validate-compile ( -- ) { diff --git a/extra/webapps/mason/counter/counter.factor b/extra/webapps/mason/counter/counter.factor index b0ef5a8005..0926a59bf7 100644 --- a/extra/webapps/mason/counter/counter.factor +++ b/extra/webapps/mason/counter/counter.factor @@ -9,6 +9,6 @@ IN: webapps.mason.counter [ [ counter-value number>string - "text/plain" + ] with-mason-db ] >>display ; diff --git a/extra/webapps/mason/docs-update/docs-update.factor b/extra/webapps/mason/docs-update/docs-update.factor index 2df1f9ee83..dd4798c803 100644 --- a/extra/webapps/mason/docs-update/docs-update.factor +++ b/extra/webapps/mason/docs-update/docs-update.factor @@ -30,5 +30,5 @@ IN: webapps.mason.docs-update [ validate-secret ] >>validate [ [ update-docs ] "Documentation update" spawn drop - "OK" "text/plain" + "OK" ] >>submit ; diff --git a/extra/webapps/mason/grids/grids.factor b/extra/webapps/mason/grids/grids.factor index 8c888b501c..26d7a0a94a 100644 --- a/extra/webapps/mason/grids/grids.factor +++ b/extra/webapps/mason/grids/grids.factor @@ -60,7 +60,7 @@ CONSTANT: cpus [ [ package-grid xml>string - "text/html" + ] with-mason-db ] >>display ; @@ -82,6 +82,6 @@ CONSTANT: cpus [ [ release-grid xml>string - "text/html" + ] with-mason-db ] >>display ; diff --git a/extra/webapps/mason/increment-counter/increment-counter.factor b/extra/webapps/mason/increment-counter/increment-counter.factor index 8cc6be0aad..d38615e793 100644 --- a/extra/webapps/mason/increment-counter/increment-counter.factor +++ b/extra/webapps/mason/increment-counter/increment-counter.factor @@ -9,6 +9,6 @@ IN: webapps.mason.increment-counter [ [ increment-counter-value - number>string "text/plain" + number>string ] with-mason-db ] >>submit ; diff --git a/extra/webapps/mason/make-release/make-release.factor b/extra/webapps/mason/make-release/make-release.factor index e0b4c13a1a..15c3a772fd 100644 --- a/extra/webapps/mason/make-release/make-release.factor +++ b/extra/webapps/mason/make-release/make-release.factor @@ -16,6 +16,6 @@ IN: webapps.mason.make-release [ [ "version" value "announcement-url" value do-release - "OK" "text/html" + "OK" ] with-mason-db ] >>submit ; diff --git a/extra/webapps/mason/report/report.factor b/extra/webapps/mason/report/report.factor index 64511d7f05..6d3a126a84 100644 --- a/extra/webapps/mason/report/report.factor +++ b/extra/webapps/mason/report/report.factor @@ -10,7 +10,7 @@ IN: webapps.mason.report [ [ current-builder last-report>> - "text/html" + ] with-mason-db ] >>display ; diff --git a/extra/webapps/mason/status-update/status-update.factor b/extra/webapps/mason/status-update/status-update.factor index 668db6ebd3..d1c60895d9 100644 --- a/extra/webapps/mason/status-update/status-update.factor +++ b/extra/webapps/mason/status-update/status-update.factor @@ -90,5 +90,5 @@ IN: webapps.mason.status-update find-builder [ update-builder ] [ update-tuple ] bi ] with-mason-db - "OK" "text/plain" + "OK" ] >>submit ; diff --git a/extra/webapps/pastebin/pastebin.factor b/extra/webapps/pastebin/pastebin.factor index bfceb65103..562639404a 100644 --- a/extra/webapps/pastebin/pastebin.factor +++ b/extra/webapps/pastebin/pastebin.factor @@ -143,7 +143,7 @@ M: annotation entity-url : ( -- action ) [ validate-integer-id "id" value paste from-object ] >>init - [ "contents" value "text/plain" ] >>display ; + [ "contents" value ] >>display ; : ( -- action ) @@ -227,7 +227,7 @@ M: annotation entity-url : ( -- action ) [ validate-integer-id "id" value lookup-annotation from-object ] >>init - [ "contents" value "text/plain" ] >>display ; + [ "contents" value ] >>display ; : ( -- action ) diff --git a/unmaintained/cont-responder/callbacks-tests.factor b/unmaintained/cont-responder/callbacks-tests.factor index db6f43c515..605109a0d6 100644 --- a/unmaintained/cont-responder/callbacks-tests.factor +++ b/unmaintained/cont-responder/callbacks-tests.factor @@ -21,7 +21,7 @@ IN: furnace.callbacks.tests [ [ "hello" print - "text/html" + ] show-page "byebye" print [ 123 ] show-final diff --git a/unmaintained/tangle/tangle.factor b/unmaintained/tangle/tangle.factor index 1f567a5f0d..f20ed52b3c 100644 --- a/unmaintained/tangle/tangle.factor +++ b/unmaintained/tangle/tangle.factor @@ -24,7 +24,7 @@ C: tangle [ [ db>> ] [ seq>> ] bi ] dip with-db ; : node-response ( id -- response ) - load-node [ node-content "text/plain" ] [ <404> ] if* ; + load-node [ node-content ] [ <404> ] if* ; : display-node ( params -- response ) [ @@ -40,7 +40,7 @@ C: tangle : submit-node ( params -- response ) [ "node_content" swap at* [ - create-node id>> number>string "text/plain" + create-node id>> number>string ] [ drop <400> ] if @@ -56,7 +56,7 @@ TUPLE: path-responder ; C: path-responder M: path-responder call-responder* ( path responder -- response ) - drop path>file [ node-content "text/plain" ] [ <404> ] if* ; + drop path>file [ node-content ] [ <404> ] if* ; TUPLE: tangle-dispatcher < dispatcher tangle ; -- 2.34.1