factor/extra/http/server/actions/actions.factor

! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors sequences kernel assocs combinators
http.server http.server.validators http hashtables namespaces
fry continuations locals boxes xml.entities html.elements io ;
IN: http.server.actions

SYMBOL: params

SYMBOL: validation-message

: render-validation-message ( -- )
    validation-message get value>> [
        <span "error" =class span>
            escape-string write
        </span>
    ] when* ;

TUPLE: action init display submit get-params post-params ;

: <action>
    action new
        [ ] >>init
        [ <400> ] >>display
        [ <400> ] >>submit ;

:: validate-param ( name validator assoc -- )
    name assoc at validator with-validator name set ; inline

: action-params ( validators -- error? )
    validation-failed? off
    params get '[ , validate-param ] assoc-each
    validation-failed? get ;

: handle-get ( -- response )
    action get get-params>> action-params [ <400> ] [
        action get [ init>> call ] [ display>> call ] bi
    ] if ;

: handle-post ( -- response )
    action get post-params>> action-params
    [ <400> ] [ action get submit>> call ] if ;

: validation-failed ( -- * )
    action get display>> call exit-with ;

: validation-failed-with ( string -- * )
    validation-message get >box
    validation-failed ;

M: action call-responder* ( path action -- response )
    '[
        , [ CHAR: / = ] right-trim empty? [
            , action set
            request get
            <box> validation-message set
            [ request-params params set ]
            [
                method>> {
                    { "GET" [ handle-get ] }
                    { "HEAD" [ handle-get ] }
                    { "POST" [ handle-post ] }
                } case
            ] bi
        ] [
            <404>
        ] if
    ] with-exit-continuation ;