extra/webapps/wiki/wiki.factor

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