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