1 ! Copyright (C) 2008 Slava Pestov
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors calendar db.tuples db.types farkup
4 furnace.actions furnace.auth furnace.boilerplate
5 furnace.recaptcha furnace.redirection furnace.syndication
6 furnace.utilities html.forms http.server.dispatchers kernel lcs
7 make namespaces present random sequences sorting splitting urls
11 : wiki-url ( rest path -- url )
12 [ "$wiki/" % % "/" % present % ] "" make
15 : view-url ( title -- url ) "view" wiki-url ;
17 : edit-url ( title -- url ) "edit" wiki-url ;
19 : revisions-url ( title -- url ) "revisions" wiki-url ;
21 : revision-url ( id -- url ) "revision" wiki-url ;
23 : user-edits-url ( author -- url ) "user-edits" wiki-url ;
25 TUPLE: wiki < dispatcher ;
27 SYMBOL: can-delete-wiki-articles?
29 can-delete-wiki-articles? define-capability
31 TUPLE: article title revision ;
34 { "title" "TITLE" { VARCHAR 256 } +not-null+ +user-assigned-id+ }
35 { "revision" "REVISION" INTEGER +not-null+ } ! revision id
38 : <article> ( title -- article ) article new swap >>title ;
40 TUPLE: revision id title author date content description ;
42 revision "REVISIONS" {
43 { "id" "ID" INTEGER +db-assigned-id+ }
44 { "title" "TITLE" { VARCHAR 256 } +not-null+ } ! article id
45 { "author" "AUTHOR" { VARCHAR 256 } +not-null+ } ! uid
46 { "date" "DATE" TIMESTAMP +not-null+ }
47 { "content" "CONTENT" TEXT +not-null+ }
48 { "description" "DESCRIPTION" TEXT }
51 M: revision feed-entry-title
52 [ title>> ] [ drop " by " ] [ author>> ] tri 3append ;
54 M: revision feed-entry-date date>> ;
56 M: revision feed-entry-url id>> revision-url ;
58 : reverse-chronological-order ( seq -- sorted )
59 [ date>> ] inv-sort-with ;
61 : <revision> ( id -- revision )
62 revision new swap >>id ;
64 : validate-title ( -- )
65 { { "title" [ v-one-line ] } } validate-params ;
67 : validate-author ( -- )
68 { { "author" [ v-username ] } } validate-params ;
70 : <article-boilerplate> ( responder -- responder' )
72 { wiki "page-common" } >>template ;
74 : <main-article-action> ( -- action )
76 [ "Front Page" view-url <redirect> ] >>display ;
78 : latest-revision ( title -- revision/f )
79 <article> select-tuple
80 dup [ revision>> <revision> select-tuple ] when ;
82 : <view-article-action> ( -- action )
87 [ validate-title ] >>init
90 "title" value dup latest-revision [
92 { wiki "view" } <chloe-content>
98 <article-boilerplate> ;
100 : <view-revision-action> ( -- action )
107 "id" value <revision>
108 select-tuple from-object
111 { wiki "view" } >>template
113 <article-boilerplate> ;
115 : <random-article-action> ( -- action )
118 article new select-tuples random
119 [ title>> ] [ "Front Page" ] if*
123 : amend-article ( revision article -- )
124 swap id>> >>revision update-tuple ;
126 : add-article ( revision -- )
127 [ title>> ] [ id>> ] bi article boa insert-tuple ;
129 : add-revision ( revision -- )
132 dup title>> <article> select-tuple
133 [ amend-article ] [ add-article ] if*
137 : <edit-article-action> ( -- action )
145 "title" value <article> select-tuple
146 [ revision>> <revision> select-tuple ]
147 [ f <revision> "title" value >>title ]
150 [ title>> "title" set-value ]
151 [ content>> "content" set-value ]
155 { wiki "edit" } >>template
157 <article-boilerplate> ;
159 : <submit-article-action> ( -- action )
167 { "content" [ v-required ] }
168 { "description" [ [ v-one-line ] v-optional ] }
172 "title" value >>title
175 "content" value >>content
176 "description" value >>description
177 [ add-revision ] [ title>> view-url <redirect> ] bi
181 "edit wiki articles" >>description ;
183 : <revisions-boilerplate> ( responder -- responder )
185 { wiki "revisions-common" } >>template ;
187 : list-revisions ( -- seq )
188 f <revision> "title" value >>title select-tuples
189 reverse-chronological-order ;
191 : <list-revisions-action> ( -- action )
198 list-revisions "revisions" set-value
201 { wiki "revisions" } >>template
203 <revisions-boilerplate>
204 <article-boilerplate> ;
206 : <list-revisions-feed-action> ( -- action )
211 [ validate-title ] >>init
213 [ "Revisions of " "title" value append ] >>title
215 [ "title" value revisions-url ] >>url
217 [ list-revisions ] >>entries ;
219 : rollback-description ( description -- description' )
220 [ "Rollback to '" "'" surround ] [ "Rollback" ] if* ;
222 : <rollback-action> ( -- action )
225 [ validate-integer-id ] >>validate
228 "id" value <revision> select-tuple
232 [ rollback-description ] change-description
234 [ title>> revisions-url <redirect> ] bi
238 "rollback wiki articles" >>description ;
240 : list-changes ( -- seq )
241 f <revision> select-tuples
242 reverse-chronological-order ;
244 : <list-changes-action> ( -- action )
246 [ list-changes "revisions" set-value ] >>init
247 { wiki "changes" } >>template
249 <revisions-boilerplate> ;
251 : <list-changes-feed-action> ( -- action )
253 [ URL" $wiki/changes" ] >>url
254 [ "All changes" ] >>title
255 [ list-changes ] >>entries ;
257 : <delete-action> ( -- action )
260 [ validate-title ] >>validate
263 "title" value <article> delete-tuples
264 f <revision> "title" value >>title delete-tuples
265 URL" $wiki" <redirect>
269 "delete wiki articles" >>description
270 { can-delete-wiki-articles? } >>capabilities ;
272 : <diff-action> ( -- action )
277 { "old-id" [ v-integer ] }
278 { "new-id" [ v-integer ] }
282 [ value <revision> select-tuple ] bi@
284 over title>> "title" set-value
285 [ "old" [ from-object ] nest-form ]
286 [ "new" [ from-object ] nest-form ]
289 [ [ content>> split-lines ] bi@ lcs-diff "diff" set-value ]
293 { wiki "diff" } >>template
295 <article-boilerplate> ;
297 : <list-articles-action> ( -- action )
301 f <article> select-tuples
302 [ title>> ] sort-with
306 { wiki "articles" } >>template ;
308 : list-user-edits ( -- seq )
309 f <revision> "author" value >>author select-tuples
310 reverse-chronological-order ;
312 : <user-edits-action> ( -- action )
319 list-user-edits "revisions" set-value
322 { wiki "user-edits" } >>template
324 <revisions-boilerplate> ;
326 : <user-edits-feed-action> ( -- action )
329 [ validate-author ] >>init
330 [ "Edits by " "author" value append ] >>title
331 [ "author" value user-edits-url ] >>url
332 [ list-user-edits ] >>entries ;
334 : init-sidebars ( -- )
335 "Contents" latest-revision [ "contents" [ from-object ] nest-form ] when*
336 "Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ;
338 : init-relative-link-prefix ( -- )
339 URL" $wiki/view/" adjust-url present relative-link-prefix set ;
341 : <wiki> ( -- dispatcher )
343 <main-article-action> "" add-responder
344 <view-article-action> "view" add-responder
345 <view-revision-action> "revision" add-responder
346 <random-article-action> "random" add-responder
347 <list-revisions-action> "revisions" add-responder
348 <list-revisions-feed-action> "revisions.atom" add-responder
349 <diff-action> "diff" add-responder
350 <edit-article-action> "edit" add-responder
351 <submit-article-action> "submit" add-responder
352 <rollback-action> "rollback" add-responder
353 <user-edits-action> "user-edits" add-responder
354 <list-articles-action> "articles" add-responder
355 <list-changes-action> "changes" add-responder
356 <user-edits-feed-action> "user-edits.atom" add-responder
357 <list-changes-feed-action> "changes.atom" add-responder
358 <delete-action> "delete" add-responder
360 [ init-sidebars init-relative-link-prefix ] >>init
361 { wiki "wiki-common" } >>template ;