From 37ee63e72d4195618cf6a82b4e3af8a48217f2ff Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 12 Nov 2007 23:26:45 -0500 Subject: [PATCH] Move http.server.responders.* to webapps.* --- extra/furnace/furnace.factor | 2 +- extra/html/html.factor | 40 ++++++ extra/http/server/server-tests.factor | 2 +- extra/http/server/server.factor | 10 +- extra/rss/reader/reader.factor | 2 +- .../article-manager/article-manager.factor | 2 +- .../callback/callback.factor | 7 +- extra/webapps/cgi/cgi.factor | 6 +- .../continuation/continuation.factor | 132 ++++++------------ .../continuation/examples/examples.factor | 7 +- .../responders => webapps}/file/file.factor | 2 +- extra/webapps/fjsc/fjsc.factor | 2 +- .../numbers/numbers.factor | 6 +- 13 files changed, 114 insertions(+), 106 deletions(-) rename extra/{http/server/responders => webapps}/callback/callback.factor (96%) rename extra/{http/server/responders => webapps}/continuation/continuation.factor (60%) rename extra/{http/server/responders => webapps}/continuation/examples/examples.factor (96%) rename extra/{http/server/responders => webapps}/file/file.factor (98%) rename extra/{http/server/responders/continuation/examples => webapps}/numbers/numbers.factor (94%) diff --git a/extra/furnace/furnace.factor b/extra/furnace/furnace.factor index 330c486817..f2ce0ddf18 100644 --- a/extra/furnace/furnace.factor +++ b/extra/furnace/furnace.factor @@ -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 diff --git a/extra/html/html.factor b/extra/html/html.factor index fe933bb659..9e98831482 100755 --- a/extra/html/html.factor +++ b/extra/html/html.factor @@ -210,3 +210,43 @@ M: html-stream stream-nl ( stream -- ) write default-css ] html-document ; + +: vertical-layout ( list -- ) + #! Given a list of HTML components, arrange them vertically. + + [ ] each +
call
; + +: horizontal-layout ( list -- ) + #! Given a list of HTML components, arrange them horizontally. + + [ ] each +
call
; + +: button ( label -- ) + #! Output an HTML submit button with the given label. + ; + +: paragraph ( str -- ) + #! Output the string as an html paragraph +

write

; + +: simple-page ( title quot -- ) + #! Call the quotation, with all output going to the + #! body of an html page with the given title. + + swap write + call + ; + +: 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. + + + rot write + swap call + + call + ; diff --git a/extra/http/server/server-tests.factor b/extra/http/server/server-tests.factor index 97fac31c69..f72e12f927 100644 --- a/extra/http/server/server-tests.factor +++ b/extra/http/server/server-tests.factor @@ -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 diff --git a/extra/http/server/server.factor b/extra/http/server/server.factor index 63a742589a..58ef587150 100644 --- a/extra/http/server/server.factor +++ b/extra/http/server/server.factor @@ -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 diff --git a/extra/rss/reader/reader.factor b/extra/rss/reader/reader.factor index 968f7fa23e..205b51b72c 100644 --- a/extra/rss/reader/reader.factor +++ b/extra/rss/reader/reader.factor @@ -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 ; diff --git a/extra/webapps/article-manager/article-manager.factor b/extra/webapps/article-manager/article-manager.factor index 22daf96724..cb999818d2 100644 --- a/extra/webapps/article-manager/article-manager.factor +++ b/extra/webapps/article-manager/article-manager.factor @@ -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 ) diff --git a/extra/http/server/responders/callback/callback.factor b/extra/webapps/callback/callback.factor similarity index 96% rename from extra/http/server/responders/callback/callback.factor rename to extra/webapps/callback/callback.factor index 6a5e32d32f..bf1ebe6648 100644 --- a/extra/http/server/responders/callback/callback.factor +++ b/extra/webapps/callback/callback.factor @@ -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. diff --git a/extra/webapps/cgi/cgi.factor b/extra/webapps/cgi/cgi.factor index bc933b0c23..3588b21bda 100644 --- a/extra/webapps/cgi/cgi.factor +++ b/extra/webapps/cgi/cgi.factor @@ -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 diff --git a/extra/http/server/responders/continuation/continuation.factor b/extra/webapps/continuation/continuation.factor similarity index 60% rename from extra/http/server/responders/continuation/continuation.factor rename to extra/webapps/continuation/continuation.factor index 601dd3700b..6b6838d89f 100644 --- a/extra/http/server/responders/continuation/continuation.factor +++ b/extra/webapps/continuation/continuation.factor @@ -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 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. write ; @@ -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. - - swap write - call - ; - -: 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. - - - rot write - swap call - - call - ; - -: paragraph ( str -- ) - #! Output the string as an html paragraph -

write

; - : show-message-page ( message -- ) #! Display the message in an HTML page with an OK button. [ "Press OK to Continue" [ - swap paragraph + swap paragraph "OK" write - ] simple-page + ] simple-page ] show 2drop ; - -: vertical-layout ( list -- ) - #! Given a list of HTML components, arrange them vertically. - - [ ] each -
call
; - -: horizontal-layout ( list -- ) - #! Given a list of HTML components, arrange them horizontally. - - [ ] each -
call
; - -: button ( label -- ) - #! Output an HTML submit button with the given label. - ; diff --git a/extra/http/server/responders/continuation/examples/examples.factor b/extra/webapps/continuation/examples/examples.factor similarity index 96% rename from extra/http/server/responders/continuation/examples/examples.factor rename to extra/webapps/continuation/examples/examples.factor index e6abcc7a72..2899562503 100644 --- a/extra/http/server/responders/continuation/examples/examples.factor +++ b/extra/webapps/continuation/examples/examples.factor @@ -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. diff --git a/extra/http/server/responders/file/file.factor b/extra/webapps/file/file.factor similarity index 98% rename from extra/http/server/responders/file/file.factor rename to extra/webapps/file/file.factor index 2f743b932d..d8fec990db 100644 --- a/extra/http/server/responders/file/file.factor +++ b/extra/webapps/file/file.factor @@ -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+ ; diff --git a/extra/webapps/fjsc/fjsc.factor b/extra/webapps/fjsc/fjsc.factor index 83f6e62c1c..2a5bb94e30 100644 --- a/extra/webapps/fjsc/fjsc.factor +++ b/extra/webapps/fjsc/fjsc.factor @@ -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 -- ) diff --git a/extra/http/server/responders/continuation/examples/numbers/numbers.factor b/extra/webapps/numbers/numbers.factor similarity index 94% rename from extra/http/server/responders/continuation/examples/numbers/numbers.factor rename to extra/webapps/numbers/numbers.factor index 84418bfdc2..59247e934c 100644 --- a/extra/http/server/responders/continuation/examples/numbers/numbers.factor +++ b/extra/webapps/numbers/numbers.factor @@ -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.