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

commit inicial

Browse source
This commit is contained in:
silva guimaraes 2025-06-27 22:32:27 -03:00
commit 3e44b40c35
16 changed files with 23004 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

230
lib/lib.ml Normal file
View file

@ -0,0 +1,230 @@
open Ppx_yojson_conv_lib.Yojson_conv.Primitives
open Printf
type api_status = {
code : int;
description : string;
typ : string; [@key "type"]
}
[@@deriving yojson, show]
type api_country = { alpha2 : string; alpha3 : string; name : string }
[@@yojson.allow_extra_fields] [@@deriving yojson, show]
type api_team_colors = { primary : string; secondary : string; text : string }
[@@deriving yojson, show]
type api_team = {
id : int;
name : string;
gender : string;
teamColors : api_team_colors;
country : api_country;
}
[@@yojson.allow_extra_fields] [@@deriving yojson, show]
type api_tournament_info = { name : string; slug : string }
[@@yojson.allow_extra_fields] [@@deriving yojson, show]
type api_score = {
current : int;
period1 : int;
period2 : int;
normaltime : int;
}
[@@yojson.allow_extra_fields] [@@deriving yojson, show]
type api_time = {
injuryTime1 : int option; [@yojson.option]
injuryTime2 : int option; [@yojson.option]
currentPeriodStartTimestamp : int option; [@yojson.option]
}
[@@yojson.allow_extra_fields] [@@deriving yojson, show]
type api_match = {
tournament : api_tournament_info;
homeTeam : api_team;
awayTeam : api_team;
(* homeScore: api_team; *)
(* awayScore: api_team; *)
status : api_status;
time : api_time;
startTimestamp : int;
}
[@@yojson.allow_extra_fields] [@@deriving yojson, show]
type api_events = { events : api_match list }
[@@yojson.allow_extra_fields] [@@deriving yojson, show]
type half =
| FirstHalf of { injury_time1 : int option }
| HalfTime of { injury_time1 : int }
| SecondHalf of {
injury_time1 : int;
(* second_half_start_timestamp: int; *)
injury_time2 : int option;
}
[@@deriving show]
type time = { start_timestamp : int; half : half } [@@deriving show]
type status =
| NotStarted of { start_timestamp : int }
| Postponed
| Canceled
| InProgress of time
| Completed of time
[@@deriving show]
(* TODO: round info *)
type match' = { status : status; home_team : api_team; away_team : api_team }
[@@deriving show]
type tournament_scrape_context = {
id : int;
season : int;
name : string;
filter_foreigners : bool;
timezone_offset : int option (* we assumes UTC-3 if None *);
}
[@@deriving show]
let mmod a b = ((a mod b) + b) mod b
let is_conmebol x =
match x.country.alpha2 with
| "AR" | "BO" | "BR" | "CL" | "CO" | "EC" | "PY" | "PE" | "UY" | "VE" -> true
| _ -> false
module Tournament = struct
type t = { context : tournament_scrape_context; matches : match' list }
let make context matches = { context; matches }
let pp (day : Unix.tm) tournament =
let m =
tournament.matches
|> List.filter (fun x ->
match x.status with
| Postponed | Completed _ | Canceled -> false
| InProgress _ | NotStarted _ -> true)
|> List.filter (fun x ->
if tournament.context.filter_foreigners then
is_conmebol x.home_team || is_conmebol x.away_team
else true)
|> List.filter (fun x ->
let ts =
match x.status with
| Postponed | Canceled -> -1
| NotStarted t -> t.start_timestamp
| InProgress t -> t.start_timestamp
| Completed t -> t.start_timestamp
in
let t = ts |> float_of_int |> Unix.localtime in
t.tm_mday = day.tm_mday)
|> List.map (fun x ->
let timestamp =
match x.status with
| Postponed | Completed _ | Canceled ->
failwith "impossible: improper filter"
| InProgress _ -> "NOW! "
| NotStarted t -> (
let ts1 =
t.start_timestamp |> float_of_int |> Unix.localtime
in
match tournament.context.timezone_offset with
| None -> sprintf "%02d:%02d" ts1.tm_hour ts1.tm_min
| Some off ->
let ts2 =
t.start_timestamp |> float_of_int |> Unix.gmtime
in
sprintf "%02d:%02d/%02d:%02d" ts1.tm_hour ts1.tm_min
(mmod (ts2.tm_hour + off) 24) ts2.tm_min)
in
sprintf "%s | %s x %s" timestamp x.home_team.name x.away_team.name)
|> String.concat "\n"
in
if m = "" then ""
else
match tournament.context.timezone_offset with
| None -> sprintf ">%s\n%s" tournament.context.name m
| Some off -> sprintf ">%s (UTC%d)\n%s" tournament.context.name off m
end
let ( let* ) = Lwt.bind
let get url : string =
let http_get url =
Printf.printf "\r%-90s" url;
Stdlib.flush Stdlib.stdout;
let* resp, body = Cohttp_lwt_unix.Client.get (Uri.of_string url) in
let code = resp |> Cohttp.Response.status |> Cohttp.Code.code_of_status in
if Cohttp.Code.is_success code then
let* b = Cohttp_lwt.Body.to_string body in
Lwt.return (Ok b)
else Lwt.return (Error (Cohttp.Code.reason_phrase_of_code code))
in
Lwt_main.run
(let* result = http_get url in
match result with
| Error str -> failwith str
| Ok result -> Lwt.return result)
let matches_of_api_events (e : api_events) =
e.events
|> List.map (fun (m : api_match) ->
{
home_team = m.homeTeam;
away_team = m.awayTeam;
status =
(let typ = m.status.typ in
let h =
match m.time with
| {
injuryTime1 = x;
injuryTime2 = None;
currentPeriodStartTimestamp = _;
} ->
FirstHalf { injury_time1 = x }
| {
injuryTime1 = Some x;
injuryTime2 = y;
currentPeriodStartTimestamp = _;
} ->
SecondHalf
{
injury_time1 = x;
injury_time2 = y;
(* second_half_start_timestamp = z; *)
}
| {
injuryTime1 = None;
injuryTime2 = Some y;
currentPeriodStartTimestamp = _;
} ->
SecondHalf { injury_time1 = 0; injury_time2 = Some y }
in
let t = { start_timestamp = m.startTimestamp; half = h } in
match typ with
| "notstarted" ->
NotStarted { start_timestamp = m.startTimestamp }
| "postponed" -> Postponed
| "canceled" -> Canceled
| "inprogress" -> InProgress t
| "finished" -> Completed t
| _ -> failwith (sprintf "unrecognized match type: %s" typ));
})
let fetch_matches ctx =
let g order =
try
sprintf
"https://www.sofascore.com/api/v1/unique-tournament/%d/season/%d/events/%s/0"
ctx.id ctx.season order
|> get |> Yojson.Safe.from_string |> api_events_of_yojson
|> matches_of_api_events
with Failure str when str = "Not Found" -> []
in
Tournament.make ctx (List.append (g "last") (g "next"))
let fetch_all tournaments = tournaments |> List.map fetch_matches