From 2513c2d3dff4fbd150cea565fb0ea50f4452da6d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 6 Jun 2008 18:18:05 -0500 Subject: [PATCH] Working on blogs web app --- extra/db/tuples/tuples.factor | 3 + extra/furnace/furnace.factor | 2 +- extra/urls/urls-tests.factor | 4 +- extra/urls/urls.factor | 2 +- extra/webapps/blogs/blogs-common.xml | 31 +++ extra/webapps/blogs/blogs.css | 15 ++ extra/webapps/blogs/blogs.factor | 253 ++++++++++++++++++ extra/webapps/blogs/edit-post.xml | 29 ++ extra/webapps/blogs/list-posts.xml | 35 +++ extra/webapps/blogs/new-post.xml | 17 ++ extra/webapps/blogs/user-posts.xml | 41 +++ extra/webapps/blogs/view-post.xml | 60 +++++ .../factor-website/factor-website.factor | 7 +- extra/webapps/pastebin/paste.xml | 1 + extra/webapps/planet/planet.xml | 2 +- extra/webapps/todo/todo.factor | 26 +- extra/webapps/wiki/wiki.factor | 12 +- 17 files changed, 512 insertions(+), 28 deletions(-) create mode 100644 extra/webapps/blogs/blogs-common.xml create mode 100644 extra/webapps/blogs/blogs.css create mode 100644 extra/webapps/blogs/blogs.factor create mode 100644 extra/webapps/blogs/edit-post.xml create mode 100644 extra/webapps/blogs/list-posts.xml create mode 100644 extra/webapps/blogs/new-post.xml create mode 100644 extra/webapps/blogs/user-posts.xml create mode 100644 extra/webapps/blogs/view-post.xml diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor index bac141d6d2..0fe2f3577e 100755 --- a/extra/db/tuples/tuples.factor +++ b/extra/db/tuples/tuples.factor @@ -149,6 +149,9 @@ M: retryable execute-statement* ( statement type -- ) : select-tuples ( tuple -- tuples ) dup dup class do-select ; +: count-tuples ( tuple -- n ) + select-tuples length ; + : select-tuple ( tuple -- tuple/f ) dup dup class f f f 1 do-select ?first ; diff --git a/extra/furnace/furnace.factor b/extra/furnace/furnace.factor index 862ed80e11..3566d45c5b 100644 --- a/extra/furnace/furnace.factor +++ b/extra/furnace/furnace.factor @@ -151,7 +151,7 @@ CHLOE: a : form-magic ( tag -- ) [ modify-form ] each-responder nested-values get " " join f like form-nesting-key hidden-form-field - "for" optional-attr [ hidden render ] when* ; + "for" optional-attr [ "," split [ hidden render ] each ] when* ; : form-start-tag ( tag -- ) [ diff --git a/extra/urls/urls-tests.factor b/extra/urls/urls-tests.factor index a718989476..87c9b91950 100644 --- a/extra/urls/urls-tests.factor +++ b/extra/urls/urls-tests.factor @@ -1,7 +1,7 @@ IN: urls.tests USING: urls urls.private tools.test tuple-syntax arrays kernel assocs -present ; +present accessors ; [ "hello%20world" ] [ "hello world" url-encode ] unit-test [ "hello world" ] [ "hello%20world" url-decode ] unit-test @@ -224,3 +224,5 @@ urls [ [ "a" ] [ "a" "b" set-query-param "b" query-param ] unit-test + +[ "foo#3" ] [ URL" foo" clone 3 >>anchor present ] unit-test diff --git a/extra/urls/urls.factor b/extra/urls/urls.factor index bb4d17e1f5..7e74fd1115 100644 --- a/extra/urls/urls.factor +++ b/extra/urls/urls.factor @@ -170,7 +170,7 @@ M: url present [ dup protocol>> dup [ unparse-host-part ] [ 2drop ] if ] [ path>> url-encode % ] [ query>> dup assoc-empty? [ drop ] [ "?" % assoc>query % ] if ] - [ anchor>> [ "#" % url-encode % ] when* ] + [ anchor>> [ "#" % present url-encode % ] when* ] } cleave ] "" make ; diff --git a/extra/webapps/blogs/blogs-common.xml b/extra/webapps/blogs/blogs-common.xml new file mode 100644 index 0000000000..38005e6f1c --- /dev/null +++ b/extra/webapps/blogs/blogs-common.xml @@ -0,0 +1,31 @@ + + + + + Recent Posts + + + +
+ + All Posts + | My Posts + | New Post + + + + + | Edit Profile + + + | Logout + + + +
+ +

