stayhydrated23/copabot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

website

Browse source
This commit is contained in:
silva guimaraes 2025-07-21 17:44:16 -03:00
parent 53a566d37a
commit 116ed0068b
5 changed files with 729 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

456
website/main.ml Normal file
View file

@ -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