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

USING: urls pcre sequences accessors kernel assocs parser quotations combinators.short-circuit regexp arrays unicode ;
FROM: regexp => matches? ;
USING: xml.syntax xml.writer ;
USING: io io.streams.string ;
USING: math.parser math.text.english ;
USING: calendar calendar.english calendar.format ;
USING: html.parser html.parser.analyzer ;
USING: http.client ;

USING: triangle-beer-league.entities ;

IN: triangle-beer-league.daysmart

CONSTANT: daysmart-base-url URL" https://apps.daysmartrecreation.com/dash/index.php?company=dreamsports"
CONSTANT: datetime-regex "^(?<month>\\w{3}) (?<day>\\d{0,2}).{7}(?<hour>\\d{0,2}):(?<minute>\\d{0,2}) (?<ampm>[ap]m)$"

: tbl-team-name? ( name -- ? )
    R/ (maroon|white|blue|teal|green|yellow|light blue|red|orange|black)$/i matches? ;

: normalize-team-name ( name -- name' )
    >lower R/ \s*team$/i "" re-replace ;

! turns something like "Aug 23rd Wed 8:20 pm" into a timestamp
: parse-daysmart-schedule-time ( string -- timestamp )
    datetime-regex findall
    first
    [
        [ now year>> swap "month" of month-abbreviation-index ]
        [ "day" of string>number ] bi <date>
    ]
    [
        [ "hour" of string>number ]
        [ "minute" of string>number ]
        [ "ampm" of ] tri
    ] bi
    [ 0 set-time dup hour>> ] dip
    parse-word 1quotation call( ts h -- ts' ) ;

! TODO team schedules
! dup [ "event__date" html-class? ] find-between-all [ trim-text [ { [ name>> text = ] [ text>> empty? not ] } 1&& ] filter 2 swap remove-nth " " join ] map
: parse-team-schedule-response ( vector -- schedules )
    [ "event__date" html-class? ] find-between-all
    [ trim-text [ { [ name>> text = ] [ text>> empty? not ] } 1&& ] filter
      2 swap remove-nth [ text>> ] map " " join ] map ;

: parse-schedule-response ( vector -- schedules )
    [ "list-group-item" html-class? ] find-between-all
    [
        remove-blank-text trim-text
        [ name>> text = ] filter
        [ text>> ] map
        [ first R/ \s*Game$/ "" re-replace ]
        [ second ] [ fourth ] tri [ normalize-team-name ] bi@ team-schedule boa
    ] { } map-as
    [ home>> tbl-team-name? ] filter ;

: <daysmart-url> ( action -- url )
    daysmart-base-url swap "Action" set-query-param ;

: <daysmart-team-url> ( team-id -- url )
    "team/index" <daysmart-url> swap "teamid" set-query-param ;

: <daysmart-schedule-url> ( -- url )
    "Schedule/location" <daysmart-url> ;

: <daysmart-schedule-form-data> ( datetime -- assoc )
    [ { MM "/" DD "/" YYYY } formatted ] with-string-writer dup
    '{
        { "startDate" _ }
        { "endDate" _ }
        { "facilityId" "1" } ! apex
        { "eventType" "g" } ! game types
        { "run" "true" } ! no idea
    } ;

: <daysmart-schedule-request> ( datetime -- vector )
    <daysmart-schedule-form-data> <daysmart-schedule-url> <post-request>
    http-request nip parse-html ;

: <daysmart-request> ( url -- response )
    <get-request> http-request nip parse-html ;

: <daysmart-team-request> ( team-id -- response )
    <daysmart-team-url> scrape-html nip ;

: tbl-games ( -- assoc )
    now [ wednesday ] [ thursday ] bi 2array dup
    [ <daysmart-schedule-request> parse-schedule-response ] map
    zip ;

: render-day-header ( timestamp -- xml )
    [ day-of-week day-name ]
    [ month>> month-name ]
    [ day>> dup number>string swap ordinal-suffix append ] tri
    [XML
     <h1 class="day-header">
        <span class="day-name"><-></span>
        <span class="month"><-></span>
        <span class="day"><-></span>
     </h1>
     XML] ;

: render-team-times ( schedule -- xml )
    [ away>> [ "team " prepend ] keep ]
    [ home>> [ "team " prepend ] keep ]
    [ start>> ] tri
    [XML
     <div class="team-times">
        <span class="at">@</span>
        <div class="teams">
            <span class=<->><-></span>
            <span class=<->><-></span>
        </div>
        <div class="time"><-></div>
     </div>
     XML] ;

: render-no-games ( -- xml )
    [XML
     <div class="team-times"><div class="none">No Scheduled TBL games</div></div>
     XML] ;

: render-day-schedule ( assoc -- xml )
    [ first render-day-header ]
    [ second
      dup empty?
      [ drop render-no-games ]
      [ [ render-team-times ] map ] if
    ] bi
    [XML
     <section class="game">
     <->
     <->
     </section>
    XML] ;

: tbl-games? ( -- ? )
    tbl-games empty? not ;

: render-schedule ( -- )
    tbl-games [ render-day-schedule pprint-xml ] each ;