/extra/webapps/wiki/wiki.factor

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