1! Copyright (C) 2008 Slava Pestov
2! See http://factorcode.org/license.txt for BSD license.
3USING: accessors kernel hashtables calendar random assocs
4namespaces make splitting sequences sorting math.order present
5io.files io.directories io.encodings.ascii
6syndication farkup
7html.components html.forms
8http.server
9http.server.dispatchers
10furnace.actions
11furnace.utilities
12furnace.redirection
13furnace.auth
14furnace.auth.login
15furnace.boilerplate
16furnace.syndication
17validators
18db.types db.tuples lcs urls ;
19IN: webapps.wiki
20
21: wiki-url ( rest path -- url )
22    [ "$wiki/" % % "/" % present % ] "" make
23    <url> swap >>path ;
24
25: view-url ( title -- url ) "view" wiki-url ;
26
27: edit-url ( title -- url ) "edit" wiki-url ;
28
29: revisions-url ( title -- url ) "revisions" wiki-url ;
30
31: revision-url ( id -- url ) "revision" wiki-url ;
32
33: user-edits-url ( author -- url ) "user-edits" wiki-url ;
34
35TUPLE: wiki < dispatcher ;
36
37SYMBOL: can-delete-wiki-articles?
38
39can-delete-wiki-articles? define-capability
40
41TUPLE: article title revision ;
42
43article "ARTICLES" {
44    { "title" "TITLE" { VARCHAR 256 } +not-null+ +user-assigned-id+ }
45    { "revision" "REVISION" INTEGER +not-null+ } ! revision id
46} define-persistent
47
48: <article> ( title -- article ) article new swap >>title ;
49
50TUPLE: revision id title author date content description ;
51
52revision "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 }
59} define-persistent
60
61M: revision feed-entry-title
62    [ title>> ] [ drop " by " ] [ author>> ] tri 3append ;
63
64M: revision feed-entry-date date>> ;
65
66M: revision feed-entry-url id>> revision-url ;
67
68: reverse-chronological-order ( seq -- sorted )
69    [ date>> ] inv-sort-with ;
70
71: <revision> ( id -- revision )
72    revision new swap >>id ;
73
74: validate-title ( -- )
75    { { "title" [ v-one-line ] } } validate-params ;
76
77: validate-author ( -- )
78    { { "author" [ v-username ] } } validate-params ;
79
80: <article-boilerplate> ( responder -- responder' )
81    <boilerplate>
82        { wiki "page-common" } >>template ;
83
84: <main-article-action> ( -- action )
85    <action>
86        [ "Front Page" view-url <redirect> ] >>display ;
87
88: latest-revision ( title -- revision/f )
89    <article> select-tuple
90    dup [ revision>> <revision> select-tuple ] when ;
91
92: <view-article-action> ( -- action )
93    <action>
94
95        "title" >>rest
96
97        [ validate-title ] >>init
98
99        [
100            "title" value dup latest-revision [
101                from-object
102                { wiki "view" } <chloe-content>
103            ] [
104                edit-url <redirect>
105            ] ?if
106        ] >>display
107
108    <article-boilerplate> ;
109
110: <view-revision-action> ( -- action )
111    <page-action>
112
113        "id" >>rest
114
115        [
116            validate-integer-id
117            "id" value <revision>
118            select-tuple from-object
119        ] >>init
120
121        { wiki "view" } >>template
122
123    <article-boilerplate> ;
124
125: <random-article-action> ( -- action )
126    <action>
127        [
128            article new select-tuples random
129            [ title>> ] [ "Front Page" ] if*
130            view-url <redirect>
131        ] >>display ;
132
133: amend-article ( revision article -- )
134    swap id>> >>revision update-tuple ;
135
136: add-article ( revision -- )
137    [ title>> ] [ id>> ] bi article boa insert-tuple ;
138
139: add-revision ( revision -- )
140    [ insert-tuple ]
141    [
142        dup title>> <article> select-tuple
143        [ amend-article ] [ add-article ] if*
144    ]
145    bi ;
146
147: <edit-article-action> ( -- action )
148    <page-action>
149
150        "title" >>rest
151
152        [
153            validate-title
154
155            "title" value <article> select-tuple
156            [ revision>> <revision> select-tuple ]
157            [ f <revision> "title" value >>title ]
158            if*
159
160            [ title>> "title" set-value ]
161            [ content>> "content" set-value ]
162            bi
163        ] >>init
164
165        { wiki "edit" } >>template
166
167    <article-boilerplate> ;
168
169: <submit-article-action> ( -- action )
170    <action>
171        [
172            validate-title
173
174            {
175                { "content" [ v-required ] }
176                { "description" [ [ v-one-line ] v-optional ] }
177            } validate-params
178
179            f <revision>
180                "title" value >>title
181                now >>date
182                username >>author
183                "content" value >>content
184                "description" value >>description
185            [ add-revision ] [ title>> view-url <redirect> ] bi
186        ] >>submit
187
188    <protected>
189        "edit wiki articles" >>description ;
190
191: <revisions-boilerplate> ( responder -- responder )
192    <boilerplate>
193        { wiki "revisions-common" } >>template ;
194
195: list-revisions ( -- seq )
196    f <revision> "title" value >>title select-tuples
197    reverse-chronological-order ;
198
199: <list-revisions-action> ( -- action )
200    <page-action>
201
202        "title" >>rest
203
204        [
205            validate-title
206            list-revisions "revisions" set-value
207        ] >>init
208
209        { wiki "revisions" } >>template
210
211    <revisions-boilerplate>
212    <article-boilerplate> ;
213
214: <list-revisions-feed-action> ( -- action )
215    <feed-action>
216
217        "title" >>rest
218
219        [ validate-title ] >>init
220
221        [ "Revisions of " "title" value append ] >>title
222
223        [ "title" value revisions-url ] >>url
224
225        [ list-revisions ] >>entries ;
226
227: rollback-description ( description -- description' )
228    [ "Rollback of '" "'" surround ] [ "Rollback" ] if* ;
229
230: <rollback-action> ( -- action )
231    <action>
232
233        [ validate-integer-id ] >>validate
234
235        [
236            "id" value <revision> select-tuple
237                f >>id
238                now >>date
239                username >>author
240                [ rollback-description ] change-description
241            [ add-revision ]
242            [ title>> revisions-url <redirect> ] bi
243        ] >>submit
244
245    <protected>
246        "rollback wiki articles" >>description ;
247
248: list-changes ( -- seq )
249    f <revision> select-tuples
250    reverse-chronological-order ;
251
252: <list-changes-action> ( -- action )
253    <page-action>
254        [ list-changes "revisions" set-value ] >>init
255        { wiki "changes" } >>template
256
257    <revisions-boilerplate> ;
258
259: <list-changes-feed-action> ( -- action )
260    <feed-action>
261        [ URL" $wiki/changes" ] >>url
262        [ "All changes" ] >>title
263        [ list-changes ] >>entries ;
264
265: <delete-action> ( -- action )
266    <action>
267
268        [ validate-title ] >>validate
269
270        [
271            "title" value <article> delete-tuples
272            f <revision> "title" value >>title delete-tuples
273            URL" $wiki" <redirect>
274        ] >>submit
275
276     <protected>
277        "delete wiki articles" >>description
278        { can-delete-wiki-articles? } >>capabilities ;
279
280: <diff-action> ( -- action )
281    <page-action>
282
283        [
284            {
285                { "old-id" [ v-integer ] }
286                { "new-id" [ v-integer ] }
287            } validate-params
288
289            "old-id" "new-id"
290            [ value <revision> select-tuple ] bi@
291            [
292                over title>> "title" set-value
293                [ "old" [ from-object ] nest-form ]
294                [ "new" [ from-object ] nest-form ]
295                bi*
296            ]
297            [ [ content>> string-lines ] bi@ diff "diff" set-value ]
298            2bi
299        ] >>init
300
301        { wiki "diff" } >>template
302
303    <article-boilerplate> ;
304
305: <list-articles-action> ( -- action )
306    <page-action>
307
308        [
309            f <article> select-tuples
310            [ title>> ] sort-with
311            "articles" set-value
312        ] >>init
313
314        { wiki "articles" } >>template ;
315
316: list-user-edits ( -- seq )
317    f <revision> "author" value >>author select-tuples
318    reverse-chronological-order ;
319
320: <user-edits-action> ( -- action )
321    <page-action>
322
323        "author" >>rest
324
325        [
326            validate-author
327            list-user-edits "revisions" set-value
328        ] >>init
329
330        { wiki "user-edits" } >>template
331
332    <revisions-boilerplate> ;
333
334: <user-edits-feed-action> ( -- action )
335    <feed-action>
336        "author" >>rest
337        [ validate-author ] >>init
338        [ "Edits by " "author" value append ] >>title
339        [ "author" value user-edits-url ] >>url
340        [ list-user-edits ] >>entries ;
341
342: init-sidebars ( -- )
343    "Contents" latest-revision [ "contents" [ from-object ] nest-form ] when*
344    "Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ;
345
346: init-relative-link-prefix ( -- )
347    URL" $wiki/view/" adjust-url present relative-link-prefix set ;
348
349: <wiki> ( -- dispatcher )
350    wiki new-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
367    <boilerplate>
368        [ init-sidebars init-relative-link-prefix ] >>init
369        { wiki "wiki-common" } >>template ;
370
371: init-wiki ( -- )
372    "resource:extra/webapps/wiki/initial-content" [
373        [
374            dup ".txt" ?tail [
375                swap ascii file-contents
376                f <revision>
377                    swap >>content
378                    swap >>title
379                    "slava" >>author
380                    now >>date
381                add-revision
382            ] [ 2drop ] if
383        ] each
384    ] with-directory-files ;