1 ! Copyright (C) 2008, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors sequences kernel assocs combinators
4 validators http hashtables namespaces fry continuations locals
5 io arrays math boxes splitting urls
16 html.templates.chloe.syntax
17 html.templates.chloe.compiler ;
22 TUPLE: action rest init authorize display validate submit ;
24 : new-action ( class -- action )
25 new [ ] >>init [ ] >>validate [ ] >>authorize ; inline
27 : <action> ( -- action )
30 : merge-forms ( form -- )
32 [ [ errors>> ] bi@ append! drop ]
33 [ [ values>> ] bi@ assoc-union! drop ]
34 [ validation-failed>> >>validation-failed drop ]
37 : set-nested-form ( form name -- )
41 unclip [ set-nested-form ] nest-form
44 : restore-validation-errors ( -- )
46 nested-forms cget set-nested-form
49 : handle-get ( action -- response )
54 [ authorize>> call( -- ) ]
55 [ drop restore-validation-errors ]
56 [ display>> call( -- response ) ]
59 ] with-exit-continuation ;
61 CONSTANT: revalidate-url-key "__u"
63 : revalidate-url ( -- url/f )
64 revalidate-url-key param
65 dup [ >url ensure-port [ same-host? ] keep and ] when ;
67 : validation-failed ( -- * )
68 post-request? revalidate-url and [
70 nested-forms-key param " " split harvest nested-forms cset
72 <continue-conversation>
76 : handle-post ( action -- response )
79 [ validate>> call( -- ) ]
80 [ authorize>> call( -- ) ]
81 [ submit>> call( -- response ) ]
84 ] with-exit-continuation ;
86 : handle-rest ( path action -- )
87 rest>> [ [ "/" join ] dip set-param ] [ drop ] if* ;
89 : init-action ( path action -- )
93 M: action call-responder* ( path action -- response )
95 request get method>> {
96 { "GET" [ handle-get ] }
97 { "HEAD" [ handle-get ] }
98 { "POST" [ handle-post ] }
101 M: action modify-form
102 drop url get revalidate-url-key hidden-form-field ;
104 : check-validation ( -- )
105 validation-failed? [ validation-failed ] when ;
107 : validate-params ( validators -- )
108 params get swap validate-values check-validation ;
110 : validate-integer-id ( -- )
111 { { "id" [ v-number ] } } validate-params ;
113 TUPLE: page-action < action template ;
115 : <chloe-content> ( path -- response )
116 resolve-template-path <chloe> <html-content> ;
118 : <page-action> ( -- page )
119 page-action new-action
120 dup '[ _ template>> <chloe-content> ] >>display ;