diff --git a/.ocamlinit b/.ocamlinit deleted file mode 100644 index cc14f36..0000000 --- a/.ocamlinit +++ /dev/null @@ -1 +0,0 @@ -open Lwt.Infix diff --git a/Dockerfile b/Dockerfile deleted file mode 100644 index 5f11a5b..0000000 --- a/Dockerfile +++ /dev/null @@ -1 +0,0 @@ -FROM ocaml/opam:debian diff --git a/README.md b/README.md deleted file mode 100644 index 7cdba71..0000000 --- a/README.md +++ /dev/null @@ -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. diff --git a/api.opam b/api.opam index d906f9e..cea7e74 100644 --- a/api.opam +++ b/api.opam @@ -14,7 +14,6 @@ depends: [ "ocaml" "ppx_deriving_yojson" "cohttp-curl-lwt" - "lwt_ppx" "cohttp-lwt-unix" "lwt_ssl" "ppx_expect" diff --git a/bin/main.ml b/bin/main.ml index 8773720..9855986 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -7,7 +7,6 @@ let tournaments : Lib.tournament_scrape_context list = id = 357; season = 69619; name = "CWC"; - emoji = "πŸ‡§πŸ‡·"; filter_foreigners = true; timezone_offset = None; }; @@ -15,7 +14,6 @@ let tournaments : Lib.tournament_scrape_context list = id = 384; season = 70083; name = "LIBERTADORES"; - emoji = "πŸ‡§πŸ‡·"; filter_foreigners = false; timezone_offset = None; }; @@ -23,7 +21,6 @@ let tournaments : Lib.tournament_scrape_context list = id = 480; season = 70070; name = "SUDAMERICANA"; - emoji = "πŸ‡§πŸ‡·"; filter_foreigners = false; timezone_offset = None; }; @@ -31,7 +28,6 @@ let tournaments : Lib.tournament_scrape_context list = id = 373; season = 71944; name = "COPA DO BRASIL"; - emoji = "πŸ‡§πŸ‡·"; filter_foreigners = false; timezone_offset = None; }; @@ -39,7 +35,6 @@ let tournaments : Lib.tournament_scrape_context list = id = 1596; season = 69430; name = "COPA DO NORDESTE"; - emoji = "πŸ‡§πŸ‡·"; filter_foreigners = false; timezone_offset = None; }; @@ -47,7 +42,6 @@ let tournaments : Lib.tournament_scrape_context list = id = 1024; season = 70664; name = "COPA ARGENTINA"; - emoji = "πŸ‡§πŸ‡·"; filter_foreigners = false; timezone_offset = None; }; @@ -55,7 +49,6 @@ let tournaments : Lib.tournament_scrape_context list = id = 325; season = 72034; name = "BRA1"; - emoji = "πŸ‡§πŸ‡·"; filter_foreigners = false; timezone_offset = None; }; @@ -63,7 +56,6 @@ let tournaments : Lib.tournament_scrape_context list = id = 155; season = 77826; name = "ARG1"; - emoji = "πŸ‡§πŸ‡·"; filter_foreigners = false; timezone_offset = None; }; @@ -71,7 +63,6 @@ let tournaments : Lib.tournament_scrape_context list = id = 278; season = 71306; name = "URY1"; - emoji = "πŸ‡§πŸ‡·"; filter_foreigners = false; timezone_offset = None; }; @@ -79,7 +70,6 @@ let tournaments : Lib.tournament_scrape_context list = id = 11536; season = 77825; name = "COL1"; - emoji = "πŸ‡§πŸ‡·"; filter_foreigners = false; timezone_offset = Some ~-5; }; @@ -87,7 +77,6 @@ let tournaments : Lib.tournament_scrape_context list = id = 1335; season = 76050; name = "COPA COLOMBIA"; - emoji = "πŸ‡§πŸ‡·"; filter_foreigners = false; timezone_offset = Some ~-5; }; @@ -95,7 +84,6 @@ let tournaments : Lib.tournament_scrape_context list = id = 11653; season = 71131; name = "CHL1"; - emoji = "πŸ‡§πŸ‡·"; filter_foreigners = false; timezone_offset = Some ~-4; }; @@ -103,7 +91,6 @@ let tournaments : Lib.tournament_scrape_context list = id = 390; season = 72603; name = "BRA2"; - emoji = "πŸ‡§πŸ‡·"; filter_foreigners = false; timezone_offset = None; }; @@ -111,7 +98,6 @@ let tournaments : Lib.tournament_scrape_context list = id = 1221; season = 71100; name = "COPA CHILE"; - emoji = "πŸ‡§πŸ‡·"; filter_foreigners = false; timezone_offset = Some ~-4; }; @@ -119,7 +105,6 @@ let tournaments : Lib.tournament_scrape_context list = id = 11541; season = 69831; name = "PRY1"; - emoji = "πŸ‡§πŸ‡·"; filter_foreigners = false; timezone_offset = None; }; @@ -145,11 +130,11 @@ let pp (day : Unix.tm) matches = in if ppd_matches = "" then "" 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 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 tomorrow = Unix.time () +. (60. *. 60. *. 24.) |> Unix.localtime in let header = "### schedules" in diff --git a/changelog.txt b/changelog.txt deleted file mode 100644 index b7a088e..0000000 --- a/changelog.txt +++ /dev/null @@ -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. - diff --git a/dune-project b/dune-project index 5ffeaec..36cdbce 100644 --- a/dune-project +++ b/dune-project @@ -23,7 +23,6 @@ ocaml ppx_deriving_yojson cohttp-curl-lwt - lwt_ppx cohttp-lwt-unix lwt_ssl ppx_expect diff --git a/lib/dune b/lib/dune index 77d0aee..8527db5 100644 --- a/lib/dune +++ b/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 lwt_ppx))) + (preprocess (pps ppx_yojson_conv ppx_deriving.show ppx_expect))) diff --git a/lib/foobar.ml b/lib/foobar.ml deleted file mode 100644 index af43965..0000000 --- a/lib/foobar.ml +++ /dev/null @@ -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 [] [] - diff --git a/lib/lib.ml b/lib/lib.ml index b81f46e..7b4b2e5 100644 --- a/lib/lib.ml +++ b/lib/lib.ml @@ -1,6 +1,5 @@ open Ppx_yojson_conv_lib.Yojson_conv.Primitives open Printf -open Lwt.Infix type api_status = { code : int; @@ -9,12 +8,7 @@ type api_status = { } [@@deriving yojson, show] -type api_country = { - alpha2 : string; - alpha3 : string; - name : string; - slug : string; -} +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 } @@ -23,27 +17,23 @@ type api_team_colors = { primary : string; secondary : string; text : string } type api_team = { id : int; name : string; - shortName : string option; [@yojson.option] + short_name : string option; [@key "shortName"] [@yojson.option] gender : string; teamColors : api_team_colors; country : api_country; } [@@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 = { - name : string; - slug : string; - country : api_country option; [@yojson.option] -} +type api_tournament_info = { name : string; slug : string } [@@yojson.allow_extra_fields] [@@deriving yojson, show] type api_score = { - current : int; [@default 0] - period1 : int; [@default 0] - period2 : int; [@default 0] - normaltime : int; [@default 0] + current : int; + period1 : int; + period2 : int; + normaltime : int; } [@@yojson.allow_extra_fields] [@@deriving yojson, show] @@ -55,14 +45,13 @@ type api_time = { [@@yojson.allow_extra_fields] [@@deriving yojson, show] type api_match = { - tournament : api_tournament; + tournament : api_tournament_info; homeTeam : api_team; awayTeam : api_team; - homeScore : api_score; - awayScore : api_score; + (* homeScore: api_team; *) + (* awayScore: api_team; *) status : api_status; time : api_time; - id : int; startTimestamp : int; } [@@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] type half = - | First_Half of { injury_time1 : int option; period_start_timestamp : int } - | Half_Time of { injury_time1 : int option } - | Second_Half of { - injury_time1 : int option; - injury_time2 : int option; - 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; + | 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; } - | Second_Extra of { - injury_time1 : int option; - injury_time2 : int option; - period_start_timestamp : int; - } - | Extra_Time_Await - | Penalties [@@deriving show] -type api_standing_rows = { - 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 time = { start_timestamp : int; half : half } [@@deriving show] type status = | NotStarted of { start_timestamp : int } @@ -179,24 +77,18 @@ type status = | Postponed | Canceled | Delayed - | InProgress of { score : score; start_timestamp : int; half : half } - | Completed of { score : score; start_timestamp : int } + | InProgress of time + | Completed of time [@@deriving show] (* TODO: round info *) -type match' = { - status : status; - home_team : api_team; - away_team : api_team; - api_id : int; -} +type match' = { status : status; home_team : api_team; away_team : api_team } [@@deriving show] type tournament_scrape_context = { id : int; season : int; name : string; - emoji : string; filter_foreigners : bool; 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 is_conmebol (x : api_team) = +let is_conmebol x = match x.country.alpha2 with | "AR" | "BO" | "BR" | "CL" | "CO" | "EC" | "PY" | "PE" | "UY" | "VE" -> true | _ -> false @@ -273,13 +165,13 @@ let ( let* ) = Lwt.bind exception Status_Not_found (* TODO: handle "resolution failed: name resolution failed" *) -let get url = +let get url : string = let http_get url = Stdlib.flush Stdlib.stdout; let req_headers = Cohttp.Header.( add (init ()) "X-Captcha" - "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE3NTQzMTc2MTJ9.sMoqrrTQMoq1JJRJqn-pbOtPIOlOfh5gjrniyUKX_04") + "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE3NTI0OTgxMTR9.sZk2yhTk5TeWu_kXE7RO__LDYKlPgZuaA7KKFsB_0GQ") in let* resp, body = Cohttp_lwt_unix.Client.get ~headers:req_headers @@ Uri.of_string url @@ -291,276 +183,57 @@ let get url = Lwt.return (Ok b) else Lwt.return @@ Error (Cohttp.Code.reason_phrase_of_code code) in - let* result = http_get url in - match result with Error str -> failwith str | Ok r -> Lwt.return r - -let tables_of_api_standings_total (s : api_standings_total) : table list = - let must_some = function None -> failwith "impossible" | Some x -> x in - 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 + 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) -> - 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; away_team = m.awayTeam; status = - (match (m.status.description, m.status.typ, m.time) with - | ( "Halftime", - "inprogress", - { - 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; - injuryTime2 = None; - currentPeriodStartTimestamp = _; - } ) -> - InProgress - { - start_timestamp = m.startTimestamp; - 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; - currentPeriodStartTimestamp = _; - } ) -> - InProgress - { - start_timestamp = m.startTimestamp; - half = - 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 = _; - } ) -> - InProgress - { - start_timestamp = m.startTimestamp; - half = - First_Extra - { - 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 } - | _, "canceled", _ -> Canceled - | _, "postponed", _ -> Postponed - | _, "suspended", _ -> - Suspended { start_timestamp = m.startTimestamp } - | _, "delayed", _ -> Delayed - | a, b, _ -> - failwith - @@ Printf.sprintf "impossible: %s %s %s" a b - (show_api_time m.time)); + (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 + | "delayed" -> Delayed + | _ -> failwith (sprintf "unrecognized match type: %s" typ)); }) -(* https://www.sofascore.com/api/v1/unique-tournament/480/season/70070/rounds *) -(* https://www.sofascore.com/api/v1/unique-tournament/480/season/70070/events/round/636/slug/playoff-round *) - -let fetch ctx order (* "last" for previous matches "next" for future matches *) - = - try%lwt - let url = +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. @@ -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, which they do generously accept. *) "http://www.sofascore.com/api/v1/unique-tournament/%d/season/%d/events/%s/0" - ctx.id ctx.season - (match order with `Last -> "last" | `Next -> "next") - in - get url >|= Yojson.Safe.from_string >|= api_events_of_yojson - >|= matches_of_api_events - with - | Status_Not_found -> Lwt.return [] - | Ppx_yojson_conv_lib__Yojson_conv.Of_yojson_error (exn, _) -> raise 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 + ctx.id ctx.season order + |> get |> Yojson.Safe.from_string |> api_events_of_yojson + |> matches_of_api_events + with + | Status_Not_found -> [] + | Ppx_yojson_conv_lib__Yojson_conv.Of_yojson_error (exn, _) -> + failwith @@ Printexc.to_string exn in - get url >|= Yojson.Safe.from_string >|= api_standings_total_of_yojson - >|= tables_of_api_standings_total + Tournament.make ctx (List.append (g "last") (g "next")) -(* let last_five_matches context = *) -(* 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 >|= *) *) -(* ;; *) +let fetch_all tournaments = tournaments |> List.map fetch_matches diff --git a/website/dune b/website/dune deleted file mode 100644 index 1e68279..0000000 --- a/website/dune +++ /dev/null @@ -1,6 +0,0 @@ -(executable - (public_name website) - (name main) - (libraries api dream tyxml) - (preprocess (pps tyxml-ppx)) - ) diff --git a/website/main.ml b/website/main.ml deleted file mode 100644 index 046622e..0000000 --- a/website/main.ml +++ /dev/null @@ -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 diff --git a/website/static/ae_mainbg.gif b/website/static/ae_mainbg.gif deleted file mode 100644 index f7a4519..0000000 Binary files a/website/static/ae_mainbg.gif and /dev/null differ