From a90e22cd524d34210a65d163f4c16a991aee77d9 Mon Sep 17 00:00:00 2001 From: Chris Double Date: Wed, 21 Jul 2004 23:22:35 +0000 Subject: [PATCH] Added todo list cont-responder example. --- contrib/cont-responder/todo-example.factor | 169 +++++++++++++++++++++ contrib/cont-responder/todo.factor | 114 ++++++++++++++ 2 files changed, 283 insertions(+) create mode 100644 contrib/cont-responder/todo-example.factor create mode 100644 contrib/cont-responder/todo.factor diff --git a/contrib/cont-responder/todo-example.factor b/contrib/cont-responder/todo-example.factor new file mode 100644 index 0000000000..61fbcc3b19 --- /dev/null +++ b/contrib/cont-responder/todo-example.factor @@ -0,0 +1,169 @@ +! Copyright (C) 2004 Chris Double. +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, +! this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, +! this list of conditions and the following disclaimer in the documentation +! and/or other materials provided with the distribution. +! +! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, +! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; +! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR +! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! A simple 'to-do list' web application. +! +! Users can register with the system and from there manage a simple +! list of things to do. All data is stored in a directory in the +! filesystem with the users name. +IN: todo-example +USE: cont-responder +USE: cont-html +USE: stdio +USE: stack +USE: strings +USE: namespaces +USE: inspector +USE: lists +USE: combinators +USE: cont-examples +USE: todo + +: simple-todo-page ( title quot -- ) + #! Call the quotation, with all output going to the + #! body of an html page with the given title. + [ + [ [ swap write ] ] + [ call ] + ] ; + +: paragraph ( str -- ) + #! Output the string as an html paragraph +

[ write ]

; + +: row ( list -- ) + #! Output an html TR row with each element of the list + #! being called to produce the output for each TD. + [ + [ [ call ] ] each + ] ; + +: simple-input ( name -- ) + #! Output a simple HTML input field which will have the + #! specified name. + ; + +: button ( label -- ) + #! Output an HTML submit button with the given label. + ; + +: form ( quot action -- ) + #! Call quot with any output appearing inside an HTML form. + #! The form is a POST form where the action is as specified. +
[ call ]
; + +: input-value ( name -- value ) + #! Get the value of the variable "name". If it is f + #! return "" else return the value. + get [ "" ] unless* ; + +: register-new-user ( -- ) + #! Get registration details for a new user and add a + #! todo list form them. + [ + "Register New TODO List" + [ + [ + "" write + [ [ "Name:" write ] [ "name" simple-input ] ] row + [ [ "Password:" write ] [ "password" simple-input ] ] row + "
" write + "Register" button + ] swap form + ] simple-todo-page + ] show alist>namespace [ + "name" get dup "password" get + ] bind + dup "1" "Set up todo list" add-todo-item + swap "database-path" get swap ".todo" cat3 store-todo ; + +: get-login-information ( -- user password ) + [ + "Login" + [ +

[ "Please enter your username and password (" write + "Click to Register" [ register-new-user ] quot-href + "):" write + ]

+ [ + "" write + [ [ "Username:" write ] [ "username" simple-input ] ] row + [ [ "Password:" write ] [ "password" simple-input ] ] row + "
" write + "Login" button + ] swap form + ] simple-todo-page + ] show alist>namespace [ "username" input-value "password" input-value ] bind ; + +: get-todo-list ( -- ) + #! Prompts for a username or password until a valid combination + #! is entered then returns the list for that user. + get-login-information "database-path" get -rot user-exists? [ get-todo-list ] unless* ; + +: enter-new-todo-item ( -- ) + #! Enter a new item to the current todo list. + [ + "Enter New Todo Item" + [ + [ + "" write + [ [ "Priority:" write ] [ "priority" simple-input ] ] row + [ [ "Description:" write ] [ "description" simple-input ] ] row + "
" write + "Add" button + ] swap form + ] simple-todo-page + ] show alist>namespace [ + "priority" get "description" get + ] bind ; + +: save-current-todo ( -- ) + #! Save the current todo list + "todo" get dup "database-path" get swap [ "user" get ] bind ".todo" cat3 store-todo ; + +: todo-example ( path -- ) + #! Startup the todo list example using the given path as the + #! directory holding the todo files. + "database-path" set + get-todo-list "todo" set + [ + "todo" get [ "user" get ] bind "'s" "To Do list" cat3 + [ + drop + "todo" get [ + "" write + [ [ "Priority" write ] [ "Complete?" write ] [ "Description" write ] ] row + [ + [ [ "priority" get write ] + [ "complete?" get [ "Yes" ] [ "No" ] ifte write ] + [ "description" get write ] ] row + ] items-each-bind + "
" write + "Add Item" [ + "todo" get enter-new-todo-item add-todo-item save-current-todo + ] quot-href + ] bind + ] simple-todo-page + ] show drop ; + +"todo" [ drop "todo/" todo-example ] install-cont-responder \ No newline at end of file diff --git a/contrib/cont-responder/todo.factor b/contrib/cont-responder/todo.factor new file mode 100644 index 0000000000..c031329797 --- /dev/null +++ b/contrib/cont-responder/todo.factor @@ -0,0 +1,114 @@ +! Copyright (C) 2004 Chris Double. +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, +! this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, +! this list of conditions and the following disclaimer in the documentation +! and/or other materials provided with the distribution. +! +! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, +! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; +! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR +! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! Routines for managing a simple "To Do list". A todo list has a 'user', 'password' +! and list of items. Each item has a priority, description, and indication if it is +! complete. +IN: todo +USE: parser +USE: stack +USE: strings +USE: streams +USE: namespaces +USE: lists +USE: stdio +USE: kernel + +: ( user password -- ) + #! Create an empty todo list + [ + "password" set + "user" set + f "items" set + ] extend ; + +: ( priority description -- ) + #! Create a todo item + [ + "description" set + "priority" set + f "complete?" set + ] extend ; + +: add-todo-item ( -- ) + #! Add the item to the todo list + swap [ + "items" add@ + ] bind ; + +: namespace>alist ( namespace -- alist ) + #! Convert a namespace to an alist + [ vars-values ] bind ; + +: print-quoted ( str -- ) + #! Print the string with quotes around it + "\"" write write "\"" print ; + +: write-todo ( -- ) + #! Write the todo list to the current output stream + #! in a format that if loaded by the parser will result + #! in a again. + [ + "USE: namespaces" print + "USE: lists" print + " [" print + "password" get print-quoted + "password" print-quoted "set" print + "user" get print-quoted + "user" print-quoted "set" print + "items" get [ namespace>alist ] map print + "[ alist>namespace ] map" print + "items" print-quoted "set" print + "] extend" print + ] bind ; + +: store-todo ( filename -- ) + #! store the todo list in the given file. + [ write-todo ] with-stream ; + +: load-todo ( filename -- ) + run-file ; + +: password-matches? ( password -- ) + #! Returns the if the password matches otherwise + #! returns false. + dup -rot [ "password" get ] bind = [ ] [ drop f ] ifte ; + +: user-exists? ( db-path name password -- ) + #! Returns a if a user with the given name exists + #! otherwise returns false. + -rot ".todo" cat3 dup exists? [ + load-todo password-matches? + ] [ + 2drop f + ] ifte ; + +: items-each-bind ( quot -- ) + #! For each item in the currently bound todo list, call the quotation + #! with that item bound. + unit [ bind ] append "items" get swap each ; + +: test-todo + "user" "password" + dup "1" "item1" add-todo-item + dup "2" "item2" add-todo-item ; \ No newline at end of file