diff --git a/contrib/cont-responder/load.factor b/contrib/cont-responder/load.factor index 76b7dac304..c372091a5d 100644 --- a/contrib/cont-responder/load.factor +++ b/contrib/cont-responder/load.factor @@ -35,7 +35,9 @@ default-responders USE: parser -: l1 +: l1 + "../parser-combinators/lazy.factor" run-file + "../parser-combinators/parser-combinators.factor" run-file "cont-html.factor" run-file "cont-responder.factor" run-file "cont-utils.factor" run-file ; diff --git a/contrib/cont-responder/todo-example.factor b/contrib/cont-responder/todo-example.factor index e8dfa2da7b..d15af8f494 100644 --- a/contrib/cont-responder/todo-example.factor +++ b/contrib/cont-responder/todo-example.factor @@ -45,6 +45,8 @@ USE: todo USE: arithmetic USE: logic USE: kernel +USE: lazy +USE: parser-combinators : todo-stylesheet ( -- string ) #! Return the stylesheet for the todo list @@ -189,15 +191,23 @@ USE: kernel "Register" login-form ] simple-page ; -: re-matches ( a b -- b ) - drop drop t ; +: username-parser ( -- parser ) + #! Return a parser which parses a valid todo username. + #! That is, it contains only lowercase, uppercase and digits. + [ letter? ] satisfy + [ LETTER? ] satisfy <|> + [ digit? ] satisfy <|> just ; + +: is-valid-username? ( password -- bool ) + #! Return true if the username parses correctly + username-parser call ; : login-details-valid? ( name password -- ) #! Ensure that a valid username and password were #! entered. In particular, ensure that only alphanumeric #! data was entered to prevent security problems by #! using .., etc in the name. - drop "[a-zA-Z0-9]*" re-matches ; + drop is-valid-username? ; : get-registration-details ( -- name password ) #! Get the registration details from the user putting @@ -309,9 +319,13 @@ USE: kernel ] form ] bind ; +: priority-parser ( -- parser ) + #! Return a parser for parsing priorities + [ digit? ] satisfy just ; + : todo-details-valid? ( priority description -- bool ) #! Return true if a valid priority and description were entered. - str-length 0 > swap "[0-9]" re-matches and ; + str-length 0 > swap priority-parser call and ; : get-new-todo-item ( -- ) #! Enter a new item to the current todo list. diff --git a/contrib/cont-responder/todo.factor b/contrib/cont-responder/todo.factor index ed6c511485..f5bc3f68da 100644 --- a/contrib/cont-responder/todo.factor +++ b/contrib/cont-responder/todo.factor @@ -34,6 +34,10 @@ USE: lists USE: arithmetic USE: stdio USE: kernel +USE: prettyprint +USE: unparser +USE: url-encoding + : ( user password -- ) #! Create an empty todo list @@ -59,36 +63,53 @@ USE: kernel : namespace>alist ( namespace -- alist ) #! Convert a namespace to an alist - [ vars-values ] bind ; - + [ vars-values ] bind ; + : print-quoted ( str -- ) #! Print the string with quotes around it "\"" write write "\"" print ; +: write-item ( -- ) + #! write the item in a manner that can be later re-read + [ + "complete?" get [ "yes" url-encode print ] [ "no" url-encode print ] ifte + "priority" get url-encode print + "description" get url-encode print + ] bind ; + +: write-items ( list -- ) + #! write the todo list items + dup length unparse print + [ write-item ] each ; + : 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 "items" swons print - "cdr [ alist>namespace ] map" print - "items" print-quoted "set" print - "] extend" print + "user" get url-encode print + "password" get url-encode print + "items" get write-items ] bind ; : store-todo ( filename -- ) #! store the todo list in the given file. [ write-todo ] with-stream ; +: read-todo ( -- ) + #! Read a todo list from the current input stream. + read url-decode read url-decode + read str>number [ + dup + [ + read url-decode "yes" = "complete?" set + read url-decode "priority" set + read url-decode "description" set + ] extend add-todo-item + ] times ; + : load-todo ( filename -- ) - run-file ; + [ read-todo ] with-stream ; : password-matches? ( password -- ) #! Returns the if the password matches otherwise @@ -132,7 +153,7 @@ USE: kernel #! Return true if item1 is a higher priority than item2 >r item-priority r> item-priority str-lexi> ; -: todo-items ( -- ) +: todo-items ( -- alist ) #! Return a list of items for the given todo list. [ "items" get ] bind [ priority-comparator ] sort ;