Tweak some furnace code to infer and load with almost no warnings
parent
ca4d60095b
commit
8e55533bfa
|
@ -149,4 +149,4 @@ M: db-connection rollback-transaction ( -- ) "ROLLBACK" sql-command ;
|
|||
t in-transaction [
|
||||
begin-transaction
|
||||
[ ] [ rollback-transaction ] cleanup commit-transaction
|
||||
] with-variable ;
|
||||
] with-variable ; inline
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors sequences kernel assocs combinators
|
||||
validators http hashtables namespaces fry continuations locals
|
||||
io arrays math boxes splitting urls
|
||||
io arrays math boxes splitting urls call
|
||||
xml.entities
|
||||
http.server
|
||||
http.server.responses
|
||||
|
@ -52,10 +52,10 @@ TUPLE: action rest init authorize display validate submit ;
|
|||
'[
|
||||
_ dup display>> [
|
||||
{
|
||||
[ init>> call ]
|
||||
[ authorize>> call ]
|
||||
[ init>> call( -- ) ]
|
||||
[ authorize>> call( -- ) ]
|
||||
[ drop restore-validation-errors ]
|
||||
[ display>> call ]
|
||||
[ display>> call( -- response ) ]
|
||||
} cleave
|
||||
] [ drop <400> ] if
|
||||
] with-exit-continuation ;
|
||||
|
@ -81,9 +81,9 @@ CONSTANT: revalidate-url-key "__u"
|
|||
: handle-post ( action -- response )
|
||||
'[
|
||||
_ dup submit>> [
|
||||
[ validate>> call ]
|
||||
[ authorize>> call ]
|
||||
[ submit>> call ]
|
||||
[ validate>> call( -- ) ]
|
||||
[ authorize>> call( -- ) ]
|
||||
[ submit>> call( -- response ) ]
|
||||
tri
|
||||
] [ drop <400> ] if
|
||||
] with-exit-continuation ;
|
||||
|
|
|
@ -53,7 +53,7 @@ M: login-realm modify-form ( responder -- )
|
|||
|
||||
\ successful-login DEBUG add-input-logging
|
||||
|
||||
: logout ( -- )
|
||||
: logout ( -- response )
|
||||
permit-id get [ delete-permit ] when*
|
||||
URL" $realm" end-aside ;
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (c) 2008 Slava Pestov
|
||||
! Copyright (c) 2008, 2009 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel math.order namespaces combinators.short-circuit
|
||||
USING: accessors kernel math.order namespaces combinators.short-circuit call
|
||||
html.forms
|
||||
html.templates
|
||||
html.templates.chloe
|
||||
|
@ -23,7 +23,7 @@ TUPLE: boilerplate < filter-responder template init ;
|
|||
M:: boilerplate call-responder* ( path responder -- )
|
||||
begin-form
|
||||
path responder call-next-method
|
||||
responder init>> call
|
||||
responder init>> call( -- )
|
||||
dup wrap-boilerplate? [
|
||||
clone [| body |
|
||||
[
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel http.server http.server.filters
|
||||
http.server.responses furnace.utilities ;
|
||||
http.server.responses furnace.utilities call ;
|
||||
IN: furnace.referrer
|
||||
|
||||
TUPLE: referrer-check < filter-responder quot ;
|
||||
|
@ -9,7 +9,7 @@ TUPLE: referrer-check < filter-responder quot ;
|
|||
C: <referrer-check> referrer-check
|
||||
|
||||
M: referrer-check call-responder*
|
||||
referrer over quot>> call
|
||||
referrer over quot>> call( referrer -- ? )
|
||||
[ call-next-method ]
|
||||
[ 2drop 403 "Bad referrer" <trivial-response> ] if ;
|
||||
|
||||
|
|
|
@ -135,4 +135,4 @@ SYMBOL: exit-continuation
|
|||
exit-continuation get continue-with ;
|
||||
|
||||
: with-exit-continuation ( quot -- value )
|
||||
'[ exit-continuation set @ ] callcc1 exit-continuation off ;
|
||||
'[ exit-continuation set @ ] callcc1 exit-continuation off ; inline
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Slava Pestov
|
||||
! Copyright (C) 2008, 2009 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel accessors strings namespaces assocs hashtables io
|
||||
USING: kernel accessors strings namespaces assocs hashtables io call
|
||||
mirrors math fry sequences words continuations
|
||||
xml.entities xml.writer xml.syntax ;
|
||||
IN: html.forms
|
||||
|
@ -96,7 +96,7 @@ C: <validation-error> validation-error
|
|||
>hashtable "validators" set-word-prop ;
|
||||
|
||||
: validate ( value quot -- result )
|
||||
[ <validation-error> ] recover ; inline
|
||||
'[ _ call( value -- validated ) ] [ <validation-error> ] recover ;
|
||||
|
||||
: validate-value ( name value quot -- )
|
||||
validate
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel fry io io.encodings.utf8 io.files
|
||||
debugger prettyprint continuations namespaces boxes sequences
|
||||
arrays strings html io.streams.string assocs
|
||||
arrays strings html io.streams.string assocs call
|
||||
quotations xml.data xml.writer xml.syntax ;
|
||||
IN: html.templates
|
||||
|
||||
|
@ -12,7 +12,7 @@ GENERIC: call-template* ( template -- )
|
|||
|
||||
M: string call-template* write ;
|
||||
|
||||
M: callable call-template* call ;
|
||||
M: callable call-template* call( -- ) ;
|
||||
|
||||
M: xml call-template* write-xml ;
|
||||
|
||||
|
|
|
@ -20,7 +20,7 @@ HELP: enable-fhtml
|
|||
{ $side-effects "responder" } ;
|
||||
|
||||
ARTICLE: "http.server.static.extend" "Hooks for dynamic content"
|
||||
"The static responder can be extended for dynamic content by associating quotations with MIME types in the hashtable stored in the " { $slot "special" } " slot. The quotations have stack effect " { $snippet "( path -- )" } "."
|
||||
"The static responder can be extended for dynamic content by associating quotations with MIME types in the hashtable stored in the " { $slot "special" } " slot. The quotations have stack effect " { $snippet "( path -- response )" } "."
|
||||
$nl
|
||||
"A utility word uses the above feature to enable server-side " { $snippet ".fhtml" } " scripts, allowing a development style much like PHP:"
|
||||
{ $subsection enable-fhtml }
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2004, 2008 Slava Pestov.
|
||||
! Copyright (C) 2004, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: calendar kernel math math.order math.parser namespaces
|
||||
parser sequences strings assocs hashtables debugger mime.types
|
||||
|
@ -6,7 +6,7 @@ sorting logging calendar.format accessors splitting io io.files
|
|||
io.files.info io.directories io.pathnames io.encodings.binary
|
||||
fry xml.entities destructors urls html xml.syntax
|
||||
html.templates.fhtml http http.server http.server.responses
|
||||
http.server.redirection xml.writer ;
|
||||
http.server.redirection xml.writer call ;
|
||||
IN: http.server.static
|
||||
|
||||
TUPLE: file-responder root hook special allow-listings ;
|
||||
|
@ -42,7 +42,9 @@ TUPLE: file-responder root hook special allow-listings ;
|
|||
|
||||
: serve-static ( filename mime-type -- response )
|
||||
over modified-since?
|
||||
[ file-responder get hook>> call ] [ 2drop <304> ] if ;
|
||||
[ file-responder get hook>> call( filename mime-type -- response ) ]
|
||||
[ 2drop <304> ]
|
||||
if ;
|
||||
|
||||
: serving-path ( filename -- filename )
|
||||
[ file-responder get root>> trim-tail-separators "/" ] dip
|
||||
|
@ -51,7 +53,7 @@ TUPLE: file-responder root hook special allow-listings ;
|
|||
: serve-file ( filename -- response )
|
||||
dup mime-type
|
||||
dup file-responder get special>> at
|
||||
[ call ] [ serve-static ] ?if ;
|
||||
[ call( filename -- response ) ] [ serve-static ] ?if ;
|
||||
|
||||
\ serve-file NOTICE add-input-logging
|
||||
|
||||
|
|
|
@ -5,7 +5,7 @@ sequences assocs math arrays stack-checker effects generalizations
|
|||
continuations debugger classes.tuple namespaces make vectors
|
||||
bit-arrays byte-arrays strings sbufs math.functions macros
|
||||
sequences.private combinators mirrors splitting
|
||||
combinators.short-circuit fry words.symbol generalizations ;
|
||||
combinators.short-circuit fry words.symbol generalizations call ;
|
||||
RENAME: _ fry => __
|
||||
IN: inverse
|
||||
|
||||
|
@ -122,7 +122,7 @@ M: math-inverse inverse
|
|||
|
||||
M: pop-inverse inverse
|
||||
[ "pop-length" word-prop cut-slice swap >quotation ]
|
||||
[ "pop-inverse" word-prop ] bi compose call ;
|
||||
[ "pop-inverse" word-prop ] bi compose call( -- quot ) ;
|
||||
|
||||
: (undo) ( revquot -- )
|
||||
[ unclip-slice inverse % (undo) ] unless-empty ;
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2003, 2008 Slava Pestov.
|
||||
! Copyright (C) 2003, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: continuations destructors kernel math math.parser
|
||||
namespaces parser sequences strings prettyprint
|
||||
|
@ -7,7 +7,7 @@ fry accessors arrays io io.sockets io.encodings.ascii
|
|||
io.sockets.secure io.files io.streams.duplex io.timeouts
|
||||
io.encodings threads make concurrency.combinators
|
||||
concurrency.semaphores concurrency.flags
|
||||
combinators.short-circuit ;
|
||||
combinators.short-circuit call ;
|
||||
IN: io.servers.connection
|
||||
|
||||
TUPLE: threaded-server
|
||||
|
@ -69,7 +69,7 @@ GENERIC: handle-client* ( threaded-server -- )
|
|||
[ [ remote-address set ] [ local-address set ] bi* ]
|
||||
2bi ;
|
||||
|
||||
M: threaded-server handle-client* handler>> call ;
|
||||
M: threaded-server handle-client* handler>> call( -- ) ;
|
||||
|
||||
: handle-client ( client remote local -- )
|
||||
'[
|
||||
|
|
|
@ -41,7 +41,7 @@ SYMBOL: message-histogram
|
|||
[ >alist sort-values <reversed> ] dip [
|
||||
[ swapd with-cell pprint-cell ] with-row
|
||||
] curry assoc-each
|
||||
] tabular-output ;
|
||||
] tabular-output ; inline
|
||||
|
||||
: log-entry. ( entry -- )
|
||||
"====== " write
|
||||
|
|
|
@ -80,7 +80,7 @@ ERROR: bad-log-message-parameters msg word level ;
|
|||
PRIVATE>
|
||||
|
||||
: (define-logging) ( word level quot -- )
|
||||
[ dup ] 2dip 2curry annotate ;
|
||||
[ dup ] 2dip 2curry annotate ; inline
|
||||
|
||||
: call-logging-quot ( quot word level -- quot' )
|
||||
[ "called" ] 2dip [ log-message ] 3curry prepose ;
|
||||
|
|
Loading…
Reference in New Issue