+ + + + diff --git a/extra/webapps/blogs/blogs.css b/extra/webapps/blogs/blogs.css new file mode 100644 index 0000000000..66676796a4 --- /dev/null +++ b/extra/webapps/blogs/blogs.css @@ -0,0 +1,15 @@ +.post-form { + border: 2px solid #666; + padding: 10px; + background: #eee; +} + +.post-title { + background-color:#f5f5ff; + padding: 3px; +} + +.post-footer { + text-align: right; + font-size:90%; +} diff --git a/extra/webapps/blogs/blogs.factor b/extra/webapps/blogs/blogs.factor new file mode 100644 index 0000000000..60911b4947 --- /dev/null +++ b/extra/webapps/blogs/blogs.factor @@ -0,0 +1,253 @@ +! Copyright (C) 2008 Slava Pestov +! See http://factorcode.org/license.txt for BSD license. +USING: kernel accessors sequences sorting math.order math.parser +urls validators html.components db.types db.tuples calendar +http.server.dispatchers +furnace furnace.actions furnace.auth.login furnace.boilerplate +furnace.sessions furnace.syndication ; +IN: webapps.blogs + +TUPLE: blogs < dispatcher ; + +: view-post-url ( id -- url ) + number>string "$blogs/post/" prepend >url ; + +: view-comment-url ( parent id -- url ) + [ view-post-url ] dip >>anchor ; + +: list-posts-url ( -- url ) + URL" $blogs/" ; + +: user-posts-url ( author -- url ) + "$blogs/by/" prepend >url ; + +TUPLE: entity id author date content ; + +GENERIC: entity-url ( entity -- url ) + +M: entity feed-entry-url entity-url ; + +entity f { + { "id" "ID" INTEGER +db-assigned-id+ } + { "author" "AUTHOR" { VARCHAR 256 } +not-null+ } ! uid + { "date" "DATE" TIMESTAMP +not-null+ } + { "content" "CONTENT" TEXT +not-null+ } +} define-persistent + +M: entity feed-entry-date date>> ; + +TUPLE: post < entity title comments ; + +M: post feed-entry-title + [ author>> ] [ drop ": " ] [ title>> ] tri 3append ; + +M: post entity-url + id>> view-post-url ; + +\ post "BLOG_POSTS" { + { "title" "TITLE" { VARCHAR 256 } +not-null+ } +} define-persistent + +: ( id -- post ) \ post new swap >>id ; + +: init-posts-table \ post ensure-table ; + +TUPLE: comment < entity parent ; + +comment "COMMENTS" { + { "parent" "PARENT" INTEGER +not-null+ } ! post id +} define-persistent + +M: comment feed-entry-title + author>> "Comment by " prepend ; + +M: comment entity-url + [ parent>> ] [ id>> ] bi view-comment-url ; + +: ( parent id -- post ) + comment new + swap >>id + swap >>parent ; + +: init-comments-table comment ensure-table ; + +: post ( id -- post ) + [ select-tuple ] [ f select-tuples ] bi + >>comments ; + +: reverse-chronological-order ( seq -- sorted ) + [ [ date>> ] compare invert-comparison ] sort ; + +: validate-author ( -- ) + { { "author" [ [ v-username ] v-optional ] } } validate-params ; + +: list-posts ( -- posts ) + f "author" value >>author + select-tuples [ dup id>> f count-tuples >>comments ] map + reverse-chronological-order ; + +: ( -- action ) + + [ + list-posts "posts" set-value + ] >>init + + { blogs "list-posts" } >>template ; + +: ( -- action ) + + [ "Recent Posts" ] >>title + [ list-posts ] >>entries + [ list-posts-url ] >>url ; + +: ( -- action ) + + "author" >>rest + [ + validate-author + list-posts "posts" set-value + ] >>init + { blogs "user-posts" } >>template ; + +: ( -- action ) + + [ validate-author ] >>init + [ "Recent Posts by " "author" value append ] >>title + [ list-posts ] >>entries + [ "author" value user-posts-url ] >>url ; + +: ( -- action ) + + [ validate-integer-id "id" value post "post" set-value ] >>init + [ "post" value feed-entry-title ] >>title + [ "post" value entity-url ] >>url + [ "post" value comments>> ] >>entries ; + +: ( -- action ) + + "id" >>rest + + [ + validate-integer-id + "id" value post from-object + + "id" value + "new-comment" [ + "parent" set-value + ] nest-values + ] >>init + + { blogs "view-post" } >>template ; + +: validate-post ( -- ) + { + { "title" [ v-one-line ] } + { "content" [ v-required ] } + } validate-params ; + +: ( -- action ) + + [ + validate-post + uid "author" set-value + ] >>validate + + [ + f + dup { "title" "content" } deposit-slots + uid >>author + now >>date + [ insert-tuple ] [ entity-url ] bi + ] >>submit + + { blogs "new-post" } >>template ; + +: ( -- action ) + + [ + validate-integer-id + "id" value select-tuple from-object + ] >>init + + [ + validate-integer-id + validate-post + ] >>validate + + [ + "id" value select-tuple + dup { "title" "content" } deposit-slots + [ update-tuple ] [ entity-url ] bi + ] >>submit + + { blogs "edit-post" } >>template ; + +: ( -- action ) + + [ + validate-integer-id + { { "author" [ v-username ] } } validate-params + ] >>validate + [ + "id" value delete-tuples + "author" value user-posts-url + ] >>submit ; + +: validate-comment ( -- ) + { + { "parent" [ v-integer ] } + { "content" [ v-required ] } + } validate-params ; + +: ( -- action ) + + + [ + validate-comment + uid "author" set-value + ] >>validate + + [ + "parent" value f + "content" value >>content + uid >>author + now >>date + [ insert-tuple ] [ entity-url ] bi + ] >>submit ; + +: ( -- action ) + + [ + validate-integer-id + { { "parent" [ v-integer ] } } validate-params + ] >>validate + [ + f "id" value delete-tuples + "parent" value view-post-url + ] >>submit ; + +: ( -- dispatcher ) + blogs new-dispatcher + "" add-responder + "posts.atom" add-responder + "by" add-responder + "by.atom" add-responder + "post" add-responder + "post.atom" add-responder + + "make a new blog post" >>description + "new-post" add-responder + + "edit a blog post" >>description + "edit-post" add-responder + + "delete a blog post" >>description + "delete-post" add-responder + + "make a comment" >>description + "new-comment" add-responder + + "delete a comment" >>description + "delete-comment" add-responder + + { blogs "blogs-common" } >>template ; diff --git a/extra/webapps/blogs/edit-post.xml b/extra/webapps/blogs/edit-post.xml new file mode 100644 index 0000000000..da88a78ab0 --- /dev/null +++ b/extra/webapps/blogs/edit-post.xml @@ -0,0 +1,29 @@ + + + + + Edit: + +
+ + +

Title:

+

+ + +
+ +
+ Post by + + + + on + + | + View Post + | + Delete Post +
+ + diff --git a/extra/webapps/blogs/list-posts.xml b/extra/webapps/blogs/list-posts.xml new file mode 100644 index 0000000000..9c9685fe74 --- /dev/null +++ b/extra/webapps/blogs/list-posts.xml @@ -0,0 +1,35 @@ + + + + + Recent Posts + + + +

+ + + +

+ +

+ +

+ +
+ Post by + + + + on + + | + + + comments. + +
+ + + + diff --git a/extra/webapps/blogs/new-post.xml b/extra/webapps/blogs/new-post.xml new file mode 100644 index 0000000000..9cb0250518 --- /dev/null +++ b/extra/webapps/blogs/new-post.xml @@ -0,0 +1,17 @@ + + + + + New Post + +
+ + +

Title:

+

+ + +
+ + + diff --git a/extra/webapps/blogs/user-posts.xml b/extra/webapps/blogs/user-posts.xml new file mode 100644 index 0000000000..95fae23b34 --- /dev/null +++ b/extra/webapps/blogs/user-posts.xml @@ -0,0 +1,41 @@ + + + + + + Recent Posts by + + + + Recent Posts by + + + + +

+ + + +

+ +

+ +

+ +
+ Post by + + + + on + + | + + + comments. + +
+ + + + diff --git a/extra/webapps/blogs/view-post.xml b/extra/webapps/blogs/view-post.xml new file mode 100644 index 0000000000..3489f1e331 --- /dev/null +++ b/extra/webapps/blogs/view-post.xml @@ -0,0 +1,60 @@ + + + + + + : + + + + Recent Posts by + + + + +

+ +

+ +
+ Post by + + + + on + + | + Edit Post + | + Delete Post +
+ + +
+ +

+ Comment by on : +

+ +

+ +

+ + Delete Comment + + + + + +

New Comment

+ +
+ +

+

+ +
+ + + + diff --git a/extra/webapps/factor-website/factor-website.factor b/extra/webapps/factor-website/factor-website.factor index 44899cba31..d17a912ad8 100644 --- a/extra/webapps/factor-website/factor-website.factor +++ b/extra/webapps/factor-website/factor-website.factor @@ -12,6 +12,7 @@ furnace.sessions furnace.auth.login furnace.auth.providers.db furnace.boilerplate +webapps.blogs webapps.pastebin webapps.planet webapps.todo @@ -38,13 +39,17 @@ IN: webapps.factor-website init-articles-table init-revisions-table + init-postings-table + init-comments-table + init-short-url-table ] with-db ; TUPLE: factor-website < dispatcher ; : ( -- responder ) - factor-website new-dispatcher + factor-website new-dispatcher + "blogs" add-responder "todo" add-responder "pastebin" add-responder "planet" add-responder diff --git a/extra/webapps/pastebin/paste.xml b/extra/webapps/pastebin/paste.xml index ea69c7bf7d..1c138fc8c0 100644 --- a/extra/webapps/pastebin/paste.xml +++ b/extra/webapps/pastebin/paste.xml @@ -53,6 +53,7 @@ + diff --git a/extra/webapps/planet/planet.xml b/extra/webapps/planet/planet.xml index 96343bc5fa..fe4d23bd3b 100644 --- a/extra/webapps/planet/planet.xml +++ b/extra/webapps/planet/planet.xml @@ -19,7 +19,7 @@

