extra/webapps/wiki/wiki.factor

   1 ! Copyright (C) 2008 Slava Pestov
   2 ! See https://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-by ;
  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
  92             [
  93                 latest-revision
  94             ] [
  95                 from-object
  96                 { wiki "view" } <chloe-content>
  97             ] [
  98                 edit-url <redirect>
  99             ] ?if
 100         ] >>display
 101
 102     <article-boilerplate> ;
 103
 104 : <view-revision-action> ( -- action )
 105     <page-action>
 106
 107         "id" >>rest
 108
 109         [
 110             validate-integer-id
 111             "id" value <revision>
 112             select-tuple from-object
 113         ] >>init
 114
 115         { wiki "view" } >>template
 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-by
 307             "articles" set-value
 308         ] >>init
 309
 310         { wiki "articles" } >>template ;
 311
 312 : <search-articles-action> ( -- action )
 313     <page-action>
 314
 315         [
 316             "search" param [ unicode:blank? ] trim
 317             dup "search" set-value
 318
 319             [ f ] [
 320                 tokenize [
 321                     " " "\s+" replace "\\b" dup surround
 322                     "i" <optioned-regexp>
 323                 ] map
 324             ] if-empty
 325
 326             [ f ] [
 327                 f <article> select-tuples
 328                 [ title>> ] sort-by
 329                 [ revision>> <revision> select-tuple ] map
 330                 swap '[ content>> _ [ first-match ] with all? ] filter
 331             ] if-empty
 332
 333             [ "results" set-value ]
 334             [ not "empty" set-value ] bi
 335         ] >>init
 336
 337         { wiki "search" } >>template ;
 338
 339 : list-user-edits ( -- seq )
 340     f <revision> "author" value >>author select-tuples
 341     reverse-chronological-order ;
 342
 343 : <user-edits-action> ( -- action )
 344     <page-action>
 345
 346         "author" >>rest
 347
 348         [
 349             validate-author
 350             list-user-edits "revisions" set-value
 351         ] >>init
 352
 353         { wiki "user-edits" } >>template
 354
 355     <revisions-boilerplate> ;
 356
 357 : <user-edits-feed-action> ( -- action )
 358     <feed-action>
 359         "author" >>rest
 360         [ validate-author ] >>init
 361         [ "Edits by " "author" value append ] >>title
 362         [ "author" value user-edits-url ] >>url
 363         [ list-user-edits ] >>entries ;
 364
 365 : init-sidebars ( -- )
 366     "Contents" latest-revision [ "contents" [ from-object ] nest-form ] when*
 367     "Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ;
 368
 369 : init-relative-link-prefix ( -- )
 370     URL" $wiki/view/" adjust-url present relative-link-prefix set ;
 371
 372 : <wiki> ( -- dispatcher )
 373     wiki new-dispatcher
 374         <main-article-action> "" add-responder
 375         <view-article-action> "view" add-responder
 376         <view-revision-action> "revision" add-responder
 377         <random-article-action> "random" add-responder
 378         <list-revisions-action> "revisions" add-responder
 379         <list-revisions-feed-action> "revisions.atom" add-responder
 380         <diff-action> "diff" add-responder
 381         <edit-article-action> "edit" add-responder
 382         <submit-article-action> "submit" add-responder
 383         <rollback-action> "rollback" add-responder
 384         <user-edits-action> "user-edits" add-responder
 385         <list-articles-action> "articles" add-responder
 386         <search-articles-action> "search" add-responder
 387         <list-changes-action> "changes" add-responder
 388         <user-edits-feed-action> "user-edits.atom" add-responder
 389         <list-changes-feed-action> "changes.atom" add-responder
 390         <delete-action> "delete" add-responder
 391         "vocab:webapps/wiki/icons/" <static> "icons" add-responder
 392     <boilerplate>
 393         [ init-sidebars init-relative-link-prefix ] >>init
 394         { wiki "wiki-common" } >>template ;