cont-responder: move to furnace.callbacks to match IN: declaration.

diff --git a/cont-responder/callbacks-tests.factor b/cont-responder/callbacks-tests.factor
deleted file mode 100644 (file)
index f9302de..0000000
--- a/cont-responder/callbacks-tests.factor
+++ /dev/null
@@ -1,67 +0,0 @@
-USING: furnace furnace.actions furnace.callbacks accessors
-http http.server http.server.responses tools.test
-namespaces io fry sequences
-splitting kernel hashtables continuations ;
-IN: furnace.callbacks.tests
-
-[ 123 ] [
-    [
-        <request> "GET" >>method init-request
-        [
-            exit-continuation set
-            { }
-            <action> [ [ "hello" print 123 ] show-final ] >>display
-            <callback-responder>
-            call-responder
-        ] callcc1
-    ] with-scope
-] unit-test
-
-[
-    <action> [
-        [
-            "hello" print
-            <html-content>
-        ] show-page
-        "byebye" print
-        [ 123 ] show-final
-    ] >>display
-    <callback-responder> "r" set
-
-    [ 123 ] [
-        <request> init-request
-
-        [
-            exit-continuation set
-            <request> "GET" >>method init-request
-            { } "r" get call-responder
-        ] callcc1
-
-        body>> first
-
-        <request>
-            "GET" >>method
-            dup url>> rot cont-id associate >>query drop
-            dup url>> "/" >>path drop
-        init-request
-
-        [
-            exit-continuation set
-            { }
-            "r" get call-responder
-        ] callcc1
-
-        ! get-post-get
-        <request>
-            "GET" >>method
-            dup url>> rot "location" header query>> >>query drop
-            dup url>> "/" >>path drop
-        init-request
-
-        [
-            exit-continuation set
-            { }
-            "r" get call-responder
-        ] callcc1
-    ] unit-test
-] with-scope

diff --git a/cont-responder/callbacks.factor b/cont-responder/callbacks.factor
deleted file mode 100644 (file)
index 088ae6d..0000000
--- a/cont-responder/callbacks.factor
+++ /dev/null
@@ -1,122 +0,0 @@
-! Copyright (C) 2004 Chris Double.
-! Copyright (C) 2006, 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: http http.server io kernel math namespaces
-continuations calendar sequences assocs hashtables
-accessors arrays alarms quotations combinators fry
-http.server.redirection furnace assocs.lib urls ;
-IN: furnace.callbacks
-
-SYMBOL: responder
-
-TUPLE: callback-responder responder callbacks ;
-
-: <callback-responder> ( responder -- responder' )
-    H{ } clone callback-responder boa ;
-
-TUPLE: callback cont quot expires alarm responder ;
-
-: timeout 20 minutes ;
-
-: timeout-callback ( callback -- )
-    [ alarm>> cancel-alarm ]
-    [ dup responder>> callbacks>> delete-at ]
-    bi ;
-
-: touch-callback ( callback -- )
-    dup expires>> [
-        dup alarm>> [ cancel-alarm ] when*
-        dup '[ , timeout-callback ] timeout later >>alarm
-    ] when drop ;
-
-: <callback> ( cont quot expires? -- callback )
-    f callback-responder get callback boa
-    dup touch-callback ;
-
-: invoke-callback ( callback -- response )
-    [ touch-callback ]
-    [ quot>> request get exit-continuation get 3array ]
-    [ cont>> continue-with ]
-    tri ;
-
-: register-callback ( cont quot expires? -- id )
-    <callback> callback-responder get callbacks>> set-at-unique ;
-
-: forward-to-url ( url -- * )
-    ! When executed inside a 'show' call, this will force a
-    ! HTTP 302 to occur to instruct the browser to forward to
-    ! the request URL.
-    <temporary-redirect> exit-with ;
-
-: cont-id "factorcontid" ;
-
-: forward-to-id ( id -- * )
-    ! When executed inside a 'show' call, this will force a
-    ! HTTP 302 to occur to instruct the browser to forward to
-    ! the request URL.
-    <url>
-        swap cont-id set-query-param forward-to-url ;
-
-: restore-request ( pair -- )
-    first3 exit-continuation set request set call ;
-
-SYMBOL: post-refresh-get?
-
-: 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 [
-        [
-            [ ] t register-callback forward-to-id
-        ] callcc1 restore-request
-    ] [
-        post-refresh-get? on
-    ] if ;
-
-SYMBOL: current-show
-
-: store-current-show ( -- )
-    ! Store the current continuation in the variable 'current-show'
-    ! so it can be returned to later by 'quot-id'. Note that it
-    ! recalls itself when the continuation is called to ensure that
-    ! it resets its value back to the most recent show call.
-    [ current-show set f ] callcc1
-    [ restore-request store-current-show ] when* ;
-
-: show-final ( quot -- * )
-    [ redirect-to-here store-current-show ] dip
-    call exit-with ; inline
-
-: resuming-callback ( responder request -- id )
-    url>> cont-id query-param swap callbacks>> at ;
-
-M: callback-responder call-responder* ( path responder -- response )
-    '[
-        , ,
-
-        [ callback-responder set ]
-        [ request get resuming-callback ] bi
-
-        [
-            invoke-callback
-        ] [
-            callback-responder get responder>> call-responder
-        ] ?if
-    ] with-exit-continuation ;
-
-: show-page ( quot -- )
-    [ redirect-to-here store-current-show ] dip
-    [
-        [ ] t register-callback swap call exit-with
-    ] callcc1 restore-request ; inline
-
-: quot-id ( quot -- id )
-    current-show get swap t register-callback ;
-
-: quot-url ( quot -- url )
-    quot-id f swap cont-id associate derive-url ;

