Compare commits

..

No commits in common. "9f964d536fb2d4f47ed7101dcdf93c262b451338" and "64368b1651bc6ced980e2c64e67a095f3d4fab06" have entirely different histories.

13 changed files with 76 additions and 1034 deletions

View file

@ -1 +0,0 @@
open Lwt.Infix

View file

@ -1 +0,0 @@
FROM ocaml/opam:debian

View file

@ -1,6 +0,0 @@
# TODO
- [ ] (2025-07-16) Lista de eventos com todos os gols por timestamp do dia.
- [ ] (2025-07-16) Tabelas de classificação.
- [ ] (2025-07-16) Atualização em tempo real.

View file

@ -14,7 +14,6 @@ depends: [
"ocaml" "ocaml"
"ppx_deriving_yojson" "ppx_deriving_yojson"
"cohttp-curl-lwt" "cohttp-curl-lwt"
"lwt_ppx"
"cohttp-lwt-unix" "cohttp-lwt-unix"
"lwt_ssl" "lwt_ssl"
"ppx_expect" "ppx_expect"

View file

@ -7,7 +7,6 @@ let tournaments : Lib.tournament_scrape_context list =
id = 357; id = 357;
season = 69619; season = 69619;
name = "CWC"; name = "CWC";
emoji = "🇧🇷";
filter_foreigners = true; filter_foreigners = true;
timezone_offset = None; timezone_offset = None;
}; };
@ -15,7 +14,6 @@ let tournaments : Lib.tournament_scrape_context list =
id = 384; id = 384;
season = 70083; season = 70083;
name = "LIBERTADORES"; name = "LIBERTADORES";
emoji = "🇧🇷";
filter_foreigners = false; filter_foreigners = false;
timezone_offset = None; timezone_offset = None;
}; };
@ -23,7 +21,6 @@ let tournaments : Lib.tournament_scrape_context list =
id = 480; id = 480;
season = 70070; season = 70070;
name = "SUDAMERICANA"; name = "SUDAMERICANA";
emoji = "🇧🇷";
filter_foreigners = false; filter_foreigners = false;
timezone_offset = None; timezone_offset = None;
}; };
@ -31,7 +28,6 @@ let tournaments : Lib.tournament_scrape_context list =
id = 373; id = 373;
season = 71944; season = 71944;
name = "COPA DO BRASIL"; name = "COPA DO BRASIL";
emoji = "🇧🇷";
filter_foreigners = false; filter_foreigners = false;
timezone_offset = None; timezone_offset = None;
}; };
@ -39,7 +35,6 @@ let tournaments : Lib.tournament_scrape_context list =
id = 1596; id = 1596;
season = 69430; season = 69430;
name = "COPA DO NORDESTE"; name = "COPA DO NORDESTE";
emoji = "🇧🇷";
filter_foreigners = false; filter_foreigners = false;
timezone_offset = None; timezone_offset = None;
}; };
@ -47,7 +42,6 @@ let tournaments : Lib.tournament_scrape_context list =
id = 1024; id = 1024;
season = 70664; season = 70664;
name = "COPA ARGENTINA"; name = "COPA ARGENTINA";
emoji = "🇧🇷";
filter_foreigners = false; filter_foreigners = false;
timezone_offset = None; timezone_offset = None;
}; };
@ -55,7 +49,6 @@ let tournaments : Lib.tournament_scrape_context list =
id = 325; id = 325;
season = 72034; season = 72034;
name = "BRA1"; name = "BRA1";
emoji = "🇧🇷";
filter_foreigners = false; filter_foreigners = false;
timezone_offset = None; timezone_offset = None;
}; };
@ -63,7 +56,6 @@ let tournaments : Lib.tournament_scrape_context list =
id = 155; id = 155;
season = 77826; season = 77826;
name = "ARG1"; name = "ARG1";
emoji = "🇧🇷";
filter_foreigners = false; filter_foreigners = false;
timezone_offset = None; timezone_offset = None;
}; };
@ -71,7 +63,6 @@ let tournaments : Lib.tournament_scrape_context list =
id = 278; id = 278;
season = 71306; season = 71306;
name = "URY1"; name = "URY1";
emoji = "🇧🇷";
filter_foreigners = false; filter_foreigners = false;
timezone_offset = None; timezone_offset = None;
}; };
@ -79,7 +70,6 @@ let tournaments : Lib.tournament_scrape_context list =
id = 11536; id = 11536;
season = 77825; season = 77825;
name = "COL1"; name = "COL1";
emoji = "🇧🇷";
filter_foreigners = false; filter_foreigners = false;
timezone_offset = Some ~-5; timezone_offset = Some ~-5;
}; };
@ -87,7 +77,6 @@ let tournaments : Lib.tournament_scrape_context list =
id = 1335; id = 1335;
season = 76050; season = 76050;
name = "COPA COLOMBIA"; name = "COPA COLOMBIA";
emoji = "🇧🇷";
filter_foreigners = false; filter_foreigners = false;
timezone_offset = Some ~-5; timezone_offset = Some ~-5;
}; };
@ -95,7 +84,6 @@ let tournaments : Lib.tournament_scrape_context list =
id = 11653; id = 11653;
season = 71131; season = 71131;
name = "CHL1"; name = "CHL1";
emoji = "🇧🇷";
filter_foreigners = false; filter_foreigners = false;
timezone_offset = Some ~-4; timezone_offset = Some ~-4;
}; };
@ -103,7 +91,6 @@ let tournaments : Lib.tournament_scrape_context list =
id = 390; id = 390;
season = 72603; season = 72603;
name = "BRA2"; name = "BRA2";
emoji = "🇧🇷";
filter_foreigners = false; filter_foreigners = false;
timezone_offset = None; timezone_offset = None;
}; };
@ -111,7 +98,6 @@ let tournaments : Lib.tournament_scrape_context list =
id = 1221; id = 1221;
season = 71100; season = 71100;
name = "COPA CHILE"; name = "COPA CHILE";
emoji = "🇧🇷";
filter_foreigners = false; filter_foreigners = false;
timezone_offset = Some ~-4; timezone_offset = Some ~-4;
}; };
@ -119,7 +105,6 @@ let tournaments : Lib.tournament_scrape_context list =
id = 11541; id = 11541;
season = 69831; season = 69831;
name = "PRY1"; name = "PRY1";
emoji = "🇧🇷";
filter_foreigners = false; filter_foreigners = false;
timezone_offset = None; timezone_offset = None;
}; };
@ -145,11 +130,11 @@ let pp (day : Unix.tm) matches =
in in
if ppd_matches = "" then "" if ppd_matches = "" then ""
else else
sprintf ">%s %02d/%02d:\n%s" (weekday day.tm_wday) day.tm_mday (succ day.tm_mon) sprintf ">%s %02d/%02d:\n%s" (weekday day.tm_wday) day.tm_mday day.tm_mon
ppd_matches ppd_matches
let f () = let f () =
let fetched = Lwt_main.run @@ Lib.fetch_all_tournaments tournaments in let fetched = Lib.fetch_all tournaments in
let today = Unix.time () |> Unix.localtime in let today = Unix.time () |> Unix.localtime in
let tomorrow = Unix.time () +. (60. *. 60. *. 24.) |> Unix.localtime in let tomorrow = Unix.time () +. (60. *. 60. *. 24.) |> Unix.localtime in
let header = "### schedules" in let header = "### schedules" in

