Tweak some furnace code to infer and load with almost no warnings

db4
Slava Pestov 2009-03-15 18:19:29 -05:00
parent ca4d60095b
commit 8e55533bfa
14 changed files with 37 additions and 35 deletions

View File

@ -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

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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 |
[

View File

@ -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 ;

View File

@ -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

View File

@ -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

View File

@ -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 ;

View File

@ -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 }

View File

@ -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

View File

@ -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 ;

View File

@ -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 -- )
'[

View File

@ -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

View File

@ -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 ;