diff --git a/furnace/callbacks/callbacks-tests.factor b/furnace/callbacks/callbacks-tests.factor
new file mode 100644 (file)
index 0000000..f9302de
--- /dev/null
+++ b/furnace/callbacks/callbacks-tests.factor
@@ -0,0 +1,67 @@
+USING: furnace furnace.actions furnace.callbacks accessors
+http http.server http.server.responses tools.test
+namespaces io fry sequences
+splitting kernel hashtables continuations ;
+IN: furnace.callbacks.tests
+
+[ 123 ] [
+    [
+        <request> "GET" >>method init-request
+        [
+            exit-continuation set
+            { }
+            <action> [ [ "hello" print 123 ] show-final ] >>display
+            <callback-responder>
+            call-responder
+        ] callcc1
+    ] with-scope
+] unit-test
+
+[
+    <action> [
+        [
+            "hello" print
+            <html-content>
+        ] show-page
+        "byebye" print
+        [ 123 ] show-final
+    ] >>display
+    <callback-responder> "r" set
+
+    [ 123 ] [
+        <request> init-request
+
+        [
+            exit-continuation set
+            <request> "GET" >>method init-request
+            { } "r" get call-responder
+        ] callcc1
+
+        body>> first
+
+        <request>
+            "GET" >>method
+            dup url>> rot cont-id associate >>query drop
+            dup url>> "/" >>path drop
+        init-request
+
+        [
+            exit-continuation set
+            { }
+            "r" get call-responder
+        ] callcc1
+
+        ! get-post-get
+        <request>
+            "GET" >>method
+            dup url>> rot "location" header query>> >>query drop
+            dup url>> "/" >>path drop
+        init-request
+
+        [
+            exit-continuation set
+            { }
+            "r" get call-responder
+        ] callcc1
+    ] unit-test
+] with-scope

diff --git a/furnace/callbacks/callbacks.factor b/furnace/callbacks/callbacks.factor
new file mode 100644 (file)
index 0000000..088ae6d
--- /dev/null
+++ b/furnace/callbacks/callbacks.factor
@@ -0,0 +1,122 @@
+! Copyright (C) 2004 Chris Double.
+! Copyright (C) 2006, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: http http.server io kernel math namespaces
+continuations calendar sequences assocs hashtables
+accessors arrays alarms quotations combinators fry
+http.server.redirection furnace assocs.lib urls ;
+IN: furnace.callbacks
+
+SYMBOL: responder
+
+TUPLE: callback-responder responder callbacks ;
+
+: <callback-responder> ( responder -- responder' )
+    H{ } clone callback-responder boa ;
+
+TUPLE: callback cont quot expires alarm responder ;
+
+: timeout 20 minutes ;
+
+: timeout-callback ( callback -- )
+    [ alarm>> cancel-alarm ]
+    [ dup responder>> callbacks>> delete-at ]
+    bi ;
+
+: touch-callback ( callback -- )
+    dup expires>> [
+        dup alarm>> [ cancel-alarm ] when*
+        dup '[ , timeout-callback ] timeout later >>alarm
+    ] when drop ;
+
+: <callback> ( cont quot expires? -- callback )
+    f callback-responder get callback boa
+    dup touch-callback ;
+
+: invoke-callback ( callback -- response )
+    [ touch-callback ]
+    [ quot>> request get exit-continuation get 3array ]
+    [ cont>> continue-with ]
+    tri ;
+
+: register-callback ( cont quot expires? -- id )
+    <callback> callback-responder get callbacks>> set-at-unique ;
+
+: forward-to-url ( url -- * )
+    ! When executed inside a 'show' call, this will force a
+    ! HTTP 302 to occur to instruct the browser to forward to
+    ! the request URL.
+    <temporary-redirect> exit-with ;
+
+: cont-id "factorcontid" ;
+
+: forward-to-id ( id -- * )
+    ! When executed inside a 'show' call, this will force a
+    ! HTTP 302 to occur to instruct the browser to forward to
+    ! the request URL.
+    <url>
+        swap cont-id set-query-param forward-to-url ;
+
+: restore-request ( pair -- )
+    first3 exit-continuation set request set call ;
+
+SYMBOL: post-refresh-get?
+
+: 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 [
+        [
+            [ ] t register-callback forward-to-id
+        ] callcc1 restore-request
+    ] [
+        post-refresh-get? on
+    ] if ;
+
+SYMBOL: current-show
+
+: store-current-show ( -- )
+    ! Store the current continuation in the variable 'current-show'
+    ! so it can be returned to later by 'quot-id'. Note that it
+    ! recalls itself when the continuation is called to ensure that
+    ! it resets its value back to the most recent show call.
+    [ current-show set f ] callcc1
+    [ restore-request store-current-show ] when* ;
+
+: show-final ( quot -- * )
+    [ redirect-to-here store-current-show ] dip
+    call exit-with ; inline
+
+: resuming-callback ( responder request -- id )
+    url>> cont-id query-param swap callbacks>> at ;
+
+M: callback-responder call-responder* ( path responder -- response )
+    '[
+        , ,
+
+        [ callback-responder set ]
+        [ request get resuming-callback ] bi
+
+        [
+            invoke-callback
+        ] [
+            callback-responder get responder>> call-responder
+        ] ?if
+    ] with-exit-continuation ;
+
+: show-page ( quot -- )
+    [ redirect-to-here store-current-show ] dip
+    [
+        [ ] t register-callback swap call exit-with
+    ] callcc1 restore-request ; inline
+
+: quot-id ( quot -- id )
+    current-show get swap t register-callback ;
+
+: quot-url ( quot -- url )
+    quot-id f swap cont-id associate derive-url ;