factor-work/triangle-beer-league/triangle-beer-league.factor

58 lines
1.5 KiB
Factor
Raw Normal View History

2023-09-08 16:24:48 -04:00
USING: accessors namespaces kernel sequences arrays urls present farkup ;
USING: math.parser math.text.english ;
2023-09-06 12:40:23 -04:00
USING: io.sockets.secure io.servers ;
2023-09-08 16:24:48 -04:00
USING: furnace.actions furnace.boilerplate furnace.utilities furnace.chloe-tags ;
USING: calendar calendar.english ;
USING: html.forms ;
2023-09-06 12:40:23 -04:00
USING: http.server http.server.dispatchers http.server.static ;
2023-09-08 16:24:48 -04:00
USING: triangle-beer-league.daysmart ;
2023-09-06 12:40:23 -04:00
IN: triangle-beer-league
SYMBOLS: key-password key-file dh-file ;
2023-09-08 16:24:48 -04:00
! DTO
TUPLE: schedule header schedules ;
2023-09-06 12:40:23 -04:00
TUPLE: tbl < dispatcher ;
: <splash-action> ( -- action )
<page-action>
{ tbl "tbl" } >>template ;
2023-09-08 16:24:48 -04:00
: timestamp>day-header ( timestamp -- str )
[ day-of-week day-name ]
[ month>> month-name ]
[ day>> dup number>string swap ordinal-suffix append ] tri
3array " " join ;
: tbl-games>schedule ( game-schedules -- schedules )
[ [ first timestamp>day-header ] [ second ] bi schedule boa ] map ;
2023-09-06 12:40:23 -04:00
: <schedule-action> ( -- action )
<page-action>
2023-09-08 16:24:48 -04:00
[ tbl-games tbl-games>schedule "schedule" set-value ] >>init
2023-09-06 12:40:23 -04:00
{ tbl "schedule" } >>template ;
2023-09-06 16:35:05 -04:00
: <tbl> ( -- responder )
2023-09-06 12:40:23 -04:00
tbl new-dispatcher
2023-09-08 16:24:48 -04:00
"resource:work/triangle-beer-league" <static> >>default
<schedule-action> "schedule" add-responder
<boilerplate>
{ tbl "tbl-common" } >>template ;
2023-09-06 12:40:23 -04:00
: <tbl-website-server> ( -- threaded-server )
<http-server>
2023-09-06 16:35:05 -04:00
f >>secure
8080 >>insecure ;
2023-09-06 12:40:23 -04:00
: start-tbl-site ( -- server )
2023-09-06 16:35:05 -04:00
<tbl> main-responder set-global
2023-09-06 12:40:23 -04:00
<tbl-website-server> start-server ;
2023-09-06 16:21:20 -04:00
: start-tbl ( -- )
start-tbl-site wait-for-server ;
MAIN: start-tbl