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
   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 ;
  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 } define-persistent
  59
  60 M: revision feed-entry-title
  61     [ title>> ] [ drop " by " ] [ author>> ] tri 3append ;
  62
  63 M: revision feed-entry-date date>> ;
  64
  65 M: revision feed-entry-url id>> revision-url ;
  66
  67 : reverse-chronological-order ( seq -- sorted )
  68     [ [ date>> ] compare invert-comparison ] sort ;
  69
  70 : <revision> ( id -- revision )
  71     revision new swap >>id ;
  72
  73 : validate-title ( -- )
  74     { { "title" [ v-one-line ] } } validate-params ;
  75
  76 : validate-author ( -- )
  77     { { "author" [ v-username ] } } validate-params ;
  78
  79 : <main-article-action> ( -- action )
  80     <action>
  81         [ "Front Page" view-url <redirect> ] >>display ;
  82
  83 : latest-revision ( title -- revision/f )
  84     <article> select-tuple
  85     dup [ revision>> <revision> select-tuple ] when ;
  86
  87 : <view-article-action> ( -- action )
  88     <action>
  89
  90         "title" >>rest
  91
  92         [
  93             validate-title
  94         ] >>init
  95
  96         [
  97             "title" value dup latest-revision [
  98                 from-object
  99                 { wiki "view" } <chloe-content>
 100             ] [
 101                 edit-url <redirect>
 102             ] ?if
 103         ] >>display ;
 104
 105 : <view-revision-action> ( -- action )
 106     <page-action>
 107
 108         "id" >>rest
 109
 110         [
 111             validate-integer-id
 112             "id" value <revision>
 113             select-tuple from-object
 114             URL" $wiki/view/" adjust-url present relative-link-prefix set
 115         ] >>init
 116
 117         { wiki "view" } >>template ;
 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     ] bi ;
 139
 140 : <edit-article-action> ( -- action )
 141     <page-action>
 142
 143         "title" >>rest
 144
 145         [
 146             validate-title
 147             "title" value <article> select-tuple [
 148                 revision>> <revision> select-tuple from-object
 149             ] when*
 150         ] >>init
 151
 152         { wiki "edit" } >>template
 153
 154         [
 155             validate-title
 156             { { "content" [ v-required ] } } validate-params
 157
 158             f <revision>
 159                 "title" value >>title
 160                 now >>date
 161                 logged-in-user get username>> >>author
 162                 "content" value >>content
 163             [ add-revision ] [ title>> view-url <redirect> ] bi
 164         ] >>submit
 165
 166     <protected>
 167         "edit wiki articles" >>description ;
 168
 169 : list-revisions ( -- seq )
 170     f <revision> "title" value >>title select-tuples
 171     reverse-chronological-order ;
 172
 173 : <list-revisions-action> ( -- action )
 174     <page-action>
 175
 176         "title" >>rest
 177
 178         [
 179             validate-title
 180             list-revisions "revisions" set-value
 181         ] >>init
 182
 183         { wiki "revisions" } >>template ;
 184
 185 : <list-revisions-feed-action> ( -- action )
 186     <feed-action>
 187
 188         "title" >>rest
 189
 190         [ validate-title ] >>init
 191
 192         [ "Revisions of " "title" value append ] >>title
 193
 194         [ "title" value revisions-url ] >>url
 195
 196         [ list-revisions ] >>entries ;
 197
 198 : <rollback-action> ( -- action )
 199     <action>
 200
 201         [ validate-integer-id ] >>validate
 202
 203         [
 204             "id" value <revision> select-tuple clone f >>id
 205             [ add-revision ] [ title>> view-url <redirect> ] bi
 206         ] >>submit ;
 207
 208 : list-changes ( -- seq )
 209     f <revision> select-tuples
 210     reverse-chronological-order ;
 211
 212 : <list-changes-action> ( -- action )
 213     <page-action>
 214         [ list-changes "changes" set-value ] >>init
 215         { wiki "changes" } >>template ;
 216
 217 : <list-changes-feed-action> ( -- action )
 218     <feed-action>
 219         [ URL" $wiki/changes" ] >>url
 220         [ "All changes" ] >>title
 221         [ list-changes ] >>entries ;
 222
 223 : <delete-action> ( -- action )
 224     <action>
 225
 226         [ validate-title ] >>validate
 227
 228         [
 229             "title" value <article> delete-tuples
 230             f <revision> "title" value >>title delete-tuples
 231             URL" $wiki" <redirect>
 232         ] >>submit
 233
 234      <protected>
 235         "delete wiki articles" >>description
 236         { can-delete-wiki-articles? } >>capabilities ;
 237
 238 : <diff-action> ( -- action )
 239     <page-action>
 240         [
 241             {
 242                 { "old-id" [ v-integer ] }
 243                 { "new-id" [ v-integer ] }
 244             } validate-params
 245
 246             "old-id" "new-id"
 247             [ value <revision> select-tuple ] bi@
 248             [
 249                 [ [ title>> "title" set-value ] [ "old" [ from-object ] nest-form ] bi ]
 250                 [ "new" [ from-object ] nest-form ] bi*
 251             ]
 252             [ [ content>> string-lines ] bi@ diff "diff" set-value ]
 253             2bi
 254         ] >>init
 255
 256         { wiki "diff" } >>template ;
 257
 258 : <list-articles-action> ( -- action )
 259     <page-action>
 260
 261         [
 262             f <article> select-tuples
 263             [ [ title>> ] compare ] sort
 264             "articles" set-value
 265         ] >>init
 266
 267         { wiki "articles" } >>template ;
 268
 269 : list-user-edits ( -- seq )
 270     f <revision> "author" value >>author select-tuples
 271     reverse-chronological-order ;
 272
 273 : <user-edits-action> ( -- action )
 274     <page-action>
 275
 276         "author" >>rest
 277
 278         [
 279             validate-author
 280             list-user-edits "user-edits" set-value
 281         ] >>init
 282
 283         { wiki "user-edits" } >>template ;
 284
 285 : <user-edits-feed-action> ( -- action )
 286     <feed-action>
 287         "author" >>rest
 288         [ validate-author ] >>init
 289         [ "Edits by " "author" value append ] >>title
 290         [ "author" value user-edits-url ] >>url
 291         [ list-user-edits ] >>entries ;
 292
 293 : <article-boilerplate> ( responder -- responder' )
 294     <boilerplate>
 295         { wiki "page-common" } >>template ;
 296
 297 : init-sidebar ( -- )
 298     "Sidebar" latest-revision [ "sidebar" [ from-object ] nest-form ] when*
 299     "Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ;
 300
 301 : <wiki> ( -- dispatcher )
 302     wiki new-dispatcher
 303         <main-article-action> <article-boilerplate> "" add-responder
 304         <view-article-action> <article-boilerplate> "view" add-responder
 305         <view-revision-action> <article-boilerplate> "revision" add-responder
 306         <random-article-action> "random" add-responder
 307         <list-revisions-action> <article-boilerplate> "revisions" add-responder
 308         <list-revisions-feed-action> "revisions.atom" add-responder
 309         <diff-action> <article-boilerplate> "diff" add-responder
 310         <edit-article-action> <article-boilerplate> "edit" add-responder
 311         <rollback-action> "rollback" add-responder
 312         <user-edits-action> "user-edits" add-responder
 313         <list-articles-action> "articles" add-responder
 314         <list-changes-action> "changes" add-responder
 315         <user-edits-feed-action> "user-edits.atom" add-responder
 316         <list-changes-feed-action> "changes.atom" add-responder
 317         <delete-action> "delete" add-responder
 318     <boilerplate>
 319         [ init-sidebar ] >>init
 320         { wiki "wiki-common" } >>template ;
 321
 322 : init-wiki ( -- )
 323     "resource:extra/webapps/wiki/initial-content" directory* keys
 324     [
 325         [ ascii file-contents ] [ file-name "." split1 drop ] bi
 326         f <revision>
 327             swap >>title
 328             swap >>content
 329             "slava" >>author
 330             now >>date
 331         add-revision
 332     ] each ;