View file

@ -1,24 +0,0 @@
##### changelog:
2024-06-14 - rentry page initial release.
2024-06-16 - included ecuador as a conmebol country.
- fix formatting issues when there are no matches or all matches are concluded at a day.
2024-06-17 - added copa america.
2024-06-19 - added stats.
- added flag frequency counter.
2024-06-20 - tracking of multiple threads for stats.
- added posts per hour counter.
2024-06-21 - whitelist concacaf countries in copa america.
2024-08-?? - remove stats.
2025-01-06 - temporary script sunset.
2025-03-26 - update hardcoded queries. revives the script.
- mitigate the views counter inflation with a third-party counter.
2025-04-06 - reorder copa chile.
2025-06-04 - second attempt at reviving the script.
2025-06-07 - added copa colombia.
2025-06-14 - added club world cup filtering foreign clubs.
2025-06-27 - rewrite the script in ocaml.
2025-07-04 - updated PRY1.
2025-07-09 - added copa nordeste.
2025-07-11 - updated ARG1 and COL1.
2025-07-12 - use short team names.

View file

@ -23,7 +23,6 @@
ocaml ocaml
ppx_deriving_yojson ppx_deriving_yojson
cohttp-curl-lwt cohttp-curl-lwt
lwt_ppx
cohttp-lwt-unix cohttp-lwt-unix
lwt_ssl lwt_ssl
ppx_expect ppx_expect

