commit inicial
This commit is contained in:
commit
3e44b40c35
16 changed files with 23004 additions and 0 deletions
6
lib/dune
Normal file
6
lib/dune
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
(library
|
||||
(name api)
|
||||
(public_name api)
|
||||
; (modules api rentry)
|
||||
(libraries cohttp cohttp-lwt-unix cohttp-curl-lwt yojson ppx_deriving_yojson.runtime)
|
||||
(preprocess (pps ppx_yojson_conv ppx_deriving.show ppx_expect)))
|
||||
230
lib/lib.ml
Normal file
230
lib/lib.ml
Normal 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
|
||||
54
lib/rentry.ml
Normal file
54
lib/rentry.ml
Normal file
|
|
@ -0,0 +1,54 @@
|
|||
open Cohttp
|
||||
|
||||
let ( let* ) = Lwt.bind
|
||||
|
||||
let update_page content =
|
||||
let aux () =
|
||||
let* resp, _ =
|
||||
Cohttp_lwt_unix.Client.get (Uri.of_string "https://rentry.org")
|
||||
in
|
||||
let code = resp |> Response.status |> Code.code_of_status in
|
||||
if not (Code.is_success code) then
|
||||
Lwt.return (Error (Cohttp.Code.reason_phrase_of_code code))
|
||||
else
|
||||
let cookies =
|
||||
Cohttp.Response.headers resp |> Cookie.Set_cookie_hdr.extract
|
||||
in
|
||||
let token = List.assoc "csrftoken" cookies in
|
||||
let _, value = token.cookie in
|
||||
let form =
|
||||
Cohttp_lwt.Body.of_form
|
||||
[
|
||||
("csrfmiddlewaretoken", [ value ]);
|
||||
("edit_code", [ "foo perro bar caca" ]);
|
||||
("text", [ content ]);
|
||||
]
|
||||
in
|
||||
let uri = Uri.of_string "https://rentry.org/copalib-schedule/edit" in
|
||||
let req_headers =
|
||||
Cohttp.Header.(
|
||||
let h0 = init () in
|
||||
let h1 = add h0 "Referer" "https://rentry.org" in
|
||||
let h2 = add h1 "Content-Type" "application/x-www-form-urlencoded" in
|
||||
let h3 = add h2 "User-Agent" "copabot/v0.1.0" in
|
||||
let hname, hvalue =
|
||||
cookies
|
||||
|> List.map (fun (x : string * Cookie.Set_cookie_hdr.t) ->
|
||||
let _, v = x in
|
||||
v.cookie)
|
||||
|> Cookie.Cookie_hdr.serialize
|
||||
in
|
||||
add h3 hname hvalue)
|
||||
in
|
||||
let* resp, _ =
|
||||
Cohttp_lwt_unix.Client.post uri ?body:(Some form)
|
||||
?headers:(Some req_headers)
|
||||
in
|
||||
let code = resp |> Response.status |> Code.code_of_status in
|
||||
if not (Code.is_success code || Code.is_redirection code) then
|
||||
Lwt.return (Error (Cohttp.Code.reason_phrase_of_code code))
|
||||
else Lwt.return (Ok ())
|
||||
in
|
||||
Lwt_main.run
|
||||
(let* result = aux () in
|
||||
match result with Error str -> failwith str | Ok _ -> Lwt.return ())
|
||||
Loading…
Add table
Add a link
Reference in a new issue