389 lines
10 KiB
Factor
389 lines
10 KiB
Factor
! Copyright (C) 2008 Slava Pestov
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: accessors kernel hashtables calendar random assocs
|
|
namespaces make splitting sequences sorting math.order present
|
|
io.files io.encodings.ascii
|
|
syndication farkup
|
|
html.components html.forms
|
|
http.server
|
|
http.server.dispatchers
|
|
furnace
|
|
furnace.actions
|
|
furnace.redirection
|
|
furnace.auth
|
|
furnace.auth.login
|
|
furnace.boilerplate
|
|
furnace.syndication
|
|
validators
|
|
db.types db.tuples lcs farkup urls ;
|
|
IN: webapps.wiki
|
|
|
|
: wiki-url ( rest path -- url )
|
|
[ "$wiki/" % % "/" % present % ] "" make
|
|
<url> swap >>path ;
|
|
|
|
: view-url ( title -- url ) "view" wiki-url ;
|
|
|
|
: edit-url ( title -- url ) "edit" wiki-url ;
|
|
|
|
: revisions-url ( title -- url ) "revisions" wiki-url ;
|
|
|
|
: revision-url ( id -- url ) "revision" wiki-url ;
|
|
|
|
: user-edits-url ( author -- url ) "user-edits" wiki-url ;
|
|
|
|
TUPLE: wiki < dispatcher ;
|
|
|
|
SYMBOL: can-delete-wiki-articles?
|
|
|
|
can-delete-wiki-articles? define-capability
|
|
|
|
TUPLE: article title revision ;
|
|
|
|
article "ARTICLES" {
|
|
{ "title" "TITLE" { VARCHAR 256 } +not-null+ +user-assigned-id+ }
|
|
{ "revision" "REVISION" INTEGER +not-null+ } ! revision id
|
|
} define-persistent
|
|
|
|
: <article> ( title -- article ) article new swap >>title ;
|
|
|
|
TUPLE: revision id title author date content parsed description ;
|
|
|
|
revision "REVISIONS" {
|
|
{ "id" "ID" INTEGER +db-assigned-id+ }
|
|
{ "title" "TITLE" { VARCHAR 256 } +not-null+ } ! article id
|
|
{ "author" "AUTHOR" { VARCHAR 256 } +not-null+ } ! uid
|
|
{ "date" "DATE" TIMESTAMP +not-null+ }
|
|
{ "content" "CONTENT" TEXT +not-null+ }
|
|
{ "parsed" "PARSED" FACTOR-BLOB +not-null+ } ! Farkup AST
|
|
{ "description" "DESCRIPTION" TEXT }
|
|
} define-persistent
|
|
|
|
M: revision feed-entry-title
|
|
[ title>> ] [ drop " by " ] [ author>> ] tri 3append ;
|
|
|
|
M: revision feed-entry-date date>> ;
|
|
|
|
M: revision feed-entry-url id>> revision-url ;
|
|
|
|
: reverse-chronological-order ( seq -- sorted )
|
|
[ [ date>> ] compare invert-comparison ] sort ;
|
|
|
|
: <revision> ( id -- revision )
|
|
revision new swap >>id ;
|
|
|
|
: compute-html ( revision -- )
|
|
dup content>> parse-farkup >>parsed drop ;
|
|
|
|
: validate-title ( -- )
|
|
{ { "title" [ v-one-line ] } } validate-params ;
|
|
|
|
: validate-author ( -- )
|
|
{ { "author" [ v-username ] } } validate-params ;
|
|
|
|
: <article-boilerplate> ( responder -- responder' )
|
|
<boilerplate>
|
|
{ wiki "page-common" } >>template ;
|
|
|
|
: <main-article-action> ( -- action )
|
|
<action>
|
|
[ "Front Page" view-url <redirect> ] >>display ;
|
|
|
|
: latest-revision ( title -- revision/f )
|
|
<article> select-tuple
|
|
dup [ revision>> <revision> select-tuple ] when ;
|
|
|
|
: <view-article-action> ( -- action )
|
|
<action>
|
|
|
|
"title" >>rest
|
|
|
|
[ validate-title ] >>init
|
|
|
|
[
|
|
"title" value dup latest-revision [
|
|
from-object
|
|
{ wiki "view" } <chloe-content>
|
|
] [
|
|
edit-url <redirect>
|
|
] ?if
|
|
] >>display
|
|
|
|
<article-boilerplate> ;
|
|
|
|
: <view-revision-action> ( -- action )
|
|
<page-action>
|
|
|
|
"id" >>rest
|
|
|
|
[
|
|
validate-integer-id
|
|
"id" value <revision>
|
|
select-tuple from-object
|
|
] >>init
|
|
|
|
{ wiki "view" } >>template
|
|
|
|
<article-boilerplate> ;
|
|
|
|
: <random-article-action> ( -- action )
|
|
<action>
|
|
[
|
|
article new select-tuples random
|
|
[ title>> ] [ "Front Page" ] if*
|
|
view-url <redirect>
|
|
] >>display ;
|
|
|
|
: amend-article ( revision article -- )
|
|
swap id>> >>revision update-tuple ;
|
|
|
|
: add-article ( revision -- )
|
|
[ title>> ] [ id>> ] bi article boa insert-tuple ;
|
|
|
|
: add-revision ( revision -- )
|
|
[ compute-html ]
|
|
[ insert-tuple ]
|
|
[
|
|
dup title>> <article> select-tuple
|
|
[ amend-article ] [ add-article ] if*
|
|
]
|
|
tri ;
|
|
|
|
: <edit-article-action> ( -- action )
|
|
<page-action>
|
|
|
|
"title" >>rest
|
|
|
|
[
|
|
validate-title
|
|
|
|
"title" value <article> select-tuple
|
|
[ revision>> <revision> select-tuple ]
|
|
[ f <revision> "title" value >>title ]
|
|
if*
|
|
|
|
[ title>> "title" set-value ]
|
|
[ content>> "content" set-value ]
|
|
bi
|
|
] >>init
|
|
|
|
{ wiki "edit" } >>template
|
|
|
|
<article-boilerplate> ;
|
|
|
|
: <submit-article-action> ( -- action )
|
|
<action>
|
|
[
|
|
validate-title
|
|
|
|
{
|
|
{ "content" [ v-required ] }
|
|
{ "description" [ [ v-one-line ] v-optional ] }
|
|
} validate-params
|
|
|
|
f <revision>
|
|
"title" value >>title
|
|
now >>date
|
|
username >>author
|
|
"content" value >>content
|
|
"description" value >>description
|
|
[ add-revision ] [ title>> view-url <redirect> ] bi
|
|
] >>submit
|
|
|
|
<protected>
|
|
"edit wiki articles" >>description ;
|
|
|
|
: <revisions-boilerplate> ( responder -- responder )
|
|
<boilerplate>
|
|
{ wiki "revisions-common" } >>template ;
|
|
|
|
: list-revisions ( -- seq )
|
|
f <revision> "title" value >>title select-tuples
|
|
reverse-chronological-order ;
|
|
|
|
: <list-revisions-action> ( -- action )
|
|
<page-action>
|
|
|
|
"title" >>rest
|
|
|
|
[
|
|
validate-title
|
|
list-revisions "revisions" set-value
|
|
] >>init
|
|
|
|
{ wiki "revisions" } >>template
|
|
|
|
<revisions-boilerplate>
|
|
<article-boilerplate> ;
|
|
|
|
: <list-revisions-feed-action> ( -- action )
|
|
<feed-action>
|
|
|
|
"title" >>rest
|
|
|
|
[ validate-title ] >>init
|
|
|
|
[ "Revisions of " "title" value append ] >>title
|
|
|
|
[ "title" value revisions-url ] >>url
|
|
|
|
[ list-revisions ] >>entries ;
|
|
|
|
: rollback-description ( description -- description' )
|
|
[ "Rollback of '" swap "'" 3append ] [ "Rollback" ] if* ;
|
|
|
|
: <rollback-action> ( -- action )
|
|
<action>
|
|
|
|
[ validate-integer-id ] >>validate
|
|
|
|
[
|
|
"id" value <revision> select-tuple
|
|
f >>id
|
|
now >>date
|
|
username >>author
|
|
[ rollback-description ] change-description
|
|
[ add-revision ]
|
|
[ title>> revisions-url <redirect> ] bi
|
|
] >>submit
|
|
|
|
<protected>
|
|
"rollback wiki articles" >>description ;
|
|
|
|
: list-changes ( -- seq )
|
|
f <revision> select-tuples
|
|
reverse-chronological-order ;
|
|
|
|
: <list-changes-action> ( -- action )
|
|
<page-action>
|
|
[ list-changes "revisions" set-value ] >>init
|
|
{ wiki "changes" } >>template
|
|
|
|
<revisions-boilerplate> ;
|
|
|
|
: <list-changes-feed-action> ( -- action )
|
|
<feed-action>
|
|
[ URL" $wiki/changes" ] >>url
|
|
[ "All changes" ] >>title
|
|
[ list-changes ] >>entries ;
|
|
|
|
: <delete-action> ( -- action )
|
|
<action>
|
|
|
|
[ validate-title ] >>validate
|
|
|
|
[
|
|
"title" value <article> delete-tuples
|
|
f <revision> "title" value >>title delete-tuples
|
|
URL" $wiki" <redirect>
|
|
] >>submit
|
|
|
|
<protected>
|
|
"delete wiki articles" >>description
|
|
{ can-delete-wiki-articles? } >>capabilities ;
|
|
|
|
: <diff-action> ( -- action )
|
|
<page-action>
|
|
|
|
[
|
|
{
|
|
{ "old-id" [ v-integer ] }
|
|
{ "new-id" [ v-integer ] }
|
|
} validate-params
|
|
|
|
"old-id" "new-id"
|
|
[ value <revision> select-tuple ] bi@
|
|
[
|
|
over title>> "title" set-value
|
|
[ "old" [ from-object ] nest-form ]
|
|
[ "new" [ from-object ] nest-form ]
|
|
bi*
|
|
]
|
|
[ [ content>> string-lines ] bi@ diff "diff" set-value ]
|
|
2bi
|
|
] >>init
|
|
|
|
{ wiki "diff" } >>template
|
|
|
|
<article-boilerplate> ;
|
|
|
|
: <list-articles-action> ( -- action )
|
|
<page-action>
|
|
|
|
[
|
|
f <article> select-tuples
|
|
[ [ title>> ] compare ] sort
|
|
"articles" set-value
|
|
] >>init
|
|
|
|
{ wiki "articles" } >>template ;
|
|
|
|
: list-user-edits ( -- seq )
|
|
f <revision> "author" value >>author select-tuples
|
|
reverse-chronological-order ;
|
|
|
|
: <user-edits-action> ( -- action )
|
|
<page-action>
|
|
|
|
"author" >>rest
|
|
|
|
[
|
|
validate-author
|
|
list-user-edits "revisions" set-value
|
|
] >>init
|
|
|
|
{ wiki "user-edits" } >>template
|
|
|
|
<revisions-boilerplate> ;
|
|
|
|
: <user-edits-feed-action> ( -- action )
|
|
<feed-action>
|
|
"author" >>rest
|
|
[ validate-author ] >>init
|
|
[ "Edits by " "author" value append ] >>title
|
|
[ "author" value user-edits-url ] >>url
|
|
[ list-user-edits ] >>entries ;
|
|
|
|
: init-sidebars ( -- )
|
|
"Contents" latest-revision [ "contents" [ from-object ] nest-form ] when*
|
|
"Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ;
|
|
|
|
: init-relative-link-prefix ( -- )
|
|
URL" $wiki/view/" adjust-url present relative-link-prefix set ;
|
|
|
|
: <wiki> ( -- dispatcher )
|
|
wiki new-dispatcher
|
|
<main-article-action> "" add-responder
|
|
<view-article-action> "view" add-responder
|
|
<view-revision-action> "revision" add-responder
|
|
<random-article-action> "random" add-responder
|
|
<list-revisions-action> "revisions" add-responder
|
|
<list-revisions-feed-action> "revisions.atom" add-responder
|
|
<diff-action> "diff" add-responder
|
|
<edit-article-action> "edit" add-responder
|
|
<submit-article-action> "submit" add-responder
|
|
<rollback-action> "rollback" add-responder
|
|
<user-edits-action> "user-edits" add-responder
|
|
<list-articles-action> "articles" add-responder
|
|
<list-changes-action> "changes" add-responder
|
|
<user-edits-feed-action> "user-edits.atom" add-responder
|
|
<list-changes-feed-action> "changes.atom" add-responder
|
|
<delete-action> "delete" add-responder
|
|
<boilerplate>
|
|
[ init-sidebars init-relative-link-prefix ] >>init
|
|
{ wiki "wiki-common" } >>template ;
|
|
|
|
: init-wiki ( -- )
|
|
"resource:extra/webapps/wiki/initial-content" directory* keys
|
|
[
|
|
dup file-name ".txt" ?tail [
|
|
swap ascii file-contents
|
|
f <revision>
|
|
swap >>content
|
|
swap >>title
|
|
"slava" >>author
|
|
now >>date
|
|
add-revision
|
|
] [ 2drop ] if
|
|
] each ;
|