87 lines
2.3 KiB
Factor
87 lines
2.3 KiB
Factor
USING: accessors namespaces kernel sequences arrays urls present farkup combinators classes ;
|
|
USING: math.parser math.text.english ;
|
|
USING: io.sockets.secure io.servers ;
|
|
USING: furnace.actions furnace.boilerplate furnace.utilities furnace.chloe-tags ;
|
|
USING: calendar calendar.english ;
|
|
USING: html.forms ;
|
|
USING: http.server http.server.dispatchers http.server.static ;
|
|
|
|
USING: triangle-beer-league.daysmart ;
|
|
|
|
IN: triangle-beer-league
|
|
|
|
SYMBOLS: key-password key-file dh-file ;
|
|
|
|
! DTOs
|
|
TUPLE: game start-time home away summary show-summary? show-times? ;
|
|
TUPLE: schedule header games ;
|
|
|
|
TUPLE: tbl < dispatcher ;
|
|
|
|
: team-schedule>time-string ( schedule -- str )
|
|
[ start>> ] [ end>> ] bi
|
|
[ timestamp>relative-hh:mm "pm" append ] bi@
|
|
2array " - " join ;
|
|
|
|
: timestamp>day-header ( timestamp -- str )
|
|
[ day-of-week day-name ]
|
|
[ month>> month-name ]
|
|
[ day>> dup number>string swap ordinal-suffix append ] tri
|
|
3array " " join ;
|
|
|
|
: summary>string ( summary -- str )
|
|
[
|
|
[ away-score>> ] [ home-score>> ] bi 2array " - " join
|
|
]
|
|
[ "" ] if* ;
|
|
|
|
: tbl-game-schedules>tbl-games ( game-schedules -- games )
|
|
[
|
|
{
|
|
[ team-schedule>time-string ]
|
|
[ home>> color>> ]
|
|
[ away>> color>> ]
|
|
[ summary>> summary>string ]
|
|
} cleave dup empty? not dup not game boa
|
|
] map ;
|
|
|
|
: tbl-games>schedule ( game-schedules -- schedules )
|
|
[
|
|
[ first timestamp>day-header ]
|
|
[ second tbl-game-schedules>tbl-games ] bi schedule boa
|
|
] map ;
|
|
|
|
: <splash-action> ( -- action )
|
|
<page-action>
|
|
{ tbl "tbl" } >>template ;
|
|
|
|
: <schedule-action> ( -- action )
|
|
<page-action>
|
|
[
|
|
t "show-header?" set-value
|
|
tbl-game-schedules tbl-games>schedule "schedule" set-value
|
|
] >>init
|
|
{ tbl "schedule" } >>template ;
|
|
|
|
: <tbl> ( -- responder )
|
|
tbl new-dispatcher
|
|
"resource:work/triangle-beer-league" <static> >>default
|
|
<splash-action> "" add-responder
|
|
<schedule-action> "schedule" add-responder
|
|
<boilerplate>
|
|
{ tbl "tbl-common" } >>template ;
|
|
|
|
: <tbl-website-server> ( -- threaded-server )
|
|
<http-server>
|
|
f >>secure
|
|
8080 >>insecure ;
|
|
|
|
: start-tbl-site ( -- server )
|
|
<tbl> main-responder set-global
|
|
<tbl-website-server> start-server ;
|
|
|
|
: start-tbl ( -- )
|
|
start-tbl-site wait-for-server ;
|
|
|
|
MAIN: start-tbl
|