View file

@ -2,4 +2,4 @@
(name api) (name api)
(public_name api) (public_name api)
(libraries cohttp cohttp-lwt-unix cohttp-curl-lwt yojson ppx_deriving_yojson.runtime) (libraries cohttp cohttp-lwt-unix cohttp-curl-lwt yojson ppx_deriving_yojson.runtime)
(preprocess (pps ppx_yojson_conv ppx_deriving.show ppx_expect lwt_ppx))) (preprocess (pps ppx_yojson_conv ppx_deriving.show ppx_expect)))

View file

@ -1,46 +0,0 @@
type match' =
string (* home team *) * int (* goal difference *) * string (* away team *)
let matches =
[
("foo", 1, "car");
("foo", 0, "bar");
("foo", 1, "far");
("car", 1, "bar");
("foo", ~-1, "bar");
("tar", 1, "fir");
("bar", 1, "qux");
("jor", ~-1, "far");
("xir", 1, "kar");
("car", ~-1, "qux");
("far", 1, "qux");
("car", 1, "foo");
]
let way a b =
let rec aux (at : string) (visited : string list) (accum : match' list) =
if at = b then [ List.rev accum ]
else
let matches =
matches |> List.filter (function _, score, _ -> score <> 0)
in
let h =
matches
|> List.filter (function home, score, away ->
score > 0 && home = at && not (List.exists (( = ) away) visited))
|> List.map (function (_, _, away) as x ->
aux away (at :: visited) (x :: accum))
|> List.concat
in
let a =
matches
|> List.filter (function home, score, away ->
score < 0 && away = at && not (List.exists (( = ) home) visited))
|> List.map (function (home, _, _) as x ->
aux home (at :: visited) (x :: accum))
|> List.concat
in
a @ h
in
aux a [] []

View file

@ -1,6 +1,5 @@
open Ppx_yojson_conv_lib.Yojson_conv.Primitives open Ppx_yojson_conv_lib.Yojson_conv.Primitives
open Printf open Printf
open Lwt.Infix
type api_status = { type api_status = {
code : int; code : int;
@ -9,12 +8,7 @@ type api_status = {
} }
[@@deriving yojson, show] [@@deriving yojson, show]
type api_country = { type api_country = { alpha2 : string; alpha3 : string; name : string }
alpha2 : string;
alpha3 : string;
name : string;
slug : string;
}
[@@yojson.allow_extra_fields] [@@deriving yojson, show] [@@yojson.allow_extra_fields] [@@deriving yojson, show]
type api_team_colors = { primary : string; secondary : string; text : string } type api_team_colors = { primary : string; secondary : string; text : string }
@ -23,27 +17,23 @@ type api_team_colors = { primary : string; secondary : string; text : string }
type api_team = { type api_team = {
id : int; id : int;
name : string; name : string;
shortName : string option; [@yojson.option] short_name : string option; [@key "shortName"] [@yojson.option]
gender : string; gender : string;
teamColors : api_team_colors; teamColors : api_team_colors;
country : api_country; country : api_country;
} }
[@@yojson.allow_extra_fields] [@@deriving yojson, show] [@@yojson.allow_extra_fields] [@@deriving yojson, show]
let team_name x = match x.shortName with Some x -> x | None -> x.name let team_name x = match x.short_name with Some x -> x | None -> x.name
type api_tournament = { type api_tournament_info = { name : string; slug : string }
name : string;
slug : string;
country : api_country option; [@yojson.option]
}
[@@yojson.allow_extra_fields] [@@deriving yojson, show] [@@yojson.allow_extra_fields] [@@deriving yojson, show]
type api_score = { type api_score = {
current : int; [@default 0] current : int;
period1 : int; [@default 0] period1 : int;
period2 : int; [@default 0] period2 : int;
normaltime : int; [@default 0] normaltime : int;
} }
[@@yojson.allow_extra_fields] [@@deriving yojson, show] [@@yojson.allow_extra_fields] [@@deriving yojson, show]
@ -55,14 +45,13 @@ type api_time = {
[@@yojson.allow_extra_fields] [@@deriving yojson, show] [@@yojson.allow_extra_fields] [@@deriving yojson, show]
type api_match = { type api_match = {
tournament : api_tournament; tournament : api_tournament_info;
homeTeam : api_team; homeTeam : api_team;
awayTeam : api_team; awayTeam : api_team;
homeScore : api_score; (* homeScore: api_team; *)
awayScore : api_score; (* awayScore: api_team; *)
status : api_status; status : api_status;
time : api_time; time : api_time;
id : int;
startTimestamp : int; startTimestamp : int;
} }
[@@yojson.allow_extra_fields] [@@deriving yojson, show] [@@yojson.allow_extra_fields] [@@deriving yojson, show]
@ -71,107 +60,16 @@ type api_events = { events : api_match list }
[@@yojson.allow_extra_fields] [@@deriving yojson, show] [@@yojson.allow_extra_fields] [@@deriving yojson, show]
type half = type half =
| First_Half of { injury_time1 : int option; period_start_timestamp : int } | FirstHalf of { injury_time1 : int option }
| Half_Time of { injury_time1 : int option } | HalfTime of { injury_time1 : int }
| Second_Half of { | SecondHalf of {
injury_time1 : int option; injury_time1 : int;
injury_time2 : int option; (* second_half_start_timestamp: int; *)
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; 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] [@@deriving show]
type api_standing_rows = { type time = { start_timestamp : int; half : half } [@@deriving show]
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 api_short_match = { winnerCode : int } [@@deriving yojson]
(* type api_team_events_table = (string * api_short_match list) Hashtbl.t *)
(* [@@deriving yojson] *)
(**)
(* type api_team_events_total = { *)
(* tournamentTeamEvents : (string, api_team_events_table) Hashtbl.t *)
(* } *)
(* [@@deriving yojson] *)
type match_info = { tournament : string } [@@deriving yojson]
(* type inner_map = (string, match_info list) Hashtbl.t *)
(* [@@deriving yojson] *)
(**)
(* type outer_map = (string, inner_map) Hashtbl.t *)
(* [@@deriving yojson] *)
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 = type status =
| NotStarted of { start_timestamp : int } | NotStarted of { start_timestamp : int }
@ -179,24 +77,18 @@ type status =
| Postponed | Postponed
| Canceled | Canceled
| Delayed | Delayed
| InProgress of { score : score; start_timestamp : int; half : half } | InProgress of time
| Completed of { score : score; start_timestamp : int } | Completed of time
[@@deriving show] [@@deriving show]
(* TODO: round info *) (* TODO: round info *)
type match' = { type match' = { status : status; home_team : api_team; away_team : api_team }
status : status;
home_team : api_team;
away_team : api_team;
api_id : int;
}
[@@deriving show] [@@deriving show]
type tournament_scrape_context = { type tournament_scrape_context = {
id : int; id : int;
season : int; season : int;
name : string; name : string;
emoji : string;
filter_foreigners : bool; filter_foreigners : bool;
timezone_offset : int option (* assumes UTC-3 if None *); timezone_offset : int option (* assumes UTC-3 if None *);
} }
@ -204,7 +96,7 @@ type tournament_scrape_context = {
let mmod a b = ((a mod b) + b) mod b let mmod a b = ((a mod b) + b) mod b
let is_conmebol (x : api_team) = let is_conmebol x =
match x.country.alpha2 with match x.country.alpha2 with
| "AR" | "BO" | "BR" | "CL" | "CO" | "EC" | "PY" | "PE" | "UY" | "VE" -> true | "AR" | "BO" | "BR" | "CL" | "CO" | "EC" | "PY" | "PE" | "UY" | "VE" -> true
| _ -> false | _ -> false
@ -273,13 +165,13 @@ let ( let* ) = Lwt.bind
exception Status_Not_found exception Status_Not_found
(* TODO: handle "resolution failed: name resolution failed" *) (* TODO: handle "resolution failed: name resolution failed" *)
let get url = let get url : string =
let http_get url = let http_get url =
Stdlib.flush Stdlib.stdout; Stdlib.flush Stdlib.stdout;
let req_headers = let req_headers =
Cohttp.Header.( Cohttp.Header.(
add (init ()) "X-Captcha" add (init ()) "X-Captcha"
"eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE3NTQzMTc2MTJ9.sMoqrrTQMoq1JJRJqn-pbOtPIOlOfh5gjrniyUKX_04") "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE3NTI0OTgxMTR9.sZk2yhTk5TeWu_kXE7RO__LDYKlPgZuaA7KKFsB_0GQ")
in in
let* resp, body = let* resp, body =
Cohttp_lwt_unix.Client.get ~headers:req_headers @@ Uri.of_string url Cohttp_lwt_unix.Client.get ~headers:req_headers @@ Uri.of_string url
@ -291,276 +183,57 @@ let get url =
Lwt.return (Ok b) Lwt.return (Ok b)
else Lwt.return @@ Error (Cohttp.Code.reason_phrase_of_code code) else Lwt.return @@ Error (Cohttp.Code.reason_phrase_of_code code)
in in
let* result = http_get url in Lwt_main.run
match result with Error str -> failwith str | Ok r -> Lwt.return r (let* result = http_get url in
match result with
let tables_of_api_standings_total (s : api_standings_total) : table list = | Error str -> failwith str
let must_some = function None -> failwith "impossible" | Some x -> x in | Ok result -> Lwt.return result)
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) = let matches_of_api_events (e : api_events) =
e.events e.events
|> List.map (fun (m : api_match) -> |> List.map (fun (m : api_match) ->
let period_start_timestamp =
match m.time with
| {
currentPeriodStartTimestamp = Some x;
injuryTime1 = _;
injuryTime2 = _;
} ->
x
| {
currentPeriodStartTimestamp = None;
injuryTime1 = _;
injuryTime2 = _;
} ->
m.startTimestamp
in
{ {
api_id = m.id;
home_team = m.homeTeam; home_team = m.homeTeam;
away_team = m.awayTeam; away_team = m.awayTeam;
status = status =
(match (m.status.description, m.status.typ, m.time) with (let typ = m.status.typ in
| ( "Halftime", let h =
"inprogress", match m.time with
{ | {
injuryTime1 = x;
injuryTime2 = _;
currentPeriodStartTimestamp = _;
} ) ->
InProgress
{
start_timestamp = m.startTimestamp;
half = Half_Time { injury_time1 = x };
score =
{
home_score = m.homeScore.current;
away_score = m.awayScore.current;
};
}
| ( "1st half",
"inprogress",
{
injuryTime1 = x; injuryTime1 = x;
injuryTime2 = None; injuryTime2 = None;
currentPeriodStartTimestamp = _; currentPeriodStartTimestamp = _;
} ) -> } ->
InProgress FirstHalf { injury_time1 = x }
{ | {
start_timestamp = m.startTimestamp; injuryTime1 = Some x;
half =
First_Half { injury_time1 = x; period_start_timestamp };
score =
{
home_score = m.homeScore.current;
away_score = m.awayScore.current;
};
}
| ( "2nd half",
"inprogress",
{
injuryTime1 = x;
injuryTime2 = y; injuryTime2 = y;
currentPeriodStartTimestamp = _; currentPeriodStartTimestamp = _;
} ) -> } ->
InProgress SecondHalf { injury_time1 = x; injury_time2 = y }
{ | {
start_timestamp = m.startTimestamp; injuryTime1 = None;
half = injuryTime2 = Some y;
Second_Half
{
injury_time1 = x;
injury_time2 = y;
period_start_timestamp;
};
score =
{
home_score = m.homeScore.current;
away_score = m.awayScore.current;
};
}
| ( "1st extra",
"inprogress",
{
injuryTime1 = x;
injuryTime2 = y;
currentPeriodStartTimestamp = _; currentPeriodStartTimestamp = _;
} ) -> } ->
InProgress SecondHalf { injury_time1 = 0; injury_time2 = Some y }
{ in
start_timestamp = m.startTimestamp; let t = { start_timestamp = m.startTimestamp; half = h } in
half = match typ with
First_Extra | "notstarted" ->
{
injury_time1 = x;
injury_time2 = y;
period_start_timestamp;
};
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 = _;
} ) ->
InProgress
{
start_timestamp = m.startTimestamp;
half =
Second_Extra
{
injury_time1 = x;
injury_time2 = y;
period_start_timestamp;
};
score =
{
home_score = m.homeScore.current;
away_score = m.awayScore.current;
};
}
| ( "Awaiting penalties",
"inprogress",
{
injuryTime1 = _;
injuryTime2 = _;
currentPeriodStartTimestamp = _;
} ) ->
InProgress
{
start_timestamp = m.startTimestamp;
half = Penalties;
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", _ ->
Completed
{
start_timestamp = m.startTimestamp;
score =
{
home_score = m.homeScore.current;
away_score = m.awayScore.current;
};
}
| _, "notstarted", _ ->
NotStarted { start_timestamp = m.startTimestamp } NotStarted { start_timestamp = m.startTimestamp }
| _, "canceled", _ -> Canceled | "postponed" -> Postponed
| _, "postponed", _ -> Postponed | "canceled" -> Canceled
| _, "suspended", _ -> | "suspended" -> Suspended { start_timestamp = m.startTimestamp }
Suspended { start_timestamp = m.startTimestamp } | "inprogress" -> InProgress t
| _, "delayed", _ -> Delayed | "finished" -> Completed t
| a, b, _ -> | "delayed" -> Delayed
failwith | _ -> failwith (sprintf "unrecognized match type: %s" typ));
@@ Printf.sprintf "impossible: %s %s %s" a b
(show_api_time m.time));
}) })
(* https://www.sofascore.com/api/v1/unique-tournament/480/season/70070/rounds *) let fetch_matches ctx =
(* https://www.sofascore.com/api/v1/unique-tournament/480/season/70070/events/round/636/slug/playoff-round *) let g order (* "last" for previous matches "next" for future matches *) =
try
let fetch ctx order (* "last" for previous matches "next" for future matches *)
=
try%lwt
let url =
sprintf sprintf
(* TLS fingerprinting is in place and it's been used to block our requests once (* 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. their systems detect we've been abusing their private API.
@ -568,40 +241,14 @@ let fetch ctx order (* "last" for previous matches "next" for future matches *)
HTTPS, so using plain HTTP makes it impossible for that to happen, HTTPS, so using plain HTTP makes it impossible for that to happen,
which they do generously accept. *) which they do generously accept. *)
"http://www.sofascore.com/api/v1/unique-tournament/%d/season/%d/events/%s/0" "http://www.sofascore.com/api/v1/unique-tournament/%d/season/%d/events/%s/0"
ctx.id ctx.season ctx.id ctx.season order
(match order with `Last -> "last" | `Next -> "next") |> get |> Yojson.Safe.from_string |> api_events_of_yojson
in |> matches_of_api_events
get url >|= Yojson.Safe.from_string >|= api_events_of_yojson
>|= matches_of_api_events
with with
| Status_Not_found -> Lwt.return [] | Status_Not_found -> []
| Ppx_yojson_conv_lib__Yojson_conv.Of_yojson_error (exn, _) -> raise exn | Ppx_yojson_conv_lib__Yojson_conv.Of_yojson_error (exn, _) ->
failwith @@ Printexc.to_string exn
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 =
tournaments |> List.map fetch_all_matches |> Lwt.all
let fetch_match_details id =
let url = sprintf "https://www.sofascore.com/api/v1/event/%d" id in
get url >|= Yojson.Safe.from_string
let standings context =
let url =
sprintf
"https://www.sofascore.com/api/v1/unique-tournament/%d/season/%d/standings/total"
context.id context.season
in in
get url >|= Yojson.Safe.from_string >|= api_standings_total_of_yojson Tournament.make ctx (List.append (g "last") (g "next"))
>|= tables_of_api_standings_total
(* let last_five_matches context = *) let fetch_all tournaments = tournaments |> List.map fetch_matches
(* let url = *)
(* sprintf "https://www.sofascore.com/api/v1/unique-tournament/%d/season/%d/team-events/total" *)
(* context.id context.season *)
(* in *)
(* (* get url >|= Yojson.Safe.from_string >|= *) *)
(* ;; *)

View file

@ -1,6 +0,0 @@
(executable
(public_name website)
(name main)
(libraries api dream tyxml)
(preprocess (pps tyxml-ppx))
)

View file

@ -1,504 +0,0 @@
open Printf
open Api
let context: Lib.tournament_scrape_context list = [
{
id = 384;
season = 70083;
name = "LIBERTADORES";
emoji = "🌎";
filter_foreigners = false;
timezone_offset = None;
};
{
id = 480;
season = 70070;
name = "SUDAMERICANA";
emoji = "🌎";
filter_foreigners = false;
timezone_offset = None;
};
{
id = 373;
season = 71944;
name = "COPA DO BRASIL";
emoji = "🇧🇷";
filter_foreigners = false;
timezone_offset = None;
};
{
id = 325;
season = 72034;
name = "BRAZIL 1";
emoji = "🇧🇷";
filter_foreigners = false;
timezone_offset = None;
};
{
id = 390;
season = 72603;
name = "BRAZIL 2";
emoji = "🇧🇷";
filter_foreigners = false;
timezone_offset = None;
};
{
id = 1596;
season = 69430;
name = "COPA DO NORDESTE";
emoji = "🇧🇷";
filter_foreigners = false;
timezone_offset = None;
};
{
id = 1024;
season = 70664;
name = "COPA ARGENTINA";
emoji = "🇦🇷";
filter_foreigners = false;
timezone_offset = None;
};
{
id = 155;
season = 77826;
name = "ARGENTINA 1, CLAUSURA";
emoji = "🇦🇷";
filter_foreigners = false;
timezone_offset = None;
};
{
id = 278;
season = 71306;
name = "URUGUAY 1";
emoji = "🇺🇾";
filter_foreigners = false;
timezone_offset = None;
};
{
id = 11536;
season = 77825;
name = "COLOMBIA 1";
emoji = "🇨🇴";
filter_foreigners = false;
timezone_offset = Some ~-5;
};
{
id = 1335;
season = 76050;
name = "COPA COLOMBIA";
emoji = "🇨🇴";
filter_foreigners = false;
timezone_offset = Some ~-5;
};
{
id = 11653;
season = 71131;
name = "CHILE 1";
emoji = "🇨🇱";
filter_foreigners = false;
timezone_offset = Some ~-4;
};
{
id = 1221;
season = 71100;
name = "COPA CHILE";
emoji = "🇨🇱";
filter_foreigners = false;
timezone_offset = Some ~-4;
};
{
id = 11541;
season = 69831;
name = "PARAGUAY 1, CLAUSURA";
emoji = "🇵🇾";
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 {
text-decoration: none;
transition: background-color 0.035s;
}
.match-table:last-child {
border-bottom: 0 !important
}
.match-table:hover {
background-color: var(--main-bg);
border-radius 3px 3px;
}
.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;
}
td:nth-child(3) {
font-weight: bold;
}
|}]
])
;;
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.section ~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; flex-wrap: wrap"]
(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 (
a ~a:[a_class ["match-table"] ; a_href @@ sprintf "/match/%d" match'.api_id ;
a_style "display: flex; justify-content: space-between; border-bottom: 1px black solid; \
padding-top: calc(var(--main-margin) * 2);"]
[
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 @@ sprintf "%s %s" x.context.emoji x.context.name]];
h4 [txt @@ sprintf "(%d/%d) Today" today.tm_mon today.tm_mday];
];
main y
]
)))
;
footer [];
])
;;
let match_details_page _ =
let open Tyxml.Html in
html
(my_head "index")
(body [
my_header () ;
main [
box
[ ]
];
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 ~a:[a_style "text-wrap: nowrap"] [ 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); text-wrap: nowrap;"] [txt t.name] ;
tab ;
]
in
html
(my_head "index")
(body [
my_header () ;
main [
box
[
h3 ~a:[] [txt @@ sprintf "%s %s" tournament.context.emoji tournament.context.name];
div (List.rev @@ 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 "/match/:id" begin fun request ->
let id' = int_of_string @@ Dream.param request "id" in
let* data = Lib.fetch_match_details id' in
Dream.html @@ html_to_string @@ match_details_page 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

Binary file not shown.

Before

Width:  |  Height:  |  Size: 62 B