TUPLE: page-action < action template ;\r
\r
: <chloe-content> ( path -- response )\r
- resolve-template-path <chloe> "text/html" <content> ;\r
+ resolve-template-path <chloe> <html-content> ;\r
\r
: <page-action> ( -- page )\r
page-action new-action\r
M: base-path-check-responder call-responder*
2drop
"$funny-dispatcher" resolve-base-path
- "text/plain" <content> ;
+ <text-content> ;
[ ] [
<dispatcher>
M: foo call-responder*\r
2drop\r
"x" [ 1 + ] schange\r
- "x" sget number>string "text/html" <content> ;\r
+ "x" sget number>string <html-content> ;\r
\r
: url-responder-mock-test ( -- string )\r
[\r
\r
: <exiting-action> ( -- action )\r
<action>\r
- [ [ ] "text/plain" <content> exit-with ] >>display ;\r
+ [ [ ] <text-content> exit-with ] >>display ;\r
\r
[ "auth-test.db" temp-file delete-file ] ignore-errors\r
\r
HELP: <text-content>
{ $values { "body" "a response body" } { "response" response } }
-{ $description "Creates a plain text response." } ;
+{ $description "Creates a response with content type " { $snippet "text/plain" } "." } ;
+
+HELP: <html-content>
+{ $values { "body" "a response body" } { "response" response } }
+{ $description "Creates a response with content type " { $snippet "text/html" } "." } ;
+
+{ <content> <text-content> <html-content> } related-words
HELP: <trivial-response>
{ $values { "code" integer } { "message" string } { "response" response } }
{ $subsections
<content>
<text-content>
+ <html-content>
}
-
-{ $vocab-link "furnace.json" } " implements " { $link <json-content> } "." $nl
"For errors:"
{ $subsections
<304>
: <text-content> ( body -- response )
"text/plain" <content> ;
-
+
+: <html-content> ( body -- response )
+ "text/html" <content> ;
+
: trivial-response-body ( code message -- )
<XML
<html>
: <trivial-response> ( code message -- response )
2dup [ trivial-response-body ] with-string-writer
- "text/html" <content>
+ <html-content>
swap >>message
swap >>code ;
\r
: list-directory ( directory -- response )\r
file-responder get allow-listings>> [\r
- directory>html "text/html" <content>\r
+ directory>html <html-content>\r
] [\r
drop <403>\r
] if ;\r
index-names>> adjoin ;\r
\r
: serve-fhtml ( path -- response )\r
- <fhtml> "text/html" <content> ;\r
+ <fhtml> <html-content> ;\r
\r
: enable-fhtml ( responder -- responder )\r
[ serve-fhtml ] "application/x-factor-server-page" pick special>> set-at\r
SINGLETON: quit-responder
M: quit-responder call-responder*
- 2drop stop-this-server "Goodbye" "text/html" <content> ;
+ 2drop stop-this-server "Goodbye" <html-content> ;
: add-quot-responder ( responder -- responder )
quit-responder "quit" add-responder ;
_ utf8 [\r
_ file-name input-stream get htmlize-stream\r
] with-file-reader\r
- ] "text/html" <content>\r
+ ] <html-content>\r
] <file-responder> ;\r
TUPLE: test-responder ;
C: <test-responder> test-responder
-M: test-responder call-responder* 2drop test-output "text/html" <content> ;
+M: test-responder call-responder* 2drop test-output <html-content> ;
: do-it ( -- )
<test-responder> main-responder set
: <hello-action> ( -- action )
<page-action>
- [ "Hello, world!" "text/plain" <content> ] >>display ;
+ [ "Hello, world!" <text-content> ] >>display ;
TUPLE: benchmark < dispatcher ;
over "/" head? [ "/" append ] unless
swap append ;
+: <javascript-content> ( body -- content )
+ "application/javascript" <content> ;
+
: do-compile-url ( url -- response )
[
absolute-url http-get nip 'expression' parse
fjsc-compile write "();" write
] with-string-writer
- "application/javascript" <content> ;
+ <javascript-content> ;
: v-local ( string -- string )
dup "http:" head? [ "Unable to compile code from remote sites" throw ] when ;
[ validate-compile-url "url" value do-compile-url ] >>display ;
: do-compile ( code -- response )
- [
+ [
'expression' parse fjsc-compile write
] with-string-writer
- "application/javascript" <content> ;
+ <javascript-content> ;
: validate-compile ( -- )
{
[
[
counter-value number>string
- "text/plain" <content>
+ <text-content>
] with-mason-db
] >>display ;
[ validate-secret ] >>validate
[
[ update-docs ] "Documentation update" spawn drop
- "OK" "text/plain" <content>
+ "OK" <text-content>
] >>submit ;
[
[
package-grid xml>string
- "text/html" <content>
+ <html-content>
] with-mason-db
] >>display ;
[
[
release-grid xml>string
- "text/html" <content>
+ <html-content>
] with-mason-db
] >>display ;
[
[
increment-counter-value
- number>string "text/plain" <content>
+ number>string <text-content>
] with-mason-db
] >>submit ;
[
[
"version" value "announcement-url" value do-release
- "OK" "text/html" <content>
+ "OK" <text-content>
] with-mason-db
] >>submit ;
[
[
current-builder last-report>>
- "text/html" <content>
+ <html-content>
] with-mason-db
] >>display ;
find-builder
[ update-builder ] [ update-tuple ] bi
] with-mason-db
- "OK" "text/plain" <content>
+ "OK" <text-content>
] >>submit ;
: <raw-paste-action> ( -- action )
<action>
[ validate-integer-id "id" value paste from-object ] >>init
- [ "contents" value "text/plain" <content> ] >>display ;
+ [ "contents" value <text-content> ] >>display ;
: <paste-feed-action> ( -- action )
<feed-action>
: <raw-annotation-action> ( -- action )
<action>
[ validate-integer-id "id" value lookup-annotation from-object ] >>init
- [ "contents" value "text/plain" <content> ] >>display ;
+ [ "contents" value <text-content> ] >>display ;
: <delete-annotation-action> ( -- action )
<action>
<action> [\r
[\r
"hello" print\r
- "text/html" <content>\r
+ <html-content>\r
] show-page\r
"byebye" print\r
[ 123 ] show-final\r
[ [ db>> ] [ seq>> ] bi ] dip with-db ;
: node-response ( id -- response )
- load-node [ node-content "text/plain" <content> ] [ <404> ] if* ;
+ load-node [ node-content <text-content> ] [ <404> ] if* ;
: display-node ( params -- response )
[
: submit-node ( params -- response )
[
"node_content" swap at* [
- create-node id>> number>string "text/plain" <content>
+ create-node id>> number>string <text-content>
] [
drop <400>
] if
C: <path-responder> path-responder
M: path-responder call-responder* ( path responder -- response )
- drop path>file [ node-content "text/plain" <content> ] [ <404> ] if* ;
+ drop path>file [ node-content <text-content> ] [ <404> ] if* ;
TUPLE: tangle-dispatcher < dispatcher tangle ;
projects / factor.git / commitdiff