diff --git a/bin/main.ml b/bin/main.ml index 18c21ad..914fb86 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -134,7 +134,7 @@ let pp (day : Unix.tm) matches = ppd_matches let f () = - let fetched = Lwt_main.run @@ Lib.fetch_all tournaments in + let fetched = Lwt_main.run @@ Lib.fetch_all_tournaments tournaments in let today = Unix.time () |> Unix.localtime in let tomorrow = Unix.time () +. (60. *. 60. *. 24.) |> Unix.localtime in let header = "### schedules" in diff --git a/lib/lib.ml b/lib/lib.ml index fd36502..33bf2b2 100644 --- a/lib/lib.ml +++ b/lib/lib.ml @@ -2,7 +2,6 @@ open Ppx_yojson_conv_lib.Yojson_conv.Primitives open Printf open Lwt.Infix - type api_status = { code : int; description : string; @@ -10,8 +9,13 @@ type api_status = { } [@@deriving yojson, show] -type api_country = { alpha2 : string; alpha3 : string; name : string } -[@@yojson.allow_extra_fields] [@@deriving yojson, show] +type api_country = { + alpha2 : string; + alpha3 : string; + name : string; + slug : string; +} +[@@deriving yojson, show] type api_team_colors = { primary : string; secondary : string; text : string } [@@deriving yojson, show] @@ -19,23 +23,27 @@ type api_team_colors = { primary : string; secondary : string; text : string } type api_team = { id : int; name : string; - short_name : string option; [@key "shortName"] [@yojson.option] + shortName : string option; [@yojson.option] gender : string; teamColors : api_team_colors; country : api_country; } [@@yojson.allow_extra_fields] [@@deriving yojson, show] -let team_name x = match x.short_name with Some x -> x | None -> x.name +let team_name x = match x.shortName with Some x -> x | None -> x.name -type api_tournament_info = { name : string; slug : string } +type api_tournament = { + name : string; + slug : string; + country : api_country option; [@yojson.option] +} [@@yojson.allow_extra_fields] [@@deriving yojson, show] type api_score = { - current : int [@default 0]; - period1 : int [@default 0]; - period2 : int [@default 0]; - normaltime : int [@default 0]; + current : int; [@default 0] + period1 : int; [@default 0] + period2 : int; [@default 0] + normaltime : int; [@default 0] } [@@yojson.allow_extra_fields] [@@deriving yojson, show] @@ -47,7 +55,7 @@ type api_time = { [@@yojson.allow_extra_fields] [@@deriving yojson, show] type api_match = { - tournament : api_tournament_info; + tournament : api_tournament; homeTeam : api_team; awayTeam : api_team; homeScore : api_score; @@ -62,15 +70,88 @@ type api_events = { events : api_match list } [@@yojson.allow_extra_fields] [@@deriving yojson, show] type half = - | FirstHalf of { injury_time1 : int option; period_start_timestamp : int } - | HalfTime of { injury_time1 : int option } - | SecondHalf of { + | First_Half of { injury_time1 : int option; period_start_timestamp : int } + | Half_Time of { injury_time1 : int option } + | Second_Half of { injury_time1 : int option; injury_time2 : int option; period_start_timestamp : int; } + | First_Extra of { + injury_time1 : int option; + injury_time2 : int option; + period_start_timestamp : int; + } + | Extra_Time_Half_Time of { + injury_time1 : int option; + injury_time2 : int option; + } + | Second_Extra of { + injury_time1 : int option; + injury_time2 : int option; + period_start_timestamp : int; + } + | Extra_Time_Await + | Penalties [@@deriving show] +type api_standing_rows = { + team : api_team; + position : int; + matches : int; + points : int; + wins : int option; [@yojon.option] [@default None] + scoresFor : int option; [@yojon.option] [@default None] + scoresAgainst : int option; [@yojon.option] [@default None] + losses : int option; [@yojon.option] [@default None] + draws : int option; [@yojon.option] [@default None] + pointsPerGame : float option; [@yojon.option] [@default None] + pointsPrevPrevSeason : int option; [@yojon.option] [@default None] + pointsPrevSeason : int option; [@yojon.option] [@default None] + pointsCurrSeason : int option; [@yojon.option] [@default None] +} +[@@yojson.allow_extra_fields] [@@deriving yojson, show] + +type api_standing = { + name : string; + rows : api_standing_rows list; + updatedAtTimestamp : int; +} +[@@yojson.allow_extra_fields] [@@deriving yojson, show] + +type api_standings_total = { standings : api_standing list } +[@@deriving yojson, show] + +type normal_table_row = { + team : api_team; + position : int; + matches : int; + points : int; + wins : int; + scoresFor : int; + scoresAgainst : int; + losses : int; + draws : int; +} + +type promedios_table_row = { + team : api_team; + position : int; + matches : int; + points : int; + pointsPerGame : float; + pointsPrevPrevSeason : int; + pointsPrevSeason : int; + pointsCurrSeason : int; +} + +type table_rows = + | Normal of normal_table_row list + | Promedios of promedios_table_row list + +type table = { name : string; rows : table_rows } + +(* TODO penalties *) type score = { home_score : int; away_score : int } [@@deriving show] type status = @@ -98,7 +179,7 @@ type tournament_scrape_context = { let mmod a b = ((a mod b) + b) mod b -let is_conmebol x = +let is_conmebol (x : api_team) = match x.country.alpha2 with | "AR" | "BO" | "BR" | "CL" | "CO" | "EC" | "PY" | "PE" | "UY" | "VE" -> true | _ -> false @@ -173,7 +254,7 @@ let get url = let req_headers = Cohttp.Header.( add (init ()) "X-Captcha" - "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE3NTI4MjkzNzd9.TL1wEObA1UEKHuK7X954DHByN7_2_Mm1MW25ywqe-Z8") + "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE3NTI4NjM5MjV9.Zv5y-Ba5Kck1JPV2xTBgcfhX0YGhKq-ShTQEGAKG8Uw") in let* resp, body = Cohttp_lwt_unix.Client.get ~headers:req_headers @@ Uri.of_string url @@ -186,9 +267,44 @@ let get url = else Lwt.return @@ Error (Cohttp.Code.reason_phrase_of_code code) in let* result = http_get url in - match result with - | Error str -> failwith str - | Ok r -> Lwt.return r + match result with Error str -> failwith str | Ok r -> Lwt.return r + +let tables_of_api_standings_total (s : api_standings_total) : table list = + let must_some = function None -> failwith "impossible" | Some x -> x in + let table_of_api_standing (x : api_standing) = + let row = List.nth x.rows 0 in + match row.wins with + | Some _ -> + let of_normal (x : api_standing_rows) = + { + team = x.team; + position = x.position; + matches = x.matches; + points = x.points; + wins = must_some x.wins; + scoresFor = must_some x.scoresFor; + scoresAgainst = must_some x.scoresAgainst; + losses = must_some x.losses; + draws = must_some x.draws; + } + in + { name = x.name; rows = Normal (List.map of_normal x.rows) } + | None -> + let of_promedios (x : api_standing_rows) = + { + team = x.team; + position = x.position; + matches = x.matches; + points = x.points; + pointsPerGame = must_some x.pointsPerGame; + pointsPrevPrevSeason = must_some x.pointsPrevPrevSeason; + pointsPrevSeason = must_some x.pointsPrevSeason; + pointsCurrSeason = must_some x.pointsCurrSeason; + } + in + { name = x.name; rows = Promedios (List.map of_promedios x.rows) } + in + List.map table_of_api_standing s.standings let matches_of_api_events (e : api_events) = e.events @@ -208,7 +324,7 @@ let matches_of_api_events (e : api_events) = InProgress { start_timestamp = m.startTimestamp; - half = HalfTime { injury_time1 = x }; + half = Half_Time { injury_time1 = x }; score = { home_score = m.homeScore.current; @@ -226,7 +342,7 @@ let matches_of_api_events (e : api_events) = { start_timestamp = m.startTimestamp; half = - FirstHalf + First_Half { injury_time1 = x; period_start_timestamp = z }; score = { @@ -245,7 +361,7 @@ let matches_of_api_events (e : api_events) = { start_timestamp = m.startTimestamp; half = - SecondHalf + Second_Half { injury_time1 = x; injury_time2 = y; @@ -257,6 +373,105 @@ let matches_of_api_events (e : api_events) = away_score = m.awayScore.current; }; } + | ( "1st extra", + "inprogress", + { + injuryTime1 = x; + injuryTime2 = y; + currentPeriodStartTimestamp = Some z; + } ) -> + InProgress + { + start_timestamp = m.startTimestamp; + half = + First_Extra + { + injury_time1 = x; + injury_time2 = y; + period_start_timestamp = z; + }; + score = + { + home_score = m.homeScore.current; + away_score = m.awayScore.current; + }; + } + | ( "Extra time halftime", + "inprogress", + { + injuryTime1 = x; + injuryTime2 = y; + currentPeriodStartTimestamp = _; + } ) -> + InProgress + { + start_timestamp = m.startTimestamp; + half = + Extra_Time_Half_Time + { injury_time1 = x; injury_time2 = y }; + score = + { + home_score = m.homeScore.current; + away_score = m.awayScore.current; + }; + } + | ( "2nd extra", + "inprogress", + { + injuryTime1 = x; + injuryTime2 = y; + currentPeriodStartTimestamp = Some z; + } ) -> + InProgress + { + start_timestamp = m.startTimestamp; + half = + Second_Extra + { + injury_time1 = x; + injury_time2 = y; + period_start_timestamp = z; + }; + score = + { + home_score = m.homeScore.current; + away_score = m.awayScore.current; + }; + } + | ( "Penalties", + "inprogress", + { + injuryTime1 = _; + injuryTime2 = _; + currentPeriodStartTimestamp = _; + } ) -> + InProgress + { + start_timestamp = m.startTimestamp; + half = Penalties; + score = + { + home_score = m.homeScore.current; + away_score = m.awayScore.current; + }; + } + | ( "Awaiting extra time", + "inprogress", + { + injuryTime1 = _; + injuryTime2 = _; + currentPeriodStartTimestamp = _; + } ) -> + InProgress + { + start_timestamp = m.startTimestamp; + half = Extra_Time_Await; + score = + { + home_score = m.homeScore.normaltime; + away_score = m.awayScore.normaltime; + }; + } | "AP", "finished", _ | "AET", "finished", _ | "Ended", "finished", _ -> @@ -281,30 +496,39 @@ let matches_of_api_events (e : api_events) = (show_api_time m.time)); }) - -let fetch_matches ctx = - let g order (* "last" for previous matches "next" for future matches *) = - try%lwt - let url = - sprintf - (* TLS fingerprinting is in place and it's been used to block our requests once +let fetch ctx order (* "last" for previous matches "next" for future matches *) + = + try%lwt + let url = + sprintf + (* TLS fingerprinting is in place and it's been used to block our requests once their systems detect we've been abusing their private API. TLS handshakes can only happen with secure connections using HTTPS, so using plain HTTP makes it impossible for that to happen, which they do generously accept. *) - "http://www.sofascore.com/api/v1/unique-tournament/%d/season/%d/events/%s/0" - ctx.id ctx.season order - in + "http://www.sofascore.com/api/v1/unique-tournament/%d/season/%d/events/%s/0" + ctx.id ctx.season + (match order with `Last -> "last" | `Next -> "next") + in + get url >|= Yojson.Safe.from_string >|= api_events_of_yojson + >|= matches_of_api_events + with + | Status_Not_found -> Lwt.return [] + | Ppx_yojson_conv_lib__Yojson_conv.Of_yojson_error (exn, _) -> raise exn - get url >|= Yojson.Safe.from_string >|= api_events_of_yojson >|= matches_of_api_events - with - | Status_Not_found -> Lwt.return [] - | Ppx_yojson_conv_lib__Yojson_conv.Of_yojson_error (exn, _) -> - failwith @@ Printexc.to_string exn - in - let* last = g "last" in - let* next = g "next" in +let fetch_all_matches ctx = + let* last = fetch ctx `Last in + let* next = fetch ctx `Next in Lwt.return @@ Tournament.make ctx @@ List.append last next -let fetch_all tournaments = - tournaments |> List.map fetch_matches |> Lwt.all +let fetch_all_tournaments tournaments = + tournaments |> List.map fetch_all_matches |> Lwt.all + +let standings context = + let url = + sprintf + "https://www.sofascore.com/api/v1/unique-tournament/%d/season/%d/standings/total" + context.id context.season + in + get url >|= Yojson.Safe.from_string >|= api_standings_total_of_yojson + >|= tables_of_api_standings_total diff --git a/website/dune b/website/dune new file mode 100644 index 0000000..1e68279 --- /dev/null +++ b/website/dune @@ -0,0 +1,6 @@ +(executable + (public_name website) + (name main) + (libraries api dream tyxml) + (preprocess (pps tyxml-ppx)) + ) diff --git a/website/main.ml b/website/main.ml new file mode 100644 index 0000000..e48adf7 --- /dev/null +++ b/website/main.ml @@ -0,0 +1,456 @@ + +open Printf +open Api + + +let context: Lib.tournament_scrape_context list = [ + { + id = 384; + season = 70083; + name = "LIBERTADORES"; + filter_foreigners = false; + timezone_offset = None; + }; + { + id = 480; + season = 70070; + name = "SUDAMERICANA"; + filter_foreigners = false; + timezone_offset = None; + }; + { + id = 373; + season = 71944; + name = "COPA DO BRASIL"; + filter_foreigners = false; + timezone_offset = None; + }; + { + id = 1596; + season = 69430; + name = "COPA DO NORDESTE"; + filter_foreigners = false; + timezone_offset = None; + }; + { + id = 1024; + season = 70664; + name = "COPA ARGENTINA"; + filter_foreigners = false; + timezone_offset = None; + }; + { + id = 325; + season = 72034; + name = "BRAZIL 1"; + filter_foreigners = false; + timezone_offset = None; + }; + { + id = 155; + season = 77826; + name = "ARGENTINA 1, CLAUSURA"; + filter_foreigners = false; + timezone_offset = None; + }; + { + id = 278; + season = 71306; + name = "URUGUAY 1"; + filter_foreigners = false; + timezone_offset = None; + }; + { + id = 11536; + season = 77825; + name = "COLOMBIA 1"; + filter_foreigners = false; + timezone_offset = Some ~-5; + }; + { + id = 1335; + season = 76050; + name = "COPA COLOMBIA"; + filter_foreigners = false; + timezone_offset = Some ~-5; + }; + { + id = 11653; + season = 71131; + name = "CHILE 1"; + filter_foreigners = false; + timezone_offset = Some ~-4; + }; + { + id = 390; + season = 72603; + name = "BRAZIL 2"; + filter_foreigners = false; + timezone_offset = None; + }; + { + id = 1221; + season = 71100; + name = "COPA CHILE"; + filter_foreigners = false; + timezone_offset = Some ~-4; + }; + { + id = 11541; + season = 69831; + name = "PARAGUAY 1, CLAUSURA"; + filter_foreigners = false; + timezone_offset = None; + }; +] +;; + +let ( let& ) a b = + match a with + | None -> None + | Some x -> b x +;; + +let ( let* ) = Lwt.bind ;; + +let my_header () = + let open Tyxml.Html in + header ~a:[a_style "padding: var(--main-margin); px; margin: var(--main-margin); "] [ + div [ + a ~a:[a_href "/"; a_style "text-decoration-color: unset; color: unset"] [txt "index"] + ] ; + div [ + let ts = Unix.localtime @@ Unix.time () in + txt @@ sprintf "last updated: %02d:%02d:%02d" ts.tm_hour ts.tm_min ts.tm_sec + ] + ]; +;; + +let my_head title' = + let open Tyxml.Html in + (head (title (txt title')) [ + style [ txt {| + :root { + --main-bg: #eee; --main-margin: 3px; + --celeste: #9ed1ff; + } + * { + margin: 0; + } + html, body { + height: 100%; font-size: 13px; + } + a { + text-decoration-color: unset; + color: unset; + } + .match-table:last-child { + border-bottom: 0 !important + } + .standing tbody tr:nth-child(odd) { + background-color: var(--celeste); + } + td { + padding: var(--main-margin); + text-align: center; + } + td:nth-child(2), thead td { + text-align: left; + } + |}] + ]) +;; + +let box ?style elements = + let s = + match style with + | Some x -> x + | None -> "" + in + let attr = + [Tyxml.Html.a_style @@ "padding: var(--main-margin); border-radius: var(--main-margin); \ + margin: var(--main-margin); " ^ s] + in + Tyxml.Html.div ~a:attr elements +;; + +let greet (tournaments: Lib.Tournament.t list) = + let open Tyxml.Html in + let filter_day day mon (x: Unix.tm) = + x.tm_mday = day && x.tm_mon = mon + in + let today = + Unix.time () |> Unix.localtime + in + html + (my_head "index") + (body [ + my_header (); + main ~a:[a_style "margin: auto; display: flex; flex-direction: row;"] + (tournaments + |> List.filter_map @@ fun x -> (x + |> Lib.Tournament.matches + |> List.filter_map (fun (match': Lib.match') -> + let& ts = + match match'.status with + | Delayed | Suspended _ | Postponed | Canceled -> None + | InProgress { start_timestamp; half = _; score = _ } -> Some start_timestamp + | NotStarted { start_timestamp } -> Some start_timestamp + | Completed { start_timestamp; score = _ } -> Some start_timestamp + in + let match_ts = + Unix.localtime @@ float_of_int ts + in + if not @@ filter_day today.tm_mday today.tm_mon match_ts + then None + else + Some ( + div ~a:[a_class ["match-table"] ; + a_style "display: flex; justify-content: space-between; \ + border-bottom: 1px black solid; margin-bottom: calc(var(--main-margin) * 2); padding; \ + var(--main-margin)"] + [ + div ~a:[a_style "display: flex; width: 145px; justify-content: space-between;"] [ + div ~a:[] [ + div ~a:[a_style "white-space: nowrap"] [txt @@ Lib.team_name match'.home_team]; + div ~a:[a_style "white-space: nowrap"] [txt @@ Lib.team_name match'.away_team]; + ] ; + (match match'.status with + | NotStarted _ | Delayed | Suspended _ | Postponed | Canceled -> div [] + | Completed {score = {home_score; away_score}; start_timestamp = _} -> + (* print_string (Lib.show_api_score home_score) ; *) + div ~a:[] [ + div ~a:[] [txt @@ string_of_int home_score]; + div ~a:[] [txt @@ string_of_int away_score]; + ] + | InProgress {score = {home_score; away_score}; start_timestamp = _; half = _} -> + div ~a:[] [ + div ~a:[] [txt @@ string_of_int home_score]; + div ~a:[] [txt @@ string_of_int away_score]; + ]) + ] ; + let status_attr = [a_style "text-align: right; min-width: 87px"] in + let attr = [a_style "color: red; font-weight: bold; text-align: right; min-width: 87px"] in + match match'.status with + | Delayed | Suspended _ | Postponed | Canceled -> failwith "impossible" + | Completed _ -> div ~a:status_attr [ txt "finished" ] + | NotStarted _ -> + let text = + sprintf "%02d:%02d" match_ts.tm_hour match_ts.tm_min + in + div ~a:[] [ txt text ] + | InProgress { start_timestamp = _; half; score = _} -> + match half with + | First_Half { injury_time1; period_start_timestamp } -> + let duration = (Unix.time ()) -. (float_of_int period_start_timestamp) in + let duration_minutes = (duration /. 60.) in + let text = + if duration_minutes < 45. then + sprintf "1T %02.0f'" duration_minutes + else + match injury_time1 with + | Some it -> + sprintf "1T 45+%02d/%02d'" (int_of_float duration_minutes - 45) it + | None -> + sprintf "1T 45+%02d/??'" (int_of_float duration_minutes - 45) + in + div ~a:attr [ txt text ] + | Half_Time _ -> + div ~a:[a_style "color: red; font-weight: bold"] [ txt "HT" ] + | Second_Half { injury_time1 = _ ; injury_time2 ; period_start_timestamp } -> + let duration = (Unix.time ()) -. (float_of_int period_start_timestamp) in + let duration_minutes = (duration /. 60.) in + let text = + if duration_minutes < 45. then + sprintf "2T %02.0f'" duration_minutes + else + (match injury_time2 with + | Some it -> + sprintf "2T 45+%02d/%02d'" (int_of_float duration_minutes - 45) it + | None -> + sprintf "2T 45+%02d/??'" (int_of_float duration_minutes - 45)) + in + div ~a:attr [ txt text ] + | First_Extra { injury_time1 = _ ; injury_time2 = _ ; period_start_timestamp } -> + let duration = (Unix.time ()) -. (float_of_int period_start_timestamp) in + let duration_minutes = (duration /. 60.) in + let text = sprintf "1ET %02.0f'" duration_minutes + in + div ~a:attr [ txt text ] + | Extra_Time_Await -> + div ~a:attr [ txt "HT..?" ] + | Extra_Time_Half_Time { injury_time1 = _ ; injury_time2 = _ } -> + div ~a:attr [ txt "ET HT" ] + | Second_Extra { injury_time1 = _ ; injury_time2 = _ ; period_start_timestamp } -> + let duration = (Unix.time ()) -. (float_of_int period_start_timestamp) in + let duration_minutes = (duration /. 60.) in + let text = sprintf "2ET %02.0f'" duration_minutes + in + div ~a:attr [ txt text ] + | Penalties -> + div ~a:attr [ txt "PEN" ] ; + ] + )) + |> fun y -> + if List.length y = 0 then None else + Some (box ~style:"min-width: 200px;" + [ + header [ + a ~a:[a_href @@ sprintf "/tournament/%d" x.context.id] [h3 [txt x.context.name]]; + h4 [txt @@ sprintf "(%d/%d) Today" today.tm_mon today.tm_mday]; + ]; + main y + ] + ))) + ; + footer []; + ]) +;; + +let tournament_page (tournament: Lib.Tournament.t) (tables: Lib.table list) = + let open Tyxml.Html in + let my_table (t: Lib.table) = + let attr = + [a_style "border-collapse: collapse; border: 1px solid black; height: min-content"; + a_class ["standing"]] + in + let tab = + match t.rows with + | Lib.Normal rows -> + table ~a:attr ~thead:(thead [ + tr [ + td [txt "#"] ; + td [txt "Name"] ; + td [txt "P"] ; + td [txt "M"] ; + td [txt "W"] ; + td [txt "D"] ; + td [txt "L"] ; + td [txt "GF"] ; + td [txt "Diff"] ; + td [txt "GA"] ; + ] + ]) + (rows + |> List.map (fun ({team; points; matches; wins; scoresFor; + scoresAgainst; losses; draws; position}: Lib.normal_table_row) -> + let is_playing = + tournament.matches + |> List.find_map (fun (x: Lib.match') -> + match x.status with + | InProgress y -> + let is_home = x.home_team.id = team.id in + if is_home || x.away_team.id = team.id then + Some (is_home, y.score) else None + | _ -> None + ) + in + let attr = + match is_playing with + | Some _ -> [a_style "color: red; font-weight: bold"] + | None -> [] + in + tr [ + td ~a:attr [txt @@ string_of_int position] ; + td ~a:attr [ + div ~a:[a_style "display: flex; justify-content: space-between;"] @@ + (div [ txt @@ team.name ]) :: match is_playing with + | None -> [] + | Some (is_home, score) -> [ + let style = + "color: white; padding: 0 var(--main-margin) 0 var(--main-margin); \ + margin-left: var(--main-margin);" ^ + match is_home, Int.compare score.home_score score.away_score with + | false, -1 | true, 1 -> "background-color: green;" + | false, 1 | true, -1 -> "background-color: red;" + | false, 0 | true, 0 -> "background-color: grey;" + | _ -> failwith "impossible" + in + div ~a:[a_style style + ] [ + span [txt @@ string_of_int score.home_score ]; + span [txt "-"]; + span [txt @@ string_of_int score.away_score ]; + ] ] + ] ; + td ~a:attr [txt @@ string_of_int points] ; + td ~a:attr [txt @@ string_of_int matches] ; + td ~a:attr [txt @@ string_of_int wins] ; + td ~a:attr [txt @@ string_of_int draws] ; + td ~a:attr [txt @@ string_of_int losses] ; + td ~a:attr [txt @@ string_of_int scoresFor] ; + td ~a:attr [txt @@ string_of_int @@ scoresFor - scoresAgainst] ; + td ~a:attr [txt @@ string_of_int scoresAgainst] ; + ] + ) + ) + | Lib.Promedios rows -> + table ~a:attr ~thead:(thead [ + tr [ + td [txt "#"] ; + td [txt "Name"] ; + td [txt "PPG"] ; + td [txt "P"] ; + td [txt "M"] ; + td [txt "PPS"] ; + td [txt "PS"] ; + td [txt "CS"] ; + ] + ]) + (rows + |> List.map (fun ({team; points; matches; position; pointsPerGame; pointsPrevPrevSeason; + pointsPrevSeason; pointsCurrSeason;}: Lib.promedios_table_row) -> + tr [ + td [txt @@ string_of_int position] ; + td [txt @@ team.name] ; + td [txt @@ string_of_float pointsPerGame] ; + td [txt @@ string_of_int points] ; + td [txt @@ string_of_int matches] ; + td [txt @@ string_of_int pointsPrevPrevSeason] ; + td [txt @@ string_of_int pointsPrevSeason] ; + td [txt @@ string_of_int pointsCurrSeason] ; + ] + ) + ) + in + div [ + h3 ~a:[a_style "margin-bottom: var(--main-margin)"] [txt t.name] ; + tab ; + ] + in + html + (my_head "index") + (body [ + my_header () ; + main [ + box [h3 [txt tournament.context.name]] ; + box ~style:"display: flex; flex-direction: row; gap: calc(var(--main-margin) * 2)" @@ + List.map my_table tables + ]; + footer [] + ] + ) +;; + +let html_to_string html = Format.asprintf "%a" (Tyxml.Html.pp ()) html ;; + +Lwt_main.run begin + Dream.serve + @@ Dream.logger + @@ Dream.router + [ + Dream.get "/" begin fun _ -> + let* data = Lib.fetch_all_tournaments context in + Dream.html @@ html_to_string @@ greet data + end ; + Dream.get "/tournament/:id" begin fun request -> + let id' = int_of_string @@ Dream.param request "id" in + let ctx = + List.find (fun ({id; _}: Lib.tournament_scrape_context) -> id = id') context + in + let* matches = Lib.fetch ctx `Last in + let* standings = Lib.standings ctx in + Dream.html @@ html_to_string @@ tournament_page (Lib.Tournament.make ctx matches) standings + end + ] + end diff --git a/website/static/ae_mainbg.gif b/website/static/ae_mainbg.gif new file mode 100644 index 0000000..f7a4519 Binary files /dev/null and b/website/static/ae_mainbg.gif differ