From 8e55533bfa912a8f082c7ee26ef8d4e8a68ddc2f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 15 Mar 2009 18:19:29 -0500 Subject: [PATCH 1/7] Tweak some furnace code to infer and load with almost no warnings --- basis/db/db.factor | 2 +- basis/furnace/actions/actions.factor | 16 ++++++++-------- basis/furnace/auth/login/login.factor | 2 +- basis/furnace/boilerplate/boilerplate.factor | 6 +++--- basis/furnace/referrer/referrer.factor | 6 +++--- basis/furnace/utilities/utilities.factor | 2 +- basis/html/forms/forms.factor | 6 +++--- basis/html/templates/templates.factor | 6 +++--- basis/http/server/static/static-docs.factor | 2 +- basis/http/server/static/static.factor | 10 ++++++---- basis/inverse/inverse.factor | 4 ++-- basis/io/servers/connection/connection.factor | 6 +++--- basis/logging/analysis/analysis.factor | 2 +- basis/logging/logging.factor | 2 +- 14 files changed, 37 insertions(+), 35 deletions(-) diff --git a/basis/db/db.factor b/basis/db/db.factor index 96b72b8865..bd523b38e6 100644 --- a/basis/db/db.factor +++ b/basis/db/db.factor @@ -149,4 +149,4 @@ M: db-connection rollback-transaction ( -- ) "ROLLBACK" sql-command ; t in-transaction [ begin-transaction [ ] [ rollback-transaction ] cleanup commit-transaction - ] with-variable ; + ] with-variable ; inline diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor index 166d2a88a2..b0814db4dd 100644 --- a/basis/furnace/actions/actions.factor +++ b/basis/furnace/actions/actions.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors sequences kernel assocs combinators validators http hashtables namespaces fry continuations locals -io arrays math boxes splitting urls +io arrays math boxes splitting urls call xml.entities http.server http.server.responses @@ -52,10 +52,10 @@ TUPLE: action rest init authorize display validate submit ; '[ _ dup display>> [ { - [ init>> call ] - [ authorize>> call ] + [ init>> call( -- ) ] + [ authorize>> call( -- ) ] [ drop restore-validation-errors ] - [ display>> call ] + [ display>> call( -- response ) ] } cleave ] [ drop <400> ] if ] with-exit-continuation ; @@ -81,9 +81,9 @@ CONSTANT: revalidate-url-key "__u" : handle-post ( action -- response ) '[ _ dup submit>> [ - [ validate>> call ] - [ authorize>> call ] - [ submit>> call ] + [ validate>> call( -- ) ] + [ authorize>> call( -- ) ] + [ submit>> call( -- response ) ] tri ] [ drop <400> ] if ] with-exit-continuation ; diff --git a/basis/furnace/auth/login/login.factor b/basis/furnace/auth/login/login.factor index 915ae1c224..9c3d316d03 100644 --- a/basis/furnace/auth/login/login.factor +++ b/basis/furnace/auth/login/login.factor @@ -53,7 +53,7 @@ M: login-realm modify-form ( responder -- ) \ successful-login DEBUG add-input-logging -: logout ( -- ) +: logout ( -- response ) permit-id get [ delete-permit ] when* URL" $realm" end-aside ; diff --git a/basis/furnace/boilerplate/boilerplate.factor b/basis/furnace/boilerplate/boilerplate.factor index 95e93f2ee8..84b29bf831 100644 --- a/basis/furnace/boilerplate/boilerplate.factor +++ b/basis/furnace/boilerplate/boilerplate.factor @@ -1,6 +1,6 @@ -! Copyright (c) 2008 Slava Pestov +! Copyright (c) 2008, 2009 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel math.order namespaces combinators.short-circuit +USING: accessors kernel math.order namespaces combinators.short-circuit call html.forms html.templates html.templates.chloe @@ -23,7 +23,7 @@ TUPLE: boilerplate < filter-responder template init ; M:: boilerplate call-responder* ( path responder -- ) begin-form path responder call-next-method - responder init>> call + responder init>> call( -- ) dup wrap-boilerplate? [ clone [| body | [ diff --git a/basis/furnace/referrer/referrer.factor b/basis/furnace/referrer/referrer.factor index e5666c2698..acd4563cd6 100644 --- a/basis/furnace/referrer/referrer.factor +++ b/basis/furnace/referrer/referrer.factor @@ -1,7 +1,7 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel http.server http.server.filters -http.server.responses furnace.utilities ; +http.server.responses furnace.utilities call ; IN: furnace.referrer TUPLE: referrer-check < filter-responder quot ; @@ -9,7 +9,7 @@ TUPLE: referrer-check < filter-responder quot ; C: referrer-check M: referrer-check call-responder* - referrer over quot>> call + referrer over quot>> call( referrer -- ? ) [ call-next-method ] [ 2drop 403 "Bad referrer" ] if ; diff --git a/basis/furnace/utilities/utilities.factor b/basis/furnace/utilities/utilities.factor index c0cb7dbced..a43466489c 100755 --- a/basis/furnace/utilities/utilities.factor +++ b/basis/furnace/utilities/utilities.factor @@ -135,4 +135,4 @@ SYMBOL: exit-continuation exit-continuation get continue-with ; : with-exit-continuation ( quot -- value ) - '[ exit-continuation set @ ] callcc1 exit-continuation off ; + '[ exit-continuation set @ ] callcc1 exit-continuation off ; inline diff --git a/basis/html/forms/forms.factor b/basis/html/forms/forms.factor index d5c744beab..4cab87acfa 100644 --- a/basis/html/forms/forms.factor +++ b/basis/html/forms/forms.factor @@ -1,6 +1,6 @@ -! Copyright (C) 2008 Slava Pestov +! Copyright (C) 2008, 2009 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: kernel accessors strings namespaces assocs hashtables io +USING: kernel accessors strings namespaces assocs hashtables io call mirrors math fry sequences words continuations xml.entities xml.writer xml.syntax ; IN: html.forms @@ -96,7 +96,7 @@ C: validation-error >hashtable "validators" set-word-prop ; : validate ( value quot -- result ) - [ ] recover ; inline + '[ _ call( value -- validated ) ] [ ] recover ; : validate-value ( name value quot -- ) validate diff --git a/basis/html/templates/templates.factor b/basis/html/templates/templates.factor index 4a416e353f..fcb1b28b1a 100644 --- a/basis/html/templates/templates.factor +++ b/basis/html/templates/templates.factor @@ -1,8 +1,8 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel fry io io.encodings.utf8 io.files debugger prettyprint continuations namespaces boxes sequences -arrays strings html io.streams.string assocs +arrays strings html io.streams.string assocs call quotations xml.data xml.writer xml.syntax ; IN: html.templates @@ -12,7 +12,7 @@ GENERIC: call-template* ( template -- ) M: string call-template* write ; -M: callable call-template* call ; +M: callable call-template* call( -- ) ; M: xml call-template* write-xml ; diff --git a/basis/http/server/static/static-docs.factor b/basis/http/server/static/static-docs.factor index bbad56a6f1..b453e7ff10 100644 --- a/basis/http/server/static/static-docs.factor +++ b/basis/http/server/static/static-docs.factor @@ -20,7 +20,7 @@ HELP: enable-fhtml { $side-effects "responder" } ; ARTICLE: "http.server.static.extend" "Hooks for dynamic content" -"The static responder can be extended for dynamic content by associating quotations with MIME types in the hashtable stored in the " { $slot "special" } " slot. The quotations have stack effect " { $snippet "( path -- )" } "." +"The static responder can be extended for dynamic content by associating quotations with MIME types in the hashtable stored in the " { $slot "special" } " slot. The quotations have stack effect " { $snippet "( path -- response )" } "." $nl "A utility word uses the above feature to enable server-side " { $snippet ".fhtml" } " scripts, allowing a development style much like PHP:" { $subsection enable-fhtml } diff --git a/basis/http/server/static/static.factor b/basis/http/server/static/static.factor index 5d5ad7d2b8..13b9efc86d 100644 --- a/basis/http/server/static/static.factor +++ b/basis/http/server/static/static.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2004, 2008 Slava Pestov. +! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: calendar kernel math math.order math.parser namespaces parser sequences strings assocs hashtables debugger mime.types @@ -6,7 +6,7 @@ sorting logging calendar.format accessors splitting io io.files io.files.info io.directories io.pathnames io.encodings.binary fry xml.entities destructors urls html xml.syntax html.templates.fhtml http http.server http.server.responses -http.server.redirection xml.writer ; +http.server.redirection xml.writer call ; IN: http.server.static TUPLE: file-responder root hook special allow-listings ; @@ -42,7 +42,9 @@ TUPLE: file-responder root hook special allow-listings ; : serve-static ( filename mime-type -- response ) over modified-since? - [ file-responder get hook>> call ] [ 2drop <304> ] if ; + [ file-responder get hook>> call( filename mime-type -- response ) ] + [ 2drop <304> ] + if ; : serving-path ( filename -- filename ) [ file-responder get root>> trim-tail-separators "/" ] dip @@ -51,7 +53,7 @@ TUPLE: file-responder root hook special allow-listings ; : serve-file ( filename -- response ) dup mime-type dup file-responder get special>> at - [ call ] [ serve-static ] ?if ; + [ call( filename -- response ) ] [ serve-static ] ?if ; \ serve-file NOTICE add-input-logging diff --git a/basis/inverse/inverse.factor b/basis/inverse/inverse.factor index 1006e45e77..9dc79e91b5 100755 --- a/basis/inverse/inverse.factor +++ b/basis/inverse/inverse.factor @@ -5,7 +5,7 @@ sequences assocs math arrays stack-checker effects generalizations continuations debugger classes.tuple namespaces make vectors bit-arrays byte-arrays strings sbufs math.functions macros sequences.private combinators mirrors splitting -combinators.short-circuit fry words.symbol generalizations ; +combinators.short-circuit fry words.symbol generalizations call ; RENAME: _ fry => __ IN: inverse @@ -122,7 +122,7 @@ M: math-inverse inverse M: pop-inverse inverse [ "pop-length" word-prop cut-slice swap >quotation ] - [ "pop-inverse" word-prop ] bi compose call ; + [ "pop-inverse" word-prop ] bi compose call( -- quot ) ; : (undo) ( revquot -- ) [ unclip-slice inverse % (undo) ] unless-empty ; diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor index 589a50d2eb..5a3233afa9 100644 --- a/basis/io/servers/connection/connection.factor +++ b/basis/io/servers/connection/connection.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2003, 2008 Slava Pestov. +! Copyright (C) 2003, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: continuations destructors kernel math math.parser namespaces parser sequences strings prettyprint @@ -7,7 +7,7 @@ fry accessors arrays io io.sockets io.encodings.ascii io.sockets.secure io.files io.streams.duplex io.timeouts io.encodings threads make concurrency.combinators concurrency.semaphores concurrency.flags -combinators.short-circuit ; +combinators.short-circuit call ; IN: io.servers.connection TUPLE: threaded-server @@ -69,7 +69,7 @@ GENERIC: handle-client* ( threaded-server -- ) [ [ remote-address set ] [ local-address set ] bi* ] 2bi ; -M: threaded-server handle-client* handler>> call ; +M: threaded-server handle-client* handler>> call( -- ) ; : handle-client ( client remote local -- ) '[ diff --git a/basis/logging/analysis/analysis.factor b/basis/logging/analysis/analysis.factor index 24810a6c3e..0ba98996b3 100644 --- a/basis/logging/analysis/analysis.factor +++ b/basis/logging/analysis/analysis.factor @@ -41,7 +41,7 @@ SYMBOL: message-histogram [ >alist sort-values ] dip [ [ swapd with-cell pprint-cell ] with-row ] curry assoc-each - ] tabular-output ; + ] tabular-output ; inline : log-entry. ( entry -- ) "====== " write diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor index e295960baa..c8413c14fe 100644 --- a/basis/logging/logging.factor +++ b/basis/logging/logging.factor @@ -80,7 +80,7 @@ ERROR: bad-log-message-parameters msg word level ; PRIVATE> : (define-logging) ( word level quot -- ) - [ dup ] 2dip 2curry annotate ; + [ dup ] 2dip 2curry annotate ; inline : call-logging-quot ( quot word level -- quot' ) [ "called" ] 2dip [ log-message ] 3curry prepose ; From 0d38d2f7e82a05df5d9d9c56ffd9f93efbac7b0b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 15 Mar 2009 18:28:46 -0500 Subject: [PATCH 2/7] Fix more stack effects --- basis/http/server/server.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor index f2f3deead2..d7f6f1841a 100755 --- a/basis/http/server/server.factor +++ b/basis/http/server/server.factor @@ -132,15 +132,15 @@ M: response write-full-response ( request response -- ) [ content-charset>> encode-output ] [ write-response-body ] bi - ] unless ; + ] unless drop ; M: raw-response write-response ( respose -- ) write-response-line write-response-body drop ; -M: raw-response write-full-response ( response -- ) - write-response ; +M: raw-response write-full-response ( request response -- ) + nip write-response ; : post-request? ( -- ? ) request get method>> "POST" = ; @@ -182,7 +182,7 @@ main-responder [ <404> ] initialize swap development? get [ make-http-error >>body ] [ drop ] if ; : do-response ( response -- ) - [ request get swap write-full-response ] + '[ request get _ write-full-response ] [ [ \ do-response log-error ] [ From 943f0ee10f469acc9f487f8591d6c99e59e925fc Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 15 Mar 2009 18:33:29 -0500 Subject: [PATCH 3/7] Add test cases for problem with moving mixin instances and methods between vocabularies --- core/classes/mixin/mixin-tests.factor | 10 ++++++++++ core/generic/generic-tests.factor | 14 +++++++++++++- 2 files changed, 23 insertions(+), 1 deletion(-) diff --git a/core/classes/mixin/mixin-tests.factor b/core/classes/mixin/mixin-tests.factor index 9a372e633e..376eace4ed 100644 --- a/core/classes/mixin/mixin-tests.factor +++ b/core/classes/mixin/mixin-tests.factor @@ -109,3 +109,13 @@ TUPLE: flat-mx-2-1 ; INSTANCE: flat-mx-2-1 flat-mx-2 MIXIN: empty-mixin [ f ] [ "hi" empty-mixin? ] unit-test + +MIXIN: move-instance-declaration-mixin + +[ ] [ "IN: classes.mixin.tests.a USE: strings USE: classes.mixin.tests INSTANCE: string move-instance-declaration-mixin" "move-mixin-test-1" parse-stream drop ] unit-test + +[ ] [ "IN: classes.mixin.tests.b USE: strings USE: classes.mixin.tests INSTANCE: string move-instance-declaration-mixin" "move-mixin-test-2" parse-stream drop ] unit-test + +[ ] [ "IN: classes.mixin.tests.a" "move-mixin-test-1" parse-stream drop ] unit-test + +[ { string } ] [ move-instance-declaration-mixin members ] unit-test \ No newline at end of file diff --git a/core/generic/generic-tests.factor b/core/generic/generic-tests.factor index 5465ee1b27..db404f4850 100755 --- a/core/generic/generic-tests.factor +++ b/core/generic/generic-tests.factor @@ -2,7 +2,8 @@ USING: accessors alien arrays definitions generic generic.standard generic.math assocs hashtables io kernel math namespaces parser prettyprint sequences strings tools.test vectors words quotations classes classes.algebra classes.tuple continuations -layouts classes.union sorting compiler.units eval multiline ; +layouts classes.union sorting compiler.units eval multiline +io.streams.string ; IN: generic.tests GENERIC: foobar ( x -- y ) @@ -236,3 +237,14 @@ M: number c-n-m-cache ; [ ] [ [ { integer c-n-m-cache } forget ] with-compilation-unit ] unit-test [ 2 ] [ 2 c-n-m-cache ] unit-test + +! Moving a method from one vocab to another doesn't always work +GENERIC: move-method-generic ( a -- b ) + +[ ] [ "IN: generic.tests.a USE: strings USE: generic.tests M: string move-method-generic ;" "move-method-test-1" parse-stream drop ] unit-test + +[ ] [ "IN: generic.tests.b USE: strings USE: generic.tests M: string move-method-generic ;" "move-method-test-2" parse-stream drop ] unit-test + +[ ] [ "IN: generic.tests.a" "move-method-test-1" parse-stream drop ] unit-test + +[ { string } ] [ move-method-generic order ] unit-test \ No newline at end of file From 54e824ffe440e93a64eaddd0497c6c622f4395c8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 15 Mar 2009 19:15:28 -0500 Subject: [PATCH 4/7] Move dummy-compiler to compiler.units; throw a better error if make-image is passed an invalid architecture --- core/bootstrap/primitives.factor | 7 ++----- core/compiler/units/units.factor | 7 +++++++ 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 175735644d..083059cec5 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -25,7 +25,8 @@ H{ } clone sub-primitives set { "linux-ppc" "ppc/linux" } { "macosx-ppc" "ppc/macosx" } { "arm" "arm" } -} at "/bootstrap.factor" 3append parse-file +} ?at [ "Bad architecture: " prepend throw ] unless +"/bootstrap.factor" 3append parse-file "vocab:bootstrap/layouts/layouts.factor" parse-file @@ -45,10 +46,6 @@ init-caches ! Vocabulary for slot accessors "accessors" create-vocab drop -! Trivial recompile hook. We don't want to touch the code heap -! during stage1 bootstrap, it would just waste time. -SINGLETON: dummy-compiler -M: dummy-compiler recompile drop { } ; dummy-compiler compiler-impl set call diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index eaa9c8d537..eac288a079 100644 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -40,8 +40,15 @@ SYMBOL: compiler-impl HOOK: recompile compiler-impl ( words -- alist ) +! Non-optimizing compiler M: f recompile [ f ] { } map>assoc ; +! Trivial compiler. We don't want to touch the code heap +! during stage1 bootstrap, it would just waste time. +SINGLETON: dummy-compiler + +M: dummy-compiler recompile drop { } ; + : ( -- pair ) { H{ } H{ } } [ clone ] map ; SYMBOL: definition-observers From 311487e5e78b9c3a5e9cb2e6ff4a7d581fbe3f17 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 15 Mar 2009 20:05:59 -0500 Subject: [PATCH 5/7] Fix webapps.pastebin redirection --- extra/webapps/pastebin/pastebin.factor | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/extra/webapps/pastebin/pastebin.factor b/extra/webapps/pastebin/pastebin.factor index 38a3097999..6a52d02009 100644 --- a/extra/webapps/pastebin/pastebin.factor +++ b/extra/webapps/pastebin/pastebin.factor @@ -83,8 +83,7 @@ annotation "ANNOTATIONS" ! LINKS, ETC ! ! ! -: pastebin-url ( -- url ) - URL" $pastebin/list" ; +CONSTANT: pastebin-url URL" $pastebin/" : paste-url ( id -- url ) "$pastebin/paste" >url swap "id" set-query-param ; @@ -187,7 +186,7 @@ M: annotation entity-url "id" value delete-tuples "id" value f delete-tuples ] with-transaction - URL" $pastebin/list" + pastebin-url ] >>submit From 710ce7451241d6113b72157101c8a118a6c876f5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 15 Mar 2009 20:13:10 -0500 Subject: [PATCH 6/7] Add related-words to furnace.actions docs --- basis/furnace/actions/actions-docs.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/basis/furnace/actions/actions-docs.factor b/basis/furnace/actions/actions-docs.factor index dd453ae16d..83ed00ca1b 100644 --- a/basis/furnace/actions/actions-docs.factor +++ b/basis/furnace/actions/actions-docs.factor @@ -1,6 +1,6 @@ USING: assocs classes help.markup help.syntax io.streams.string http http.server.dispatchers http.server.responses -furnace.redirection strings multiline ; +furnace.redirection strings multiline html.forms ; IN: furnace.actions HELP: @@ -74,6 +74,8 @@ HELP: validate-params } } ; +{ validate-params validate-values } related-words + HELP: validation-failed { $description "Stops processing the current request and takes action depending on the type of the current request:" { $list From dacf1910dc19a2048ab6f6a250dcb1eaca12239a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 15 Mar 2009 20:13:17 -0500 Subject: [PATCH 7/7] First cut of webapps.site-watcheR --- extra/webapps/site-watcher/authors.txt | 1 + extra/webapps/site-watcher/site-list.xml | 41 ++++++++++++++ .../webapps/site-watcher/site-watcher.factor | 54 +++++++++++++++++++ 3 files changed, 96 insertions(+) create mode 100644 extra/webapps/site-watcher/authors.txt create mode 100644 extra/webapps/site-watcher/site-list.xml create mode 100644 extra/webapps/site-watcher/site-watcher.factor diff --git a/extra/webapps/site-watcher/authors.txt b/extra/webapps/site-watcher/authors.txt new file mode 100644 index 0000000000..d4f5d6b3ae --- /dev/null +++ b/extra/webapps/site-watcher/authors.txt @@ -0,0 +1 @@ +Slava Pestov \ No newline at end of file diff --git a/extra/webapps/site-watcher/site-list.xml b/extra/webapps/site-watcher/site-list.xml new file mode 100644 index 0000000000..9bd1467fc7 --- /dev/null +++ b/extra/webapps/site-watcher/site-list.xml @@ -0,0 +1,41 @@ + + + + + + + SiteWatcher + + +

SiteWatcher

+

It tells you if your web site goes down.

+ + + + + + + +
Remove
+

+ Check now +

+
+

Add a new site

+ + + + + + + + + + +
URL:
E-mail:
+

+ + + + + diff --git a/extra/webapps/site-watcher/site-watcher.factor b/extra/webapps/site-watcher/site-watcher.factor new file mode 100644 index 0000000000..a71a14a37a --- /dev/null +++ b/extra/webapps/site-watcher/site-watcher.factor @@ -0,0 +1,54 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors furnace.actions furnace.alloy furnace.redirection +html.forms http.server http.server.dispatchers namespaces site-watcher +site-watcher.private kernel urls validators db.sqlite assocs ; +IN: webapps.site-watcher + +TUPLE: site-watcher-app < dispatcher ; + +CONSTANT: site-list-url URL" $site-watcher-app/" + +: ( -- action ) + + { site-watcher-app "site-list" } >>template + [ + begin-form + sites get values "sites" set-value + ] >>init ; + +: ( -- action ) + + [ + { { "url" [ v-url ] } { "email" [ v-email ] } } validate-params + ] >>validate + [ + "email" value "url" value watch-site + site-list-url + ] >>submit ; + +: ( -- action ) + + [ + { { "url" [ v-url ] } } validate-params + ] >>validate + [ + "url" value delete-site + site-list-url + ] >>submit ; + +: ( -- action ) + + [ + sites get [ check-sites ] [ report-sites ] bi + site-list-url + ] >>submit ; + +: ( -- dispatcher ) + site-watcher-app new-dispatcher + "" add-responder + "add" add-responder + "remove" add-responder + "check" add-responder ; + + "resource:test.db" main-responder set-global \ No newline at end of file