- USING: math math.parser kernel sequences io\r
-USING: math math.parser kernel sequences io calendar\r
-accessors arrays io.streams.string splitting math.order\r
-combinators accessors debugger ;\r
++USING: math math.order math.parser kernel sequences io\r
+accessors arrays io.streams.string splitting\r
+combinators accessors debugger\r
+calendar calendar.format.macros ;\r
IN: calendar.format\r
\r
+: pad-00 number>string 2 CHAR: 0 pad-left ;\r
+\r
+: pad-0000 number>string 4 CHAR: 0 pad-left ;\r
+\r
+: pad-00000 number>string 5 CHAR: 0 pad-left ;\r
+\r
+: write-00 pad-00 write ;\r
+\r
+: write-0000 pad-0000 write ;\r
+\r
+: write-00000 pad-00000 write ;\r
+\r
+: hh hour>> write-00 ;\r
+\r
+: mm minute>> write-00 ;\r
+\r
+: ss second>> >integer write-00 ;\r
+\r
+: D day>> number>string write ;\r
+\r
+: DD day>> write-00 ;\r
+\r
+: DAY day-of-week day-abbreviations3 nth write ;\r
+\r
+: MM month>> write-00 ;\r
+\r
+: MONTH month>> month-abbreviations nth write ;\r
+\r
+: YYYY year>> write-0000 ;\r
+\r
+: YYYYY year>> write-00000 ;\r
+\r
+: expect ( str -- )\r
+ read1 swap member? [ "Parse error" throw ] unless ;\r
+\r
+: read-00 2 read string>number ;\r
+\r
+: read-000 3 read string>number ;\r
+\r
+: read-0000 4 read string>number ;\r
+\r
GENERIC: day. ( obj -- )\r
\r
M: integer day. ( n -- )\r
[ nip ] [ drop default>> ] if
] [
over first over responders>> at*
- [ >r drop 1 tail-slice r> ] [ drop default>> ] if
+ [ >r drop rest-slice r> ] [ drop default>> ] if
] if ;
-M: dispatcher call-responder ( path dispatcher -- response )
- [ add-base-path ] [ find-responder call-responder ] 2bi ;
+M: dispatcher call-responder* ( path dispatcher -- response )
+ find-responder call-responder ;
TUPLE: vhost-dispatcher default responders ;
'[ exit-continuation set @ ] callcc1 exit-continuation off ;
: split-path ( string -- path )
- "/" split [ empty? not ] subset ;
+ "/" split [ empty? not ] filter ;
+: init-request ( -- )
+ H{ } clone base-paths set
+ [ ] link-hook set
+ [ ] form-hook set ;
+
: do-request ( request -- response )
[
- H{ } clone base-paths set
- [ ] link-hook set
- [ ] form-hook set
-
- [ log-request ]
+ init-request
[ request set ]
+ [ log-request ]
[ path>> split-path main-responder get call-responder ] tri
[ <404> ] unless*
] [