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
   4 namespaces splitting sequences sorting math.order
   5 html.components syndication
   6 http.server
   7 http.server.dispatchers
   8 furnace
   9 furnace.actions
  10 furnace.auth
  11 furnace.auth.login
  12 furnace.boilerplate
  13 furnace.syndication
  14 validators
  15 db.types db.tuples lcs farkup urls ;
  16 IN: webapps.wiki
  17
  18 : view-url ( title -- url )
  19     "$wiki/view/" prepend >url ;
  20
  21 : edit-url ( title -- url )
  22     "$wiki/edit" >url swap "title" set-query-param ;
  23
  24 : revisions-url ( title -- url )
  25     "$wiki/revisions" >url swap "title" set-query-param ;
  26
  27 : revision-url ( id -- url )
  28     "$wiki/revision" >url swap "id" set-query-param ;
  29
  30 : user-edits-url ( author -- url )
  31     "$wiki/user-edits" >url swap "author" set-query-param ;
  32
  33 TUPLE: wiki < dispatcher ;
  34
  35 TUPLE: article title revision ;
  36
  37 article "ARTICLES" {
  38     { "title" "TITLE" { VARCHAR 256 } +not-null+ +user-assigned-id+ }
  39     ! { "AUTHOR" INTEGER +not-null+ } ! uid
  40     ! { "PROTECTED" BOOLEAN +not-null+ }
  41     { "revision" "REVISION" INTEGER +not-null+ } ! revision id
  42 } define-persistent
  43
  44 : <article> ( title -- article ) article new swap >>title ;
  45
  46 : init-articles-table ( -- ) article ensure-table ;
  47
  48 TUPLE: revision id title author date content ;
  49
  50 revision "REVISIONS" {
  51     { "id" "ID" INTEGER +db-assigned-id+ }
  52     { "title" "TITLE" { VARCHAR 256 } +not-null+ } ! article id
  53     { "author" "AUTHOR" { VARCHAR 256 } +not-null+ } ! uid
  54     { "date" "DATE" TIMESTAMP +not-null+ }
  55     { "content" "CONTENT" TEXT +not-null+ }
  56 } define-persistent
  57
  58 M: revision feed-entry-title
  59     [ title>> ] [ drop " by " ] [ author>> ] tri 3append ;
  60
  61 M: revision feed-entry-date date>> ;
  62
  63 M: revision feed-entry-url id>> revision-url ;
  64
  65 : reverse-chronological-order ( seq -- sorted )
  66     [ [ date>> ] compare invert-comparison ] sort ;
  67
  68 : <revision> ( id -- revision )
  69     revision new swap >>id ;
  70
  71 : init-revisions-table ( -- ) revision ensure-table ;
  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 : <view-article-action> ( -- action )
  84     <action>
  85         "title" >>rest
  86
  87         [
  88             validate-title
  89             "view?title=" relative-link-prefix set
  90         ] >>init
  91
  92         [
  93             "title" value dup <article> select-tuple [
  94                 revision>> <revision> select-tuple from-object
  95                 { wiki "view" } <chloe-content>
  96             ] [
  97                 edit-url <redirect>
  98             ] ?if
  99         ] >>display ;
 100
 101 : <view-revision-action> ( -- action )
 102     <page-action>
 103         [
 104             validate-integer-id
 105             "id" value <revision>
 106             select-tuple from-object
 107             "view?title=" relative-link-prefix set
 108         ] >>init
 109
 110         { wiki "view" } >>template ;
 111
 112 : add-revision ( revision -- )
 113     [ insert-tuple ]
 114     [
 115         dup title>> <article> select-tuple [
 116             swap id>> >>revision update-tuple
 117         ] [
 118             [ title>> ] [ id>> ] bi article boa insert-tuple
 119         ] if*
 120     ] bi ;
 121
 122 : <edit-article-action> ( -- action )
 123     <page-action>
 124         [
 125             validate-title
 126             "title" value <article> select-tuple [
 127                 revision>> <revision> select-tuple from-object
 128             ] when*
 129         ] >>init
 130
 131         { wiki "edit" } >>template
 132
 133         [
 134             validate-title
 135             { { "content" [ v-required ] } } validate-params
 136
 137             f <revision>
 138                 "title" value >>title
 139                 now >>date
 140                 logged-in-user get username>> >>author
 141                 "content" value >>content
 142             [ add-revision ] [ title>> view-url <redirect> ] bi
 143         ] >>submit ;
 144
 145 : list-revisions ( -- seq )
 146     f <revision> "title" value >>title select-tuples
 147     reverse-chronological-order ;
 148
 149 : <list-revisions-action> ( -- action )
 150     <page-action>
 151         [
 152             validate-title
 153             list-revisions "revisions" set-value
 154         ] >>init
 155         { wiki "revisions" } >>template ;
 156
 157 : <list-revisions-feed-action> ( -- action )
 158     <feed-action>
 159         [ validate-title ] >>init
 160         [ "Revisions of " "title" value append ] >>title
 161         [ "title" value revisions-url ] >>url
 162         [ list-revisions ] >>entries ;
 163
 164 : <rollback-action> ( -- action )
 165     <action>
 166         [ validate-integer-id ] >>validate
 167
 168         [
 169             "id" value <revision> select-tuple clone f >>id
 170             [ add-revision ] [ title>> view-url <redirect> ] bi
 171         ] >>submit ;
 172
 173 : list-changes ( -- seq )
 174     "id" value <revision> select-tuples
 175     reverse-chronological-order ;
 176
 177 : <list-changes-action> ( -- action )
 178     <page-action>
 179         [ list-changes "changes" set-value ] >>init
 180
 181         { wiki "changes" } >>template ;
 182
 183 : <list-changes-feed-action> ( -- action )
 184     <feed-action>
 185         [ URL" $wiki/changes" ] >>url
 186         [ "All changes" ] >>title
 187         [ list-changes ] >>entries ;
 188
 189 : <delete-action> ( -- action )
 190     <action>
 191         [ validate-title ] >>validate
 192
 193         [
 194             "title" value <article> delete-tuples
 195             f <revision> "title" value >>title delete-tuples
 196             URL" $wiki" <redirect>
 197         ] >>submit ;
 198
 199 : <diff-action> ( -- action )
 200     <page-action>
 201         [
 202             {
 203                 { "old-id" [ v-integer ] }
 204                 { "new-id" [ v-integer ] }
 205             } validate-params
 206
 207             "old-id" "new-id"
 208             [ value <revision> select-tuple ] bi@
 209             [
 210                 [ [ title>> "title" set-value ] [ "old" set-value ] bi ]
 211                 [ "new" set-value ] bi*
 212             ]
 213             [ [ content>> string-lines ] bi@ diff "diff" set-value ]
 214             2bi
 215         ] >>init
 216
 217         { wiki "diff" } >>template ;
 218
 219 : <list-articles-action> ( -- action )
 220     <page-action>
 221         [
 222             f <article> select-tuples
 223             [ [ title>> ] compare ] sort
 224             "articles" set-value
 225         ] >>init
 226
 227         { wiki "articles" } >>template ;
 228
 229 : list-user-edits ( -- seq )
 230     f <revision> "author" value >>author select-tuples
 231     reverse-chronological-order ;
 232
 233 : <user-edits-action> ( -- action )
 234     <page-action>
 235         [
 236             validate-author
 237             list-user-edits "user-edits" set-value
 238         ] >>init
 239         { wiki "user-edits" } >>template ;
 240
 241 : <user-edits-feed-action> ( -- action )
 242     <feed-action>
 243         [ validate-author ] >>init
 244         [ "Edits by " "author" value append ] >>title
 245         [ "author" value user-edits-url ] >>url
 246         [ list-user-edits ] >>entries ;
 247
 248 SYMBOL: can-delete-wiki-articles?
 249
 250 can-delete-wiki-articles? define-capability
 251
 252 : <article-boilerplate> ( responder -- responder' )
 253     <boilerplate>
 254         { wiki "page-common" } >>template ;
 255
 256 : <wiki> ( -- dispatcher )
 257     wiki new-dispatcher
 258         <main-article-action> <article-boilerplate> "" add-responder
 259         <view-article-action> <article-boilerplate> "view" add-responder
 260         <view-revision-action> <article-boilerplate> "revision" add-responder
 261         <list-revisions-action> <article-boilerplate> "revisions" add-responder
 262         <list-revisions-feed-action> "revisions.atom" add-responder
 263         <diff-action> <article-boilerplate> "diff" add-responder
 264         <edit-article-action> <article-boilerplate> <protected>
 265             "edit wiki articles" >>description
 266             "edit" add-responder
 267         <rollback-action> "rollback" add-responder
 268         <user-edits-action> "user-edits" add-responder
 269         <list-articles-action> "articles" add-responder
 270         <list-changes-action> "changes" add-responder
 271         <user-edits-feed-action> "user-edits.atom" add-responder
 272         <list-changes-feed-action> "changes.atom" add-responder
 273         <delete-action> <protected>
 274             "delete wiki articles" >>description
 275             { can-delete-wiki-articles? } >>capabilities
 276         "delete" add-responder
 277     <boilerplate>
 278         { wiki "wiki-common" } >>template ;