! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel hashtables calendar random assocs
namespaces 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/" % % "/" % % ] "" 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 html 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+ }
    { "html" "HTML" TEXT +not-null+ } ! Farkup converted to HTML
    { "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>> convert-farkup >>html 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 ;

: init-relative-link-prefix ( -- )
    URL" $wiki/view/" adjust-url present relative-link-prefix set ;

: <view-article-action> ( -- action )
    <action>

        "title" >>rest

        [
            validate-title
            init-relative-link-prefix
        ] >>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-relative-link-prefix
        ] >>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-sidebar ( -- )
    "Sidebar" latest-revision [ "sidebar" [ from-object ] nest-form ] when*
    "Footer" latest-revision [ "footer" [ from-object ] nest-form ] when* ;

: <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-sidebar ] >>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 ;