(** Dune project file parsing. *)

type source_info =
  | Github of { user : string; repo : string }
  | Gitlab of { user : string; repo : string }
  | Tangled of { host : string; repo : string }  (** tangled.org style sources *)
  | Uri of { url : string; branch : string option }

type t = {
  name : string;
  source : source_info option;
  homepage : string option;
  packages : string list;
}

module Sexp = Sexplib0.Sexp

(** Extract string from a Sexp.Atom, or None if it's a List *)
let atom_string = function
  | Sexp.Atom s -> Some s
  | Sexp.List _ -> None

(** Parse source stanza: (source (github user/repo)) or (source (uri "url")) *)
let parse_source_inner sexp =
  match sexp with
  | Sexp.List [ Sexp.Atom "github"; Sexp.Atom user_repo ] -> (
      match String.split_on_char '/' user_repo with
      | [ user; repo ] -> Some (Github { user; repo })
      | _ -> None)
  | Sexp.List [ Sexp.Atom "gitlab"; Sexp.Atom user_repo ] -> (
      match String.split_on_char '/' user_repo with
      | [ user; repo ] -> Some (Gitlab { user; repo })
      | _ -> None)
  | Sexp.List [ Sexp.Atom "tangled"; Sexp.Atom host_repo ] -> (
      (* tangled sources: (tangled host.domain/repo) *)
      match String.index_opt host_repo '/' with
      | Some i ->
          let host = String.sub host_repo 0 i in
          let repo = String.sub host_repo (i + 1) (String.length host_repo - i - 1) in
          Some (Tangled { host; repo })
      | None -> None)
  | Sexp.List [ Sexp.Atom "uri"; Sexp.Atom url ] ->
      (* Check for branch in URI fragment *)
      let uri = Uri.of_string url in
      let branch = Uri.fragment uri in
      let url_without_fragment =
        Uri.with_fragment uri None |> Uri.to_string
      in
      Some (Uri { url = url_without_fragment; branch })
  | Sexp.Atom url ->
      (* Single atom URL (unlikely but handle it) *)
      let uri = Uri.of_string url in
      let branch = Uri.fragment uri in
      let url_without_fragment =
        Uri.with_fragment uri None |> Uri.to_string
      in
      Some (Uri { url = url_without_fragment; branch })
  | _ -> None

(** Find name in (package (name foo) ...) stanza *)
let rec find_package_name = function
  | [] -> None
  | Sexp.List [ Sexp.Atom "name"; Sexp.Atom name ] :: _ -> Some name
  | _ :: rest -> find_package_name rest

(** Extract all package names from parsed sexps *)
let extract_packages sexps =
  List.filter_map
    (function
      | Sexp.List (Sexp.Atom "package" :: rest) -> find_package_name rest
      | _ -> None)
    sexps

(** Find a simple string field like (name foo) or (homepage "url") *)
let find_string_field name sexps =
  List.find_map
    (function
      | Sexp.List [ Sexp.Atom n; value ] when n = name -> atom_string value
      | _ -> None)
    sexps

(** Find source field: (source ...) *)
let find_source sexps =
  List.find_map
    (function
      | Sexp.List [ Sexp.Atom "source"; inner ] -> parse_source_inner inner
      | _ -> None)
    sexps

let parse content =
  match Parsexp.Many.parse_string content with
  | Error err ->
      Error (Printf.sprintf "S-expression parse error: %s"
               (Parsexp.Parse_error.message err))
  | Ok sexps -> (
      match find_string_field "name" sexps with
      | None -> Error "dune-project missing (name ...) stanza"
      | Some name ->
          let source = find_source sexps in
          let homepage = find_string_field "homepage" sexps in
          let packages = extract_packages sexps in
          Ok { name; source; homepage; packages })

(** Normalize a URL to have git+ prefix *)
let normalize_git_url url =
  if String.starts_with ~prefix:"git+" url then url
  else if String.starts_with ~prefix:"git@" url then "git+" ^ url
  else if String.starts_with ~prefix:"https://" url then "git+" ^ url
  else if String.starts_with ~prefix:"http://" url then
    "git+https" ^ String.sub url 4 (String.length url - 4)
  else "git+" ^ url

(** Ensure URL ends with .git *)
let ensure_git_suffix url =
  if String.ends_with ~suffix:".git" url then url
  else url ^ ".git"

let dev_repo_url t =
  match t.source with
  | Some (Github { user; repo }) ->
      Ok (Printf.sprintf "git+https://github.com/%s/%s.git" user repo)
  | Some (Gitlab { user; repo }) ->
      Ok (Printf.sprintf "git+https://gitlab.com/%s/%s.git" user repo)
  | Some (Tangled { host; repo }) ->
      (* Tangled sources: https://tangled.sh/@handle/repo *)
      Ok (Printf.sprintf "git+https://tangled.sh/@%s/%s.git" host repo)
  | Some (Uri { url; _ }) ->
      Ok (normalize_git_url (ensure_git_suffix url))
  | None -> (
      match t.homepage with
      | Some homepage ->
          Ok (normalize_git_url (ensure_git_suffix homepage))
      | None ->
          Error
            (Printf.sprintf
               "Package %s must declare source or homepage in dune-project"
               t.name))

let url_with_branch t =
  match dev_repo_url t with
  | Error e -> Error e
  | Ok url ->
      let branch =
        match t.source with
        | Some (Uri { branch = Some b; _ }) -> b
        | _ -> "main"
      in
      Ok (url ^ "#" ^ branch)