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