- +

diff --git a/extra/webapps/todo/todo.factor b/extra/webapps/todo/todo.factor index 1cecbc1094..a588b880d3 100755 --- a/extra/webapps/todo/todo.factor +++ b/extra/webapps/todo/todo.factor @@ -51,6 +51,9 @@ todo "TODO" { "description" [ v-required ] } } validate-params ; +: view-todo-url ( id -- url ) + "$todo-list/view" >>path swap "id" set-query-param ; + : ( -- action ) [ 0 "priority" set-value ] >>init @@ -62,14 +65,7 @@ todo "TODO" [ f dup { "summary" "priority" "description" } deposit-slots - [ insert-tuple ] - [ - - "$todo-list/view" >>path - swap id>> "id" set-query-param - - ] - bi + [ insert-tuple ] [ id>> view-todo-url ] bi ] >>submit ; : ( -- action ) @@ -89,23 +85,19 @@ todo "TODO" [ f dup { "id" "summary" "priority" "description" } deposit-slots - [ update-tuple ] - [ - - "$todo-list/view" >>path - swap id>> "id" set-query-param - - ] - bi + [ update-tuple ] [ id>> view-todo-url ] bi ] >>submit ; +: todo-list-url ( -- url ) + URL" $todo-list/list" ; + : ( -- action ) [ validate-integer-id ] >>validate [ "id" get delete-tuples - URL" $todo-list/list" + todo-list-url ] >>submit ; : ( -- action ) diff --git a/extra/webapps/wiki/wiki.factor b/extra/webapps/wiki/wiki.factor index 611bba4c70..1dc6ef4ae8 100644 --- a/extra/webapps/wiki/wiki.factor +++ b/extra/webapps/wiki/wiki.factor @@ -15,14 +15,14 @@ validators db.types db.tuples lcs farkup urls ; IN: webapps.wiki -: title-url ( title action -- url ) - "$wiki/" prepend >url swap "title" set-query-param ; +: view-url ( title -- url ) + "$wiki/view/" prepend >url ; -: view-url ( title -- url ) "view" title-url ; +: edit-url ( title -- url ) + "$wiki/edit" >url swap "title" set-query-param ; -: edit-url ( title -- url ) "edit" title-url ; - -: revisions-url ( title -- url ) "revisions" title-url ; +: revisions-url ( title -- url ) + "$wiki/revisions" >url swap "title" set-query-param ; : revision-url ( id -- url ) "$wiki/revision" >url swap "id" set-query-param ;