69 lines
1.9 KiB
Factor
Executable File
69 lines
1.9 KiB
Factor
Executable File
! 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 ;
|