remove math.blas.syntax and merge parsing words into math.blas.vectors/matrices
[factor/jcg.git] / extra / webapps / wiki / wiki.factor
blob07fbbe059601e05cfabaa93b75c21781f6ff7262
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
6 syndication farkup
7 html.components html.forms
8 http.server
9 http.server.dispatchers
10 furnace.actions
11 furnace.utilities
12 furnace.redirection
13 furnace.auth
14 furnace.auth.login
15 furnace.boilerplate
16 furnace.syndication
17 validators
18 db.types db.tuples lcs farkup urls ;
19 IN: webapps.wiki
21 : wiki-url ( rest path -- url )
22     [ "$wiki/" % % "/" % present % ] "" make
23     <url> swap >>path ;
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 ;
43 article "ARTICLES" {
44     { "title" "TITLE" { VARCHAR 256 } +not-null+ +user-assigned-id+ }
45     { "revision" "REVISION" INTEGER +not-null+ } ! revision id
46 } define-persistent
48 : <article> ( title -- article ) article new swap >>title ;
50 TUPLE: revision id title author date content parsed 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     { "parsed" "PARSED" FACTOR-BLOB +not-null+ } ! Farkup AST
59     { "description" "DESCRIPTION" TEXT }
60 } define-persistent
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>> ] compare invert-comparison ] sort ;
72 : <revision> ( id -- revision )
73     revision new swap >>id ;
75 : compute-html ( revision -- )
76     dup content>> parse-farkup >>parsed drop ;
78 : validate-title ( -- )
79     { { "title" [ v-one-line ] } } validate-params ;
81 : validate-author ( -- )
82     { { "author" [ v-username ] } } validate-params ;
84 : <article-boilerplate> ( responder -- responder' )
85     <boilerplate>
86         { wiki "page-common" } >>template ;
88 : <main-article-action> ( -- action )
89     <action>
90         [ "Front Page" view-url <redirect> ] >>display ;
92 : latest-revision ( title -- revision/f )
93     <article> select-tuple
94     dup [ revision>> <revision> select-tuple ] when ;
96 : <view-article-action> ( -- action )
97     <action>
99         "title" >>rest
101         [ validate-title ] >>init
103         [
104             "title" value dup latest-revision [
105                 from-object
106                 { wiki "view" } <chloe-content>
107             ] [
108                 edit-url <redirect>
109             ] ?if
110         ] >>display
112     <article-boilerplate> ;
114 : <view-revision-action> ( -- action )
115     <page-action>
117         "id" >>rest
119         [
120             validate-integer-id
121             "id" value <revision>
122             select-tuple from-object
123         ] >>init
125         { wiki "view" } >>template
126     
127     <article-boilerplate> ;
129 : <random-article-action> ( -- action )
130     <action>
131         [
132             article new select-tuples random
133             [ title>> ] [ "Front Page" ] if*
134             view-url <redirect>
135         ] >>display ;
137 : amend-article ( revision article -- )
138     swap id>> >>revision update-tuple ;
140 : add-article ( revision -- )
141     [ title>> ] [ id>> ] bi article boa insert-tuple ;
143 : add-revision ( revision -- )
144     [ compute-html ]
145     [ insert-tuple ]
146     [
147         dup title>> <article> select-tuple
148         [ amend-article ] [ add-article ] if*
149     ]
150     tri ;
152 : <edit-article-action> ( -- action )
153     <page-action>
155         "title" >>rest
157         [
158             validate-title
160             "title" value <article> select-tuple
161             [ revision>> <revision> select-tuple ]
162             [ f <revision> "title" value >>title ]
163             if*
165             [ title>> "title" set-value ]
166             [ content>> "content" set-value ]
167             bi
168         ] >>init
170         { wiki "edit" } >>template
172     <article-boilerplate> ;
174 : <submit-article-action> ( -- action )
175     <action>
176         [
177             validate-title
179             {
180                 { "content" [ v-required ] }
181                 { "description" [ [ v-one-line ] v-optional ] }
182             } validate-params
184             f <revision>
185                 "title" value >>title
186                 now >>date
187                 username >>author
188                 "content" value >>content
189                 "description" value >>description
190             [ add-revision ] [ title>> view-url <redirect> ] bi
191         ] >>submit
193     <protected>
194         "edit wiki articles" >>description ;
196 : <revisions-boilerplate> ( responder -- responder )
197     <boilerplate>
198         { wiki "revisions-common" } >>template ;
200 : list-revisions ( -- seq )
201     f <revision> "title" value >>title select-tuples
202     reverse-chronological-order ;
204 : <list-revisions-action> ( -- action )
205     <page-action>
207         "title" >>rest
209         [
210             validate-title
211             list-revisions "revisions" set-value
212         ] >>init
214         { wiki "revisions" } >>template
216     <revisions-boilerplate>
217     <article-boilerplate> ;
219 : <list-revisions-feed-action> ( -- action )
220     <feed-action>
222         "title" >>rest
224         [ validate-title ] >>init
226         [ "Revisions of " "title" value append ] >>title
228         [ "title" value revisions-url ] >>url
230         [ list-revisions ] >>entries ;
232 : rollback-description ( description -- description' )
233     [ "Rollback of '" "'" surround ] [ "Rollback" ] if* ;
235 : <rollback-action> ( -- action )
236     <action>
238         [ validate-integer-id ] >>validate
240         [
241             "id" value <revision> select-tuple
242                 f >>id
243                 now >>date
244                 username >>author
245                 [ rollback-description ] change-description
246             [ add-revision ]
247             [ title>> revisions-url <redirect> ] bi
248         ] >>submit
249     
250     <protected>
251         "rollback wiki articles" >>description ;
253 : list-changes ( -- seq )
254     f <revision> select-tuples
255     reverse-chronological-order ;
257 : <list-changes-action> ( -- action )
258     <page-action>
259         [ list-changes "revisions" set-value ] >>init
260         { wiki "changes" } >>template
262     <revisions-boilerplate> ;
264 : <list-changes-feed-action> ( -- action )
265     <feed-action>
266         [ URL" $wiki/changes" ] >>url
267         [ "All changes" ] >>title
268         [ list-changes ] >>entries ;
270 : <delete-action> ( -- action )
271     <action>
273         [ validate-title ] >>validate
275         [
276             "title" value <article> delete-tuples
277             f <revision> "title" value >>title delete-tuples
278             URL" $wiki" <redirect>
279         ] >>submit
281      <protected>
282         "delete wiki articles" >>description
283         { can-delete-wiki-articles? } >>capabilities ;
285 : <diff-action> ( -- action )
286     <page-action>
288         [
289             {
290                 { "old-id" [ v-integer ] }
291                 { "new-id" [ v-integer ] }
292             } validate-params
294             "old-id" "new-id"
295             [ value <revision> select-tuple ] bi@
296             [
297                 over title>> "title" set-value
298                 [ "old" [ from-object ] nest-form ]
299                 [ "new" [ from-object ] nest-form ]
300                 bi*
301             ]
302             [ [ content>> string-lines ] bi@ diff "diff" set-value ]
303             2bi
304         ] >>init
306         { wiki "diff" } >>template
308     <article-boilerplate> ;
310 : <list-articles-action> ( -- action )
311     <page-action>
313         [
314             f <article> select-tuples
315             [ [ title>> ] compare ] sort
316             "articles" set-value
317         ] >>init
319         { wiki "articles" } >>template ;
321 : list-user-edits ( -- seq )
322     f <revision> "author" value >>author select-tuples
323     reverse-chronological-order ;
325 : <user-edits-action> ( -- action )
326     <page-action>
328         "author" >>rest
330         [
331             validate-author
332             list-user-edits "revisions" set-value
333         ] >>init
335         { wiki "user-edits" } >>template
337     <revisions-boilerplate> ;
339 : <user-edits-feed-action> ( -- action )
340     <feed-action>
341         "author" >>rest
342         [ validate-author ] >>init
343         [ "Edits by " "author" value append ] >>title
344         [ "author" value user-edits-url ] >>url
345         [ list-user-edits ] >>entries ;
347 : init-sidebars ( -- )
348     "Contents" latest-revision [ "contents" [ from-object ] nest-form ] when*
349     "Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ;
351 : init-relative-link-prefix ( -- )
352     URL" $wiki/view/" adjust-url present relative-link-prefix set ;
354 : <wiki> ( -- dispatcher )
355     wiki new-dispatcher
356         <main-article-action> "" add-responder
357         <view-article-action> "view" add-responder
358         <view-revision-action> "revision" add-responder
359         <random-article-action> "random" add-responder
360         <list-revisions-action> "revisions" add-responder
361         <list-revisions-feed-action> "revisions.atom" add-responder
362         <diff-action> "diff" add-responder
363         <edit-article-action> "edit" add-responder
364         <submit-article-action> "submit" add-responder
365         <rollback-action> "rollback" add-responder
366         <user-edits-action> "user-edits" add-responder
367         <list-articles-action> "articles" add-responder
368         <list-changes-action> "changes" add-responder
369         <user-edits-feed-action> "user-edits.atom" add-responder
370         <list-changes-feed-action> "changes.atom" add-responder
371         <delete-action> "delete" add-responder
372     <boilerplate>
373         [ init-sidebars init-relative-link-prefix ] >>init
374         { wiki "wiki-common" } >>template ;
376 : init-wiki ( -- )
377     "resource:extra/webapps/wiki/initial-content" [
378         [
379             dup ".txt" ?tail [
380                 swap ascii file-contents
381                 f <revision>
382                     swap >>content
383                     swap >>title
384                     "slava" >>author
385                     now >>date
386                 add-revision
387             ] [ 2drop ] if
388         ] each
389     ] with-directory-files ;