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