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