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.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.recaptcha
  13 furnace.redirection
  14 furnace.auth
  15 furnace.auth.login
  16 furnace.boilerplate
  17 furnace.syndication
  18 validators
  19 db.types db.tuples lcs urls ;
  20 IN: 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
  36 TUPLE: wiki < dispatcher ;
  37
  38 SYMBOL: can-delete-wiki-articles?
  39
  40 can-delete-wiki-articles? define-capability
  41
  42 TUPLE: article title revision ;
  43
  44 article "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
  51 TUPLE: revision id title author date content description ;
  52
  53 revision "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
  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>> ] 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 ;