extra/webapps/wiki/wiki.factor

   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.encodings.ascii
   6 syndication farkup
   7 html.components html.forms
   8 http.server
   9 http.server.dispatchers
  10 furnace
  11 furnace.actions
  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
  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
  35 TUPLE: wiki < dispatcher ;
  36
  37 SYMBOL: can-delete-wiki-articles?
  38
  39 can-delete-wiki-articles? define-capability
  40
  41 TUPLE: article title revision ;
  42
  43 article "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
  50 TUPLE: revision id title author date content parsed description ;
  51
  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
  61
  62 M: revision feed-entry-title
  63     [ title>> ] [ drop " by " ] [ author>> ] tri 3append ;
  64
  65 M: revision feed-entry-date date>> ;
  66
  67 M: revision feed-entry-url id>> revision-url ;
  68
  69 : reverse-chronological-order ( seq -- sorted )
  70     [ [ date>> ] compare invert-comparison ] sort ;
  71
  72 : <revision> ( id -- revision )
  73     revision new swap >>id ;
  74
  75 : compute-html ( revision -- )
  76     dup content>> parse-farkup >>parsed drop ;
  77
  78 : validate-title ( -- )
  79     { { "title" [ v-one-line ] } } validate-params ;
  80
  81 : validate-author ( -- )
  82     { { "author" [ v-username ] } } validate-params ;
  83
  84 : <article-boilerplate> ( responder -- responder' )
  85     <boilerplate>
  86         { wiki "page-common" } >>template ;
  87
  88 : <main-article-action> ( -- action )
  89     <action>
  90         [ "Front Page" view-url <redirect> ] >>display ;
  91
  92 : latest-revision ( title -- revision/f )
  93     <article> select-tuple
  94     dup [ revision>> <revision> select-tuple ] when ;
  95
  96 : <view-article-action> ( -- action )
  97     <action>
  98
  99         "title" >>rest
 100
 101         [ validate-title ] >>init
 102
 103         [
 104             "title" value dup latest-revision [
 105                 from-object
 106                 { wiki "view" } <chloe-content>
 107             ] [
 108                 edit-url <redirect>
 109             ] ?if
 110         ] >>display
 111
 112     <article-boilerplate> ;
 113
 114 : <view-revision-action> ( -- action )
 115     <page-action>
 116
 117         "id" >>rest
 118
 119         [
 120             validate-integer-id
 121             "id" value <revision>
 122             select-tuple from-object
 123         ] >>init
 124
 125         { wiki "view" } >>template
 126
 127     <article-boilerplate> ;
 128
 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 ;
 136
 137 : amend-article ( revision article -- )
 138     swap id>> >>revision update-tuple ;
 139
 140 : add-article ( revision -- )
 141     [ title>> ] [ id>> ] bi article boa insert-tuple ;
 142
 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 ;
 151
 152 : <edit-article-action> ( -- action )
 153     <page-action>
 154
 155         "title" >>rest
 156
 157         [
 158             validate-title
 159
 160             "title" value <article> select-tuple
 161             [ revision>> <revision> select-tuple ]
 162             [ f <revision> "title" value >>title ]
 163             if*
 164
 165             [ title>> "title" set-value ]
 166             [ content>> "content" set-value ]
 167             bi
 168         ] >>init
 169
 170         { wiki "edit" } >>template
 171
 172     <article-boilerplate> ;
 173
 174 : <submit-article-action> ( -- action )
 175     <action>
 176         [
 177             validate-title
 178
 179             {
 180                 { "content" [ v-required ] }
 181                 { "description" [ [ v-one-line ] v-optional ] }
 182             } validate-params
 183
 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
 192
 193     <protected>
 194         "edit wiki articles" >>description ;
 195
 196 : <revisions-boilerplate> ( responder -- responder )
 197     <boilerplate>
 198         { wiki "revisions-common" } >>template ;
 199
 200 : list-revisions ( -- seq )
 201     f <revision> "title" value >>title select-tuples
 202     reverse-chronological-order ;
 203
 204 : <list-revisions-action> ( -- action )
 205     <page-action>
 206
 207         "title" >>rest
 208
 209         [
 210             validate-title
 211             list-revisions "revisions" set-value
 212         ] >>init
 213
 214         { wiki "revisions" } >>template
 215
 216     <revisions-boilerplate>
 217     <article-boilerplate> ;
 218
 219 : <list-revisions-feed-action> ( -- action )
 220     <feed-action>
 221
 222         "title" >>rest
 223
 224         [ validate-title ] >>init
 225
 226         [ "Revisions of " "title" value append ] >>title
 227
 228         [ "title" value revisions-url ] >>url
 229
 230         [ list-revisions ] >>entries ;
 231
 232 : rollback-description ( description -- description' )
 233     [ "Rollback of '" swap "'" 3append ] [ "Rollback" ] if* ;
 234
 235 : <rollback-action> ( -- action )
 236     <action>
 237
 238         [ validate-integer-id ] >>validate
 239
 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 ;
 252
 253 : list-changes ( -- seq )
 254     f <revision> select-tuples
 255     reverse-chronological-order ;
 256
 257 : <list-changes-action> ( -- action )
 258     <page-action>
 259         [ list-changes "revisions" set-value ] >>init
 260         { wiki "changes" } >>template
 261
 262     <revisions-boilerplate> ;
 263
 264 : <list-changes-feed-action> ( -- action )
 265     <feed-action>
 266         [ URL" $wiki/changes" ] >>url
 267         [ "All changes" ] >>title
 268         [ list-changes ] >>entries ;
 269
 270 : <delete-action> ( -- action )
 271     <action>
 272
 273         [ validate-title ] >>validate
 274
 275         [
 276             "title" value <article> delete-tuples
 277             f <revision> "title" value >>title delete-tuples
 278             URL" $wiki" <redirect>
 279         ] >>submit
 280
 281      <protected>
 282         "delete wiki articles" >>description
 283         { can-delete-wiki-articles? } >>capabilities ;
 284
 285 : <diff-action> ( -- action )
 286     <page-action>
 287
 288         [
 289             {
 290                 { "old-id" [ v-integer ] }
 291                 { "new-id" [ v-integer ] }
 292             } validate-params
 293
 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
 305
 306         { wiki "diff" } >>template
 307
 308     <article-boilerplate> ;
 309
 310 : <list-articles-action> ( -- action )
 311     <page-action>
 312
 313         [
 314             f <article> select-tuples
 315             [ [ title>> ] compare ] sort
 316             "articles" set-value
 317         ] >>init
 318
 319         { wiki "articles" } >>template ;
 320
 321 : list-user-edits ( -- seq )
 322     f <revision> "author" value >>author select-tuples
 323     reverse-chronological-order ;
 324
 325 : <user-edits-action> ( -- action )
 326     <page-action>
 327
 328         "author" >>rest
 329
 330         [
 331             validate-author
 332             list-user-edits "revisions" set-value
 333         ] >>init
 334
 335         { wiki "user-edits" } >>template
 336
 337     <revisions-boilerplate> ;
 338
 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 ;
 346
 347 : init-sidebars ( -- )
 348     "Contents" latest-revision [ "contents" [ from-object ] nest-form ] when*
 349     "Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ;
 350
 351 : init-relative-link-prefix ( -- )
 352     URL" $wiki/view/" adjust-url present relative-link-prefix set ;
 353
 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 ;
 375
 376 : init-wiki ( -- )
 377     "resource:extra/webapps/wiki/initial-content" directory* keys
 378     [
 379         dup file-name ".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 ;