235 lines
7.5 KiB
OCaml
235 lines
7.5 KiB
OCaml
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 }
|
|
| Suspended 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 (* 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 : t) =
|
|
let format_timestamp x =
|
|
let is_today start =
|
|
let t = start |> float_of_int |> Unix.localtime in
|
|
t.tm_mday = day.tm_mday && t.tm_mon = day.tm_mon
|
|
in
|
|
let important_match =
|
|
is_conmebol x.home_team || is_conmebol x.away_team
|
|
in
|
|
if tournament.context.filter_foreigners && not important_match then None
|
|
else
|
|
let timestamp =
|
|
match x.status with
|
|
| Postponed | Completed _ | Canceled -> None
|
|
| Suspended t ->
|
|
if is_today t.start_timestamp then Some "SUS! " else None
|
|
| InProgress t ->
|
|
if is_today t.start_timestamp then Some "NOW! " else None
|
|
| NotStarted t -> (
|
|
if not (is_today t.start_timestamp) then None
|
|
else
|
|
let ts1 = t.start_timestamp |> float_of_int |> Unix.localtime in
|
|
match tournament.context.timezone_offset with
|
|
| None -> Some (sprintf "%02d:%02d" ts1.tm_hour ts1.tm_min)
|
|
| Some off ->
|
|
let ts2 =
|
|
t.start_timestamp |> float_of_int |> Unix.gmtime
|
|
in
|
|
Some
|
|
(sprintf "%02d:%02d/%02d:%02d" ts1.tm_hour ts1.tm_min
|
|
(mmod (ts2.tm_hour + off) 24)
|
|
ts2.tm_min))
|
|
in
|
|
match timestamp with
|
|
| None -> None
|
|
| Some timestamp ->
|
|
Some
|
|
(sprintf "%s | %s x %s" timestamp x.home_team.name
|
|
x.away_team.name)
|
|
in
|
|
let m =
|
|
tournament.matches
|
|
|> List.filter_map format_timestamp
|
|
|> 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
|
|
|
|
(* TODO: handle "resolution fai led: name resolution failed" *)
|
|
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 }
|
|
| {
|
|
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
|
|
| "suspended" -> Suspended { start_timestamp = m.startTimestamp }
|
|
| "inprogress" -> InProgress t
|
|
| "finished" -> Completed t
|
|
| _ -> failwith (sprintf "unrecognized match type: %s" typ));
|
|
})
|
|
|
|
let fetch_matches ctx =
|
|
let g order (* "last" for previous matches "next" for future matches *) =
|
|
try
|
|
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
|
|
|> get |> Yojson.Safe.from_string |> api_events_of_yojson
|
|
|> matches_of_api_events
|
|
with Failure str when str = "Not Found" -> [] (* FIXME *)
|
|
in
|
|
Tournament.make ctx (List.append (g "last") (g "next"))
|
|
|
|
let fetch_all tournaments = tournaments |> List.map fetch_matches
|