factor-work/triangle-beer-league/triangle-beer-league.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