concurrent requests with lwt
This commit is contained in:
parent
64368b1651
commit
aecbd157d7
3 changed files with 118 additions and 62 deletions
|
|
@ -134,7 +134,7 @@ let pp (day : Unix.tm) matches =
|
|||
ppd_matches
|
||||
|
||||
let f () =
|
||||
let fetched = Lib.fetch_all tournaments in
|
||||
let fetched = Lwt_main.run @@ Lib.fetch_all tournaments in
|
||||
let today = Unix.time () |> Unix.localtime in
|
||||
let tomorrow = Unix.time () +. (60. *. 60. *. 24.) |> Unix.localtime in
|
||||
let header = "### schedules" in
|
||||
|
|
|
|||
2
lib/dune
2
lib/dune
|
|
@ -2,4 +2,4 @@
|
|||
(name api)
|
||||
(public_name api)
|
||||
(libraries cohttp cohttp-lwt-unix cohttp-curl-lwt yojson ppx_deriving_yojson.runtime)
|
||||
(preprocess (pps ppx_yojson_conv ppx_deriving.show ppx_expect)))
|
||||
(preprocess (pps ppx_yojson_conv ppx_deriving.show ppx_expect lwt_ppx)))
|
||||
|
|
|
|||
160
lib/lib.ml
160
lib/lib.ml
|
|
@ -1,5 +1,7 @@
|
|||
open Ppx_yojson_conv_lib.Yojson_conv.Primitives
|
||||
open Printf
|
||||
open Lwt.Infix
|
||||
|
||||
|
||||
type api_status = {
|
||||
code : int;
|
||||
|
|
@ -30,10 +32,10 @@ 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;
|
||||
current : int [@default 0];
|
||||
period1 : int [@default 0];
|
||||
period2 : int [@default 0];
|
||||
normaltime : int [@default 0];
|
||||
}
|
||||
[@@yojson.allow_extra_fields] [@@deriving yojson, show]
|
||||
|
||||
|
|
@ -48,8 +50,8 @@ type api_match = {
|
|||
tournament : api_tournament_info;
|
||||
homeTeam : api_team;
|
||||
awayTeam : api_team;
|
||||
(* homeScore: api_team; *)
|
||||
(* awayScore: api_team; *)
|
||||
homeScore : api_score;
|
||||
awayScore : api_score;
|
||||
status : api_status;
|
||||
time : api_time;
|
||||
startTimestamp : int;
|
||||
|
|
@ -60,16 +62,16 @@ 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 }
|
||||
| FirstHalf of { injury_time1 : int option; period_start_timestamp : int }
|
||||
| HalfTime of { injury_time1 : int option }
|
||||
| SecondHalf of {
|
||||
injury_time1 : int;
|
||||
(* second_half_start_timestamp: int; *)
|
||||
injury_time1 : int option;
|
||||
injury_time2 : int option;
|
||||
period_start_timestamp : int;
|
||||
}
|
||||
[@@deriving show]
|
||||
|
||||
type time = { start_timestamp : int; half : half } [@@deriving show]
|
||||
type score = { home_score : int; away_score : int } [@@deriving show]
|
||||
|
||||
type status =
|
||||
| NotStarted of { start_timestamp : int }
|
||||
|
|
@ -77,8 +79,8 @@ type status =
|
|||
| Postponed
|
||||
| Canceled
|
||||
| Delayed
|
||||
| InProgress of time
|
||||
| Completed of time
|
||||
| InProgress of { score : score; start_timestamp : int; half : half }
|
||||
| Completed of { score : score; start_timestamp : int }
|
||||
[@@deriving show]
|
||||
|
||||
(* TODO: round info *)
|
||||
|
|
@ -165,7 +167,7 @@ let ( let* ) = Lwt.bind
|
|||
exception Status_Not_found
|
||||
|
||||
(* TODO: handle "resolution failed: name resolution failed" *)
|
||||
let get url : string =
|
||||
let get url =
|
||||
let http_get url =
|
||||
Stdlib.flush Stdlib.stdout;
|
||||
let req_headers =
|
||||
|
|
@ -183,11 +185,10 @@ let get url : string =
|
|||
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
|
||||
let* result = http_get url in
|
||||
match result with
|
||||
| Error str -> failwith str
|
||||
| Ok result -> Lwt.return result)
|
||||
| Ok r -> Lwt.return r
|
||||
|
||||
let matches_of_api_events (e : api_events) =
|
||||
e.events
|
||||
|
|
@ -196,44 +197,95 @@ let matches_of_api_events (e : api_events) =
|
|||
home_team = m.homeTeam;
|
||||
away_team = m.awayTeam;
|
||||
status =
|
||||
(let typ = m.status.typ in
|
||||
let h =
|
||||
match m.time with
|
||||
| {
|
||||
(match (m.status.description, m.status.typ, m.time) with
|
||||
| ( "Halftime",
|
||||
"inprogress",
|
||||
{
|
||||
injuryTime1 = x;
|
||||
injuryTime2 = _;
|
||||
currentPeriodStartTimestamp = _;
|
||||
} ) ->
|
||||
InProgress
|
||||
{
|
||||
start_timestamp = m.startTimestamp;
|
||||
half = HalfTime { injury_time1 = x };
|
||||
score =
|
||||
{
|
||||
home_score = m.homeScore.current;
|
||||
away_score = m.awayScore.current;
|
||||
};
|
||||
}
|
||||
| ( "1st half",
|
||||
"inprogress",
|
||||
{
|
||||
injuryTime1 = x;
|
||||
injuryTime2 = None;
|
||||
currentPeriodStartTimestamp = _;
|
||||
} ->
|
||||
FirstHalf { injury_time1 = x }
|
||||
| {
|
||||
injuryTime1 = Some x;
|
||||
currentPeriodStartTimestamp = Some z;
|
||||
} ) ->
|
||||
InProgress
|
||||
{
|
||||
start_timestamp = m.startTimestamp;
|
||||
half =
|
||||
FirstHalf
|
||||
{ injury_time1 = x; period_start_timestamp = z };
|
||||
score =
|
||||
{
|
||||
home_score = m.homeScore.current;
|
||||
away_score = m.awayScore.current;
|
||||
};
|
||||
}
|
||||
| ( "2nd half",
|
||||
"inprogress",
|
||||
{
|
||||
injuryTime1 = 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" ->
|
||||
currentPeriodStartTimestamp = Some z;
|
||||
} ) ->
|
||||
InProgress
|
||||
{
|
||||
start_timestamp = m.startTimestamp;
|
||||
half =
|
||||
SecondHalf
|
||||
{
|
||||
injury_time1 = x;
|
||||
injury_time2 = y;
|
||||
period_start_timestamp = z;
|
||||
};
|
||||
score =
|
||||
{
|
||||
home_score = m.homeScore.current;
|
||||
away_score = m.awayScore.current;
|
||||
};
|
||||
}
|
||||
| "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 }
|
||||
| "postponed" -> Postponed
|
||||
| "canceled" -> Canceled
|
||||
| "suspended" -> Suspended { start_timestamp = m.startTimestamp }
|
||||
| "inprogress" -> InProgress t
|
||||
| "finished" -> Completed t
|
||||
| "delayed" -> Delayed
|
||||
| _ -> failwith (sprintf "unrecognized match type: %s" typ));
|
||||
| _, "canceled", _ -> Canceled
|
||||
| _, "postponed", _ -> Postponed
|
||||
| _, "suspended", _ ->
|
||||
Suspended { start_timestamp = m.startTimestamp }
|
||||
| a, b, _ ->
|
||||
failwith
|
||||
@@ Printf.sprintf "impossible: %s %s %s" a b
|
||||
(show_api_time m.time));
|
||||
})
|
||||
|
||||
|
||||
let fetch_matches ctx =
|
||||
let g order (* "last" for previous matches "next" for future matches *) =
|
||||
try
|
||||
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.
|
||||
|
|
@ -242,13 +294,17 @@ let fetch_matches ctx =
|
|||
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
|
||||
in
|
||||
|
||||
get url >|= Yojson.Safe.from_string >|= api_events_of_yojson >|= matches_of_api_events
|
||||
with
|
||||
| Status_Not_found -> []
|
||||
| Status_Not_found -> Lwt.return []
|
||||
| Ppx_yojson_conv_lib__Yojson_conv.Of_yojson_error (exn, _) ->
|
||||
failwith @@ Printexc.to_string exn
|
||||
in
|
||||
Tournament.make ctx (List.append (g "last") (g "next"))
|
||||
let* last = g "last" in
|
||||
let* next = g "next" in
|
||||
Lwt.return @@ Tournament.make ctx @@ List.append last next
|
||||
|
||||
let fetch_all tournaments = tournaments |> List.map fetch_matches
|
||||
let fetch_all tournaments =
|
||||
tournaments |> List.map fetch_matches |> Lwt.all
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue