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