1 ! Copyright (C) 2008 Slava Pestov
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors kernel hashtables calendar random assocs
4 namespaces make splitting sequences sorting math.order present
5 io.files io.directories io.encodings.ascii
7 html.components html.forms
9 http.server.dispatchers
19 db.types db.tuples lcs urls ;
22 : wiki-url ( rest path -- url )
23 [ "$wiki/" % % "/" % present % ] "" make
26 : view-url ( title -- url ) "view" wiki-url ;
28 : edit-url ( title -- url ) "edit" wiki-url ;
30 : revisions-url ( title -- url ) "revisions" wiki-url ;
32 : revision-url ( id -- url ) "revision" wiki-url ;
34 : user-edits-url ( author -- url ) "user-edits" wiki-url ;
36 TUPLE: wiki < dispatcher ;
38 SYMBOL: can-delete-wiki-articles?
40 can-delete-wiki-articles? define-capability
42 TUPLE: article title revision ;
45 { "title" "TITLE" { VARCHAR 256 } +not-null+ +user-assigned-id+ }
46 { "revision" "REVISION" INTEGER +not-null+ } ! revision id
49 : <article> ( title -- article ) article new swap >>title ;
51 TUPLE: revision id title author date content description ;
53 revision "REVISIONS" {
54 { "id" "ID" INTEGER +db-assigned-id+ }
55 { "title" "TITLE" { VARCHAR 256 } +not-null+ } ! article id
56 { "author" "AUTHOR" { VARCHAR 256 } +not-null+ } ! uid
57 { "date" "DATE" TIMESTAMP +not-null+ }
58 { "content" "CONTENT" TEXT +not-null+ }
59 { "description" "DESCRIPTION" TEXT }
62 M: revision feed-entry-title
63 [ title>> ] [ drop " by " ] [ author>> ] tri 3append ;
65 M: revision feed-entry-date date>> ;
67 M: revision feed-entry-url id>> revision-url ;
69 : reverse-chronological-order ( seq -- sorted )
70 [ date>> ] inv-sort-with ;
72 : <revision> ( id -- revision )
73 revision new swap >>id ;
75 : validate-title ( -- )
76 { { "title" [ v-one-line ] } } validate-params ;
78 : validate-author ( -- )
79 { { "author" [ v-username ] } } validate-params ;
81 : <article-boilerplate> ( responder -- responder' )
83 { wiki "page-common" } >>template ;
85 : <main-article-action> ( -- action )
87 [ "Front Page" view-url <redirect> ] >>display ;
89 : latest-revision ( title -- revision/f )
90 <article> select-tuple
91 dup [ revision>> <revision> select-tuple ] when ;
93 : <view-article-action> ( -- action )
98 [ validate-title ] >>init
101 "title" value dup latest-revision [
103 { wiki "view" } <chloe-content>
109 <article-boilerplate> ;
111 : <view-revision-action> ( -- action )
118 "id" value <revision>
119 select-tuple from-object
122 { wiki "view" } >>template
124 <article-boilerplate> ;
126 : <random-article-action> ( -- action )
129 article new select-tuples random
130 [ title>> ] [ "Front Page" ] if*
134 : amend-article ( revision article -- )
135 swap id>> >>revision update-tuple ;
137 : add-article ( revision -- )
138 [ title>> ] [ id>> ] bi article boa insert-tuple ;
140 : add-revision ( revision -- )
143 dup title>> <article> select-tuple
144 [ amend-article ] [ add-article ] if*
148 : <edit-article-action> ( -- action )
156 "title" value <article> select-tuple
157 [ revision>> <revision> select-tuple ]
158 [ f <revision> "title" value >>title ]
161 [ title>> "title" set-value ]
162 [ content>> "content" set-value ]
166 { wiki "edit" } >>template
168 <article-boilerplate> ;
170 : <submit-article-action> ( -- action )
178 { "content" [ v-required ] }
179 { "description" [ [ v-one-line ] v-optional ] }
183 "title" value >>title
186 "content" value >>content
187 "description" value >>description
188 [ add-revision ] [ title>> view-url <redirect> ] bi
192 "edit wiki articles" >>description ;
194 : <revisions-boilerplate> ( responder -- responder )
196 { wiki "revisions-common" } >>template ;
198 : list-revisions ( -- seq )
199 f <revision> "title" value >>title select-tuples
200 reverse-chronological-order ;
202 : <list-revisions-action> ( -- action )
209 list-revisions "revisions" set-value
212 { wiki "revisions" } >>template
214 <revisions-boilerplate>
215 <article-boilerplate> ;
217 : <list-revisions-feed-action> ( -- action )
222 [ validate-title ] >>init
224 [ "Revisions of " "title" value append ] >>title
226 [ "title" value revisions-url ] >>url
228 [ list-revisions ] >>entries ;
230 : rollback-description ( description -- description' )
231 [ "Rollback to '" "'" surround ] [ "Rollback" ] if* ;
233 : <rollback-action> ( -- action )
236 [ validate-integer-id ] >>validate
239 "id" value <revision> select-tuple
243 [ rollback-description ] change-description
245 [ title>> revisions-url <redirect> ] bi
249 "rollback wiki articles" >>description ;
251 : list-changes ( -- seq )
252 f <revision> select-tuples
253 reverse-chronological-order ;
255 : <list-changes-action> ( -- action )
257 [ list-changes "revisions" set-value ] >>init
258 { wiki "changes" } >>template
260 <revisions-boilerplate> ;
262 : <list-changes-feed-action> ( -- action )
264 [ URL" $wiki/changes" ] >>url
265 [ "All changes" ] >>title
266 [ list-changes ] >>entries ;
268 : <delete-action> ( -- action )
271 [ validate-title ] >>validate
274 "title" value <article> delete-tuples
275 f <revision> "title" value >>title delete-tuples
276 URL" $wiki" <redirect>
280 "delete wiki articles" >>description
281 { can-delete-wiki-articles? } >>capabilities ;
283 : <diff-action> ( -- action )
288 { "old-id" [ v-integer ] }
289 { "new-id" [ v-integer ] }
293 [ value <revision> select-tuple ] bi@
295 over title>> "title" set-value
296 [ "old" [ from-object ] nest-form ]
297 [ "new" [ from-object ] nest-form ]
300 [ [ content>> string-lines ] bi@ diff "diff" set-value ]
304 { wiki "diff" } >>template
306 <article-boilerplate> ;
308 : <list-articles-action> ( -- action )
312 f <article> select-tuples
313 [ title>> ] sort-with
317 { wiki "articles" } >>template ;
319 : list-user-edits ( -- seq )
320 f <revision> "author" value >>author select-tuples
321 reverse-chronological-order ;
323 : <user-edits-action> ( -- action )
330 list-user-edits "revisions" set-value
333 { wiki "user-edits" } >>template
335 <revisions-boilerplate> ;
337 : <user-edits-feed-action> ( -- action )
340 [ validate-author ] >>init
341 [ "Edits by " "author" value append ] >>title
342 [ "author" value user-edits-url ] >>url
343 [ list-user-edits ] >>entries ;
345 : init-sidebars ( -- )
346 "Contents" latest-revision [ "contents" [ from-object ] nest-form ] when*
347 "Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ;
349 : init-relative-link-prefix ( -- )
350 URL" $wiki/view/" adjust-url present relative-link-prefix set ;
352 : <wiki> ( -- dispatcher )
354 <main-article-action> "" add-responder
355 <view-article-action> "view" add-responder
356 <view-revision-action> "revision" add-responder
357 <random-article-action> "random" add-responder
358 <list-revisions-action> "revisions" add-responder
359 <list-revisions-feed-action> "revisions.atom" add-responder
360 <diff-action> "diff" add-responder
361 <edit-article-action> "edit" add-responder
362 <submit-article-action> "submit" add-responder
363 <rollback-action> "rollback" add-responder
364 <user-edits-action> "user-edits" add-responder
365 <list-articles-action> "articles" add-responder
366 <list-changes-action> "changes" add-responder
367 <user-edits-feed-action> "user-edits.atom" add-responder
368 <list-changes-feed-action> "changes.atom" add-responder
369 <delete-action> "delete" add-responder
371 [ init-sidebars init-relative-link-prefix ] >>init
372 { wiki "wiki-common" } >>template ;
375 "resource:extra/webapps/wiki/initial-content" [
378 swap ascii file-contents
387 ] with-directory-files ;