extra/webapps/todo/todo.factor

   1 ! Copyright (c) 2008 Slava Pestov
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel sequences namespaces
   4 db db.types db.tuples validators hashtables urls
   5 html.forms
   6 html.components
   7 html.templates.chloe
   8 http.server
   9 http.server.dispatchers
  10 furnace
  11 furnace.boilerplate
  12 furnace.auth
  13 furnace.actions
  14 furnace.redirection
  15 furnace.db
  16 furnace.auth.login ;
  17 IN: webapps.todo
  18
  19 TUPLE: todo-list < dispatcher ;
  20
  21 TUPLE: todo uid id priority summary description ;
  22
  23 todo "TODO"
  24 {
  25     { "uid" "UID" { VARCHAR 256 } +not-null+ }
  26     { "id" "ID" +db-assigned-id+ }
  27     { "priority" "PRIORITY" INTEGER +not-null+ }
  28     { "summary" "SUMMARY" { VARCHAR 256 } +not-null+ }
  29     { "description" "DESCRIPTION" { VARCHAR 256 } }
  30 } define-persistent
  31
  32 : <todo> ( id -- todo )
  33     todo new
  34         swap >>id
  35         username >>uid ;
  36
  37 : <view-action> ( -- action )
  38     <page-action>
  39         [
  40             validate-integer-id
  41             "id" value <todo> select-tuple from-object
  42         ] >>init
  43
  44         { todo-list "view-todo" } >>template ;
  45
  46 : validate-todo ( -- )
  47     {
  48         { "summary" [ v-one-line ] }
  49         { "priority" [ v-integer 0 v-min-value 10 v-max-value ] }
  50         { "description" [ v-required ] }
  51     } validate-params ;
  52
  53 : view-todo-url ( id -- url )
  54     <url> "$todo-list/view" >>path swap "id" set-query-param ;
  55
  56 : <new-action> ( -- action )
  57     <page-action>
  58         [ 0 "priority" set-value ] >>init
  59
  60         { todo-list "new-todo" } >>template
  61
  62         [ validate-todo ] >>validate
  63
  64         [
  65             f <todo>
  66                 dup { "summary" "priority" "description" } to-object
  67             [ insert-tuple ] [ id>> view-todo-url <redirect> ] bi
  68         ] >>submit ;
  69
  70 : <edit-action> ( -- action )
  71     <page-action>
  72         [
  73             validate-integer-id
  74             "id" value <todo> select-tuple from-object
  75         ] >>init
  76
  77         { todo-list "edit-todo" } >>template
  78
  79         [
  80             validate-integer-id
  81             validate-todo
  82         ] >>validate
  83
  84         [
  85             f <todo>
  86                 dup { "id" "summary" "priority" "description" } to-object
  87             [ update-tuple ] [ id>> view-todo-url <redirect> ] bi
  88         ] >>submit ;
  89
  90 : todo-list-url ( -- url )
  91     URL" $todo-list/list" ;
  92
  93 : <delete-action> ( -- action )
  94     <action>
  95         [ validate-integer-id ] >>validate
  96
  97         [
  98             "id" get <todo> delete-tuples
  99             todo-list-url <redirect>
 100         ] >>submit ;
 101
 102 : <list-action> ( -- action )
 103     <page-action>
 104         [ f <todo> select-tuples "items" set-value ] >>init
 105         { todo-list "todo-list" } >>template ;
 106
 107 : <todo-list> ( -- responder )
 108     todo-list new-dispatcher
 109         <list-action>   "list"   add-main-responder
 110         <view-action>   "view"   add-responder
 111         <new-action>    "new"    add-responder
 112         <edit-action>   "edit"   add-responder
 113         <delete-action> "delete" add-responder
 114     <boilerplate>
 115         { todo-list "todo" } >>template
 116     <protected>
 117         "view your todo list" >>description ;