steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Move http.server.responders.* to webapps.*

release
Slava Pestov 2007-11-12 23:26:45 -05:00
parent 86a7156a35
commit 37ee63e72d
13 changed files with 114 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/furnace/furnace.factor
View File

@ -4,7 +4,7 @@ USING: kernel vectors io assocs quotations splitting strings
words sequences namespaces arrays hashtables debugger
continuations tuples classes io.files
http http.server.templating http.basic-authentication
http.server.responders.callback html html.elements
webapps.callback html html.elements
http.server.responders furnace.validator ;
IN: furnace

40
extra/html/html.factor
View File

@ -210,3 +210,43 @@ M: html-stream stream-nl ( stream -- )
<title> write </title>
default-css
] html-document ;
: vertical-layout ( list -- )
#! Given a list of HTML components, arrange them vertically.
<table>
[ <tr> <td> call </td> </tr> ] each
</table> ;
: horizontal-layout ( list -- )
#! Given a list of HTML components, arrange them horizontally.
<table>
<tr "top" =valign tr> [ <td> call </td> ] each </tr>
</table> ;
: button ( label -- )
#! Output an HTML submit button with the given label.
<input "submit" =type =value input/> ;
: paragraph ( str -- )
#! Output the string as an html paragraph
<p> write </p> ;
: simple-page ( title quot -- )
#! Call the quotation, with all output going to the
#! body of an html page with the given title.
<html>
<head> <title> swap write </title> </head>
<body> call </body>
</html> ;
: styled-page ( title stylesheet-quot quot -- )
#! Call the quotation, with all output going to the
#! body of an html page with the given title. stylesheet-quot
#! is called to generate the required stylesheet.
<html>
<head>
<title> rot write </title>
swap call
</head>
<body> call </body>
</html> ;

2
extra/http/server/server-tests.factor
View File

@ -1,4 +1,4 @@
USING: http.server.responders.file http.server.responders http
USING: webapps.file http.server.responders http
http.server namespaces io tools.test strings io.server ;
IN: temporary

10
extra/http/server/server.factor
View File

@ -2,9 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: assocs kernel namespaces io strings splitting
threads http http.server.responders sequences prettyprint
io.server http.server.responders.file
http.server.responders.callback
http.server.responders.continuation ;
io.server ;
IN: http.server
@ -63,3 +61,9 @@ IN: http.server
: httpd-main ( -- ) 8888 httpd ;
MAIN: httpd-main
! Load default webapps
USE: webapps.file
USE: webapps.callback
USE: webapps.continuation
USE: webapps.cgi

2
extra/rss/reader/reader.factor
View File

@ -11,7 +11,7 @@
IN: rss.reader
USING: kernel html namespaces sequences io quotations
assocs sqlite.tuple-db sqlite io.files html.elements
rss http.server.responders.continuation ;
rss webapps.continuation ;
TUPLE: reader-feed url title link ;

2
extra/webapps/article-manager/article-manager.factor
View File

@ -4,7 +4,7 @@
USING: kernel furnace sqlite.tuple-db webapps.article-manager.database
sequences namespaces math arrays assocs quotations io.files
http.server http.basic-authentication http.server.responders
http.server.responders.file ;
webapps.file ;
IN: webapps.article-manager
: current-site ( -- site )

7
extra/http/server/responders/callback/callback.factor → extra/webapps/callback/callback.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2004 Chris Double.
! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: html http http.server.responders io kernel math namespaces
prettyprint continuations random system sequences assocs ;
IN: http.server.responders.callback
USING: html http http.server.responders io kernel math
namespaces prettyprint continuations random system sequences
assocs ;
IN: webapps.callback
#! Name of the variable holding the continuation used to exit
#! back to the httpd responder.

6
extra/webapps/cgi/cgi.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces kernel assocs io.files combinators
arrays io.launcher io http.server http.server.responders
http.server.responders.file sequences strings ;
webapps.file sequences strings ;
IN: webapps.cgi
SYMBOL: cgi-root
@ -67,4 +67,6 @@ SYMBOL: cgi-root
{ [ t ] [ (do-cgi) ] }
} cond ;
"cgi" [ "argument" get do-cgi ] add-simple-responder
global [
"cgi" [ "argument" get do-cgi ] add-simple-responder
] bind

132
extra/http/server/responders/continuation/continuation.factor → extra/webapps/continuation/continuation.factor
View File

