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
18 db.types db.tuples lcs urls ;
21 : wiki-url ( rest path -- url )
22 [ "$wiki/" % % "/" % present % ] "" make
25 : view-url ( title -- url ) "view" wiki-url ;
27 : edit-url ( title -- url ) "edit" wiki-url ;
29 : revisions-url ( title -- url ) "revisions" wiki-url ;
31 : revision-url ( id -- url ) "revision" wiki-url ;
33 : user-edits-url ( author -- url ) "user-edits" wiki-url ;
35 TUPLE: wiki < dispatcher ;
37 SYMBOL: can-delete-wiki-articles?
39 can-delete-wiki-articles? define-capability
41 TUPLE: article title revision ;
44 { "title" "TITLE" { VARCHAR 256 } +not-null+ +user-assigned-id+ }
45 { "revision" "REVISION" INTEGER +not-null+ } ! revision id
48 : <article> ( title -- article ) article new swap >>title ;
50 TUPLE: revision id title author date content description ;
52 revision "REVISIONS" {
53 { "id" "ID" INTEGER +db-assigned-id+ }
54 { "title" "TITLE" { VARCHAR 256 } +not-null+ } ! article id
55 { "author" "AUTHOR" { VARCHAR 256 } +not-null+ } ! uid
56 { "date" "DATE" TIMESTAMP +not-null+ }
57 { "content" "CONTENT" TEXT +not-null+ }
58 { "description" "DESCRIPTION" TEXT }
61 M: revision feed-entry-title
62 [ title>> ] [ drop " by " ] [ author>> ] tri 3append ;
64 M: revision feed-entry-date date>> ;
66 M: revision feed-entry-url id>> revision-url ;
68 : reverse-chronological-order ( seq -- sorted )
69 [ date>> ] inv-sort-with ;
71 : <revision> ( id -- revision )
72 revision new swap >>id ;
74 : validate-title ( -- )
75 { { "title" [ v-one-line ] } } validate-params ;
77 : validate-author ( -- )
78 { { "author" [ v-username ] } } validate-params ;
80 : <article-boilerplate> ( responder -- responder' )
82 { wiki "page-common" } >>template ;
84 : <main-article-action> ( -- action )
86 [ "Front Page" view-url <redirect> ] >>display ;
88 : latest-revision ( title -- revision/f )
89 <article> select-tuple
90 dup [ revision>> <revision> select-tuple ] when ;
92 : <view-article-action> ( -- action )
97 [ validate-title ] >>init
100 "title" value dup latest-revision [
102 { wiki "view" } <chloe-content>
108 <article-boilerplate> ;
110 : <view-revision-action> ( -- action )
117 "id" value <revision>
118 select-tuple from-object
121 { wiki "view" } >>template
123 <article-boilerplate> ;
125 : <random-article-action> ( -- action )
128 article new select-tuples random
129 [ title>> ] [ "Front Page" ] if*
133 : amend-article ( revision article -- )
134 swap id>> >>revision update-tuple ;
136 : add-article ( revision -- )
137 [ title>> ] [ id>> ] bi article boa insert-tuple ;
139 : add-revision ( revision -- )
142 dup title>> <article> select-tuple
143 [ amend-article ] [ add-article ] if*
147 : <edit-article-action> ( -- action )
155 "title" value <article> select-tuple
156 [ revision>> <revision> select-tuple ]
157 [ f <revision> "title" value >>title ]
160 [ title>> "title" set-value ]
161 [ content>> "content" set-value ]
165 { wiki "edit" } >>template
167 <article-boilerplate> ;
169 : <submit-article-action> ( -- action )
175 { "content" [ v-required ] }
176 { "description" [ [ v-one-line ] v-optional ] }
180 "title" value >>title
183 "content" value >>content
184 "description" value >>description
185 [ add-revision ] [ title>> view-url <redirect> ] bi
189 "edit wiki articles" >>description ;
191 : <revisions-boilerplate> ( responder -- responder )
193 { wiki "revisions-common" } >>template ;
195 : list-revisions ( -- seq )
196 f <revision> "title" value >>title select-tuples
197 reverse-chronological-order ;
199 : <list-revisions-action> ( -- action )
206 list-revisions "revisions" set-value
209 { wiki "revisions" } >>template
211 <revisions-boilerplate>
212 <article-boilerplate> ;
214 : <list-revisions-feed-action> ( -- action )
219 [ validate-title ] >>init
221 [ "Revisions of " "title" value append ] >>title
223 [ "title" value revisions-url ] >>url
225 [ list-revisions ] >>entries ;
227 : rollback-description ( description -- description' )
228 [ "Rollback of '" "'" surround ] [ "Rollback" ] if* ;
230 : <rollback-action> ( -- action )
233 [ validate-integer-id ] >>validate
236 "id" value <revision> select-tuple
240 [ rollback-description ] change-description
242 [ title>> revisions-url <redirect> ] bi
246 "rollback wiki articles" >>description ;
248 : list-changes ( -- seq )
249 f <revision> select-tuples
250 reverse-chronological-order ;
252 : <list-changes-action> ( -- action )
254 [ list-changes "revisions" set-value ] >>init
255 { wiki "changes" } >>template
257 <revisions-boilerplate> ;
259 : <list-changes-feed-action> ( -- action )
261 [ URL" $wiki/changes" ] >>url
262 [ "All changes" ] >>title
263 [ list-changes ] >>entries ;
265 : <delete-action> ( -- action )
268 [ validate-title ] >>validate
271 "title" value <article> delete-tuples
272 f <revision> "title" value >>title delete-tuples
273 URL" $wiki" <redirect>
277 "delete wiki articles" >>description
278 { can-delete-wiki-articles? } >>capabilities ;
280 : <diff-action> ( -- action )
285 { "old-id" [ v-integer ] }
286 { "new-id" [ v-integer ] }
290 [ value <revision> select-tuple ] bi@
292 over title>> "title" set-value
293 [ "old" [ from-object ] nest-form ]
294 [ "new" [ from-object ] nest-form ]
297 [ [ content>> string-lines ] bi@ diff "diff" set-value ]
301 { wiki "diff" } >>template
303 <article-boilerplate> ;
305 : <list-articles-action> ( -- action )
309 f <article> select-tuples
310 [ title>> ] sort-with
314 { wiki "articles" } >>template ;
316 : list-user-edits ( -- seq )
317 f <revision> "author" value >>author select-tuples
318 reverse-chronological-order ;
320 : <user-edits-action> ( -- action )
327 list-user-edits "revisions" set-value
330 { wiki "user-edits" } >>template
332 <revisions-boilerplate> ;
334 : <user-edits-feed-action> ( -- action )
337 [ validate-author ] >>init
338 [ "Edits by " "author" value append ] >>title
339 [ "author" value user-edits-url ] >>url
340 [ list-user-edits ] >>entries ;
342 : init-sidebars ( -- )
343 "Contents" latest-revision [ "contents" [ from-object ] nest-form ] when*
344 "Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ;
346 : init-relative-link-prefix ( -- )
347 URL" $wiki/view/" adjust-url present relative-link-prefix set ;
349 : <wiki> ( -- dispatcher )
351 <main-article-action> "" add-responder
352 <view-article-action> "view" add-responder
353 <view-revision-action> "revision" add-responder
354 <random-article-action> "random" add-responder
355 <list-revisions-action> "revisions" add-responder
356 <list-revisions-feed-action> "revisions.atom" add-responder
357 <diff-action> "diff" add-responder
358 <edit-article-action> "edit" add-responder
359 <submit-article-action> "submit" add-responder
360 <rollback-action> "rollback" add-responder
361 <user-edits-action> "user-edits" add-responder
362 <list-articles-action> "articles" add-responder
363 <list-changes-action> "changes" add-responder
364 <user-edits-feed-action> "user-edits.atom" add-responder
365 <list-changes-feed-action> "changes.atom" add-responder
366 <delete-action> "delete" add-responder
368 [ init-sidebars init-relative-link-prefix ] >>init
369 { wiki "wiki-common" } >>template ;
372 "resource:extra/webapps/wiki/initial-content" [
375 swap ascii file-contents
384 ] with-directory-files ;