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 kernel lcs
   7 make namespaces present random sequences sorting splitting urls
   8 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                 t link-no-follow? [
  93                     { wiki "view" } <chloe-content>
  94                 ] with-variable
  95             ] [
  96                 edit-url <redirect>
  97             ] ?if
  98         ] >>display
  99
 100     <article-boilerplate> ;
 101
 102 : <view-revision-action> ( -- action )
 103     <page-action>
 104
 105         "id" >>rest
 106
 107         [ validate-integer-id ] >>init
 108
 109         [
 110             "id" value <revision>
 111             select-tuple from-object
 112             t link-no-follow? [
 113                 { wiki "view" } <chloe-content>
 114             ] with-variable
 115         ] >>display
 116
 117     <article-boilerplate> ;
 118
 119 : <random-article-action> ( -- action )
 120     <action>
 121         [
 122             article new select-tuples random
 123             [ title>> ] [ "Front Page" ] if*
 124             view-url <redirect>
 125         ] >>display ;
 126
 127 : amend-article ( revision article -- )
 128     swap id>> >>revision update-tuple ;
 129
 130 : add-article ( revision -- )
 131     [ title>> ] [ id>> ] bi article boa insert-tuple ;
 132
 133 : add-revision ( revision -- )
 134     [ insert-tuple ]
 135     [
 136         dup title>> <article> select-tuple
 137         [ amend-article ] [ add-article ] if*
 138     ]
 139     bi ;
 140
 141 : <edit-article-action> ( -- action )
 142     <page-action>
 143
 144         "title" >>rest
 145
 146         [
 147             validate-title
 148
 149             "title" value <article> select-tuple
 150             [ revision>> <revision> select-tuple ]
 151             [ f <revision> "title" value >>title ]
 152             if*
 153
 154             [ title>> "title" set-value ]
 155             [ content>> "content" set-value ]
 156             bi
 157         ] >>init
 158
 159         { wiki "edit" } >>template
 160
 161     <article-boilerplate> ;
 162
 163 : <submit-article-action> ( -- action )
 164     <action>
 165         [
 166             validate-recaptcha
 167
 168             validate-title
 169
 170             {
 171                 { "content" [ v-required ] }
 172                 { "description" [ [ v-one-line ] v-optional ] }
 173             } validate-params
 174
 175             f <revision>
 176                 "title" value >>title
 177                 now >>date
 178                 username >>author
 179                 "content" value >>content
 180                 "description" value >>description
 181             [ add-revision ] [ title>> view-url <redirect> ] bi
 182         ] >>submit
 183
 184     <protected>
 185         "edit wiki articles" >>description ;
 186
 187 : <revisions-boilerplate> ( responder -- responder )
 188     <boilerplate>
 189         { wiki "revisions-common" } >>template ;
 190
 191 : list-revisions ( -- seq )
 192     f <revision> "title" value >>title select-tuples
 193     reverse-chronological-order ;
 194
 195 : <list-revisions-action> ( -- action )
 196     <page-action>
 197
 198         "title" >>rest
 199
 200         [
 201             validate-title
 202             list-revisions "revisions" set-value
 203         ] >>init
 204
 205         { wiki "revisions" } >>template
 206
 207     <revisions-boilerplate>
 208     <article-boilerplate> ;
 209
 210 : <list-revisions-feed-action> ( -- action )
 211     <feed-action>
 212
 213         "title" >>rest
 214
 215         [ validate-title ] >>init
 216
 217         [ "Revisions of " "title" value append ] >>title
 218
 219         [ "title" value revisions-url ] >>url
 220
 221         [ list-revisions ] >>entries ;
 222
 223 : rollback-description ( description -- description' )
 224     [ "Rollback to '" "'" surround ] [ "Rollback" ] if* ;
 225
 226 : <rollback-action> ( -- action )
 227     <action>
 228
 229         [ validate-integer-id ] >>validate
 230
 231         [
 232             "id" value <revision> select-tuple
 233                 f >>id
 234                 now >>date
 235                 username >>author
 236                 [ rollback-description ] change-description
 237             [ add-revision ]
 238             [ title>> revisions-url <redirect> ] bi
 239         ] >>submit
 240
 241     <protected>
 242         "rollback wiki articles" >>description ;
 243
 244 : list-changes ( -- seq )
 245     f <revision> select-tuples
 246     reverse-chronological-order ;
 247
 248 : <list-changes-action> ( -- action )
 249     <page-action>
 250         [ list-changes "revisions" set-value ] >>init
 251         { wiki "changes" } >>template
 252
 253     <revisions-boilerplate> ;
 254
 255 : <list-changes-feed-action> ( -- action )
 256     <feed-action>
 257         [ URL" $wiki/changes" ] >>url
 258         [ "All changes" ] >>title
 259         [ list-changes ] >>entries ;
 260
 261 : <delete-action> ( -- action )
 262     <action>
 263
 264         [ validate-title ] >>validate
 265
 266         [
 267             "title" value <article> delete-tuples
 268             f <revision> "title" value >>title delete-tuples
 269             URL" $wiki" <redirect>
 270         ] >>submit
 271
 272      <protected>
 273         "delete wiki articles" >>description
 274         { can-delete-wiki-articles? } >>capabilities ;
 275
 276 : <diff-action> ( -- action )
 277     <page-action>
 278
 279         [
 280             {
 281                 { "old-id" [ v-integer ] }
 282                 { "new-id" [ v-integer ] }
 283             } validate-params
 284
 285             "old-id" "new-id"
 286             [ value <revision> select-tuple ] bi@
 287             [
 288                 over title>> "title" set-value
 289                 [ "old" [ from-object ] nest-form ]
 290                 [ "new" [ from-object ] nest-form ]
 291                 bi*
 292             ]
 293             [ [ content>> split-lines ] bi@ lcs-diff "diff" set-value ]
 294             2bi
 295         ] >>init
 296
 297         { wiki "diff" } >>template
 298
 299     <article-boilerplate> ;
 300
 301 : <list-articles-action> ( -- action )
 302     <page-action>
 303
 304         [
 305             f <article> select-tuples
 306             [ title>> ] sort-with
 307             "articles" set-value
 308         ] >>init
 309
 310         { wiki "articles" } >>template ;
 311
 312 : list-user-edits ( -- seq )
 313     f <revision> "author" value >>author select-tuples
 314     reverse-chronological-order ;
 315
 316 : <user-edits-action> ( -- action )
 317     <page-action>
 318
 319         "author" >>rest
 320
 321         [
 322             validate-author
 323             list-user-edits "revisions" set-value
 324         ] >>init
 325
 326         { wiki "user-edits" } >>template
 327
 328     <revisions-boilerplate> ;
 329
 330 : <user-edits-feed-action> ( -- action )
 331     <feed-action>
 332         "author" >>rest
 333         [ validate-author ] >>init
 334         [ "Edits by " "author" value append ] >>title
 335         [ "author" value user-edits-url ] >>url
 336         [ list-user-edits ] >>entries ;
 337
 338 : init-sidebars ( -- )
 339     "Contents" latest-revision [ "contents" [ from-object ] nest-form ] when*
 340     "Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ;
 341
 342 : init-relative-link-prefix ( -- )
 343     URL" $wiki/view/" adjust-url present relative-link-prefix set ;
 344
 345 : <wiki> ( -- dispatcher )
 346     wiki new-dispatcher
 347         <main-article-action> "" add-responder
 348         <view-article-action> "view" add-responder
 349         <view-revision-action> "revision" add-responder
 350         <random-article-action> "random" add-responder
 351         <list-revisions-action> "revisions" add-responder
 352         <list-revisions-feed-action> "revisions.atom" add-responder
 353         <diff-action> "diff" add-responder
 354         <edit-article-action> "edit" add-responder
 355         <submit-article-action> "submit" add-responder
 356         <rollback-action> "rollback" add-responder
 357         <user-edits-action> "user-edits" add-responder
 358         <list-articles-action> "articles" add-responder
 359         <list-changes-action> "changes" add-responder
 360         <user-edits-feed-action> "user-edits.atom" add-responder
 361         <list-changes-feed-action> "changes.atom" add-responder
 362         <delete-action> "delete" add-responder
 363     <boilerplate>
 364         [ init-sidebars init-relative-link-prefix ] >>init
 365         { wiki "wiki-common" } >>template ;