@ -1,10 +1,10 @@
! Copyright (C) 2004 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: http math namespaces io strings kernel html html.elements
hashtables continuations quotations parser generic
sequences http.server.responders.callback http.server.responders ;
IN: http.server.responders.continuation
USING: http math namespaces io strings kernel html html.elements
hashtables continuations quotations parser generic sequences
webapps.callback http.server.responders ;
IN: webapps.continuation
#! Used inside the session state of responders to indicate whether the
#! next request should use the post-refresh-get pattern. It is set to
@ -12,7 +12,7 @@ IN: http.server.responders.continuation
SYMBOL: post-refresh-get?
: >callable ( quot|interp|f -- interp )
dup continuation? [
dup continuation? [
[ continue ] curry
] when ;
@ -20,7 +20,7 @@ SYMBOL: post-refresh-get?
#! When executed inside a 'show' call, this will force a
#! HTTP 302 to occur to instruct the browser to forward to
#! the request URL.
[
[
"HTTP/1.1 302 Document Moved\nLocation: " % %
"\nContent-Length: 0\nContent-Type: text/plain\n\n" %
] "" make write exit-continuation get continue ;
@ -34,51 +34,51 @@ SYMBOL: post-refresh-get?
SYMBOL: current-show
: store-current-show ( -- )
#! Store the current continuation in the variable 'current-show'
#! Store the current continuation in the variable 'current-show'
#! so it can be returned to later by href callbacks. Note that it
#! recalls itself when the continuation is called to ensure that
#! it resets its value back to the most recent show call.
[ ( 0 -- )
[ ( 0 1 -- )
current-show set ( 0 -- )
continue
] callcc1 ! 0 [ ] ==
nip
restore-request
call
store-current-show
[ ( 0 1 -- )
current-show set ( 0 -- )
continue
] callcc1
nip
restore-request
call
store-current-show
] callcc0 restore-request ;
: redirect-to-here ( -- )
#! Force a redirect to the client browser so that the browser
#! goes to the current point in the code. This forces an URL
#! change on the browser so that refreshing that URL will
#! immediately run from this code point. This prevents the
#! "this request will issue a POST" warning from the browser
#! and prevents re-running the previous POST logic. This is
#! known as the 'post-refresh-get' pattern.
post-refresh-get? get [
[
>callable t register-callback forward-to-url
] callcc0 restore-request
] [
t post-refresh-get? set
] if ;
#! Force a redirect to the client browser so that the browser
#! goes to the current point in the code. This forces an URL
#! change on the browser so that refreshing that URL will
#! immediately run from this code point. This prevents the
#! "this request will issue a POST" warning from the browser
#! and prevents re-running the previous POST logic. This is
#! known as the 'post-refresh-get' pattern.
post-refresh-get? get [
[
>callable t register-callback forward-to-url
] callcc0 restore-request
] [
t post-refresh-get? set
] if ;
: (show) ( quot -- hashtable )
#! See comments for show. The difference is the
: (show) ( quot -- hashtable )
#! See comments for show. The difference is the
#! quotation MUST set the content-type using 'serving-html'
#! or similar.
store-current-show redirect-to-here
[
>callable t register-callback swap with-scope
[
>callable t register-callback swap with-scope
exit-continuation get continue
] callcc0 drop restore-request "response" get ;
: show ( quot -- namespace )
: show ( quot -- namespace )
#! Call the quotation with the URL associated with the current
#! continuation. All output from the quotation goes to the client
#! browser. When the URL is later referenced then
#! browser. When the URL is later referenced then
#! computation will resume from this 'show' call with a hashtable on
#! the stack containing any query or post parameters.
#! 'quot' has stack effect ( url -- )
@ -88,7 +88,7 @@ SYMBOL: current-show
[ serving-html ] swap append (show) ;
: (show-final) ( quot -- namespace )
#! See comments for show-final. The difference is the
#! See comments for show-final. The difference is the
#! quotation MUST set the content-type using 'serving-html'
#! or similar.
store-current-show redirect-to-here
@ -102,17 +102,17 @@ SYMBOL: current-show
#! use is an optimisation to save having to generate and save a continuation
#! in that special case.
#! 'quot' has stack effect ( -- ).
[ serving-html ] swap append (show-final) ;
[ serving-html ] swap compose (show-final) ;
#! Name of variable for holding initial continuation id that starts
#! the responder.
SYMBOL: root-callback
: cont-get/post-responder ( id-or-f -- )
: cont-get/post-responder ( id-or-f -- )
#! httpd responder that handles the root continuation request.
#! The requests for actual continuation are processed by the
#! 'callback-responder'.
[
[
[ f post-refresh-get? set <request> request set root-callback get call ] with-scope
exit-continuation get continue
] with-exit-continuation drop ;
@ -124,7 +124,7 @@ SYMBOL: root-callback
#! Write to standard output an HTML HREF where the href,
#! when referenced, will call the quotation and then return
#! back to the most recent 'show' call (via the callback-cc).
#! The text of the link will be the 'text' argument on the
#! The text of the link will be the 'text' argument on the
#! stack.
<a quot-url =href a> write </a> ;
@ -134,58 +134,18 @@ SYMBOL: root-callback
#!
#! Convert the quotation so it is run within a session namespace
#! and that namespace is initialized first.
[
[ cont-get/post-responder ] "get" set
[ cont-get/post-responder ] "post" set
[
[ cont-get/post-responder ] "get" set
[ cont-get/post-responder ] "post" set
swap "responder" set
root-callback set
root-callback set
] make-responder ;
: simple-page ( title quot -- )
#! Call the quotation, with all output going to the
#! body of an html page with the given title.
<html>
<head> <title> swap write </title> </head>
<body> call </body>
</html> ;
: styled-page ( title stylesheet-quot quot -- )
#! Call the quotation, with all output going to the
#! body of an html page with the given title. stylesheet-quot
#! is called to generate the required stylesheet.
<html>
<head>
<title> rot write </title>
swap call
</head>
<body> call </body>
</html> ;
: paragraph ( str -- )
#! Output the string as an html paragraph
<p> write </p> ;
: show-message-page ( message -- )
#! Display the message in an HTML page with an OK button.
[
"Press OK to Continue" [
swap paragraph
swap paragraph
<a =href a> "OK" write </a>
] simple-page
] simple-page
] show 2drop ;
: vertical-layout ( list -- )
#! Given a list of HTML components, arrange them vertically.
<table>
[ <tr> <td> call </td> </tr> ] each
</table> ;
: horizontal-layout ( list -- )
#! Given a list of HTML components, arrange them horizontally.
<table>
<tr "top" =valign tr> [ <td> call </td> ] each </tr>
</table> ;
: button ( label -- )
#! Output an HTML submit button with the given label.
<input "submit" =type =value input/> ;

7
extra/http/server/responders/continuation/examples/examples.factor → extra/webapps/continuation/examples/examples.factor
View File

@ -22,10 +22,11 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!
! Simple test applications
USING: hashtables html kernel io html html.elements strings math assocs quotations
http.server.responders.continuation namespaces prettyprint sequences ;
USING: hashtables html kernel io html html.elements strings math
assocs quotations webapps.continuation namespaces prettyprint
sequences ;
IN: http.server.responders.continuation.examples
IN: webapps.continuation.examples
: display-page ( title -- )
#! Display a page with some text to test the cont-responder.

2
extra/http/server/responders/file/file.factor → extra/webapps/file/file.factor
View File

@ -5,7 +5,7 @@ http.server.responders http.server.templating namespaces parser
sequences strings assocs hashtables debugger http.mime sorting
html.elements ;
IN: http.server.responders.file
IN: webapps.file
: serving-path ( filename -- filename )
"" or "doc-root" get swap path+ ;

2
extra/webapps/fjsc/fjsc.factor
View File

@ -4,7 +4,7 @@
USING: kernel furnace fjsc parser-combinators namespaces
lazy-lists io io.files furnace.validator sequences
http.client http.server http.server.responders
http.server.responders.file ;
webapps.file ;
IN: webapps.fjsc
: compile ( code -- )

6
extra/http/server/responders/continuation/examples/numbers/numbers.factor → extra/webapps/numbers/numbers.factor
View File

@ -31,10 +31,10 @@
! to use HTML. The remaining code was untouched.
!
! The result is not that pretty but it shows the basic idea.
USING: kernel math parser html html.elements io namespaces math.parser
random http.server.responders.continuation ;
USING: kernel math parser html html.elements io namespaces
math.parser random webapps.continuation ;
IN: http.server.responders.continuation.examples.numbers
IN: webapps.numbers
: web-print ( str -- )
#! Display the string in a web page.