(*---------------------------------------------------------------------------
   Copyright (c) 2016 Daniel C. Bünzli. All rights reserved.
   SPDX-License-Identifier: ISC
  ---------------------------------------------------------------------------*)

open Bos_setup

(* Command *)

let cmd =
  Cmd.of_list @@ Topkg.Cmd.to_list @@ Topkg.Conf.tool "opam" `Host_os

(* Publish *)

let publish =
  let absent = Cmd.(v "opam-publish") in
  OS.Env.(value "TOPKG_OPAM_PUBLISH" cmd ~absent)

let ensure_publish () =
  OS.Cmd.must_exist publish >>= fun cmd ->
  OS.Cmd.run_out Cmd.(publish % "--version") |> OS.Cmd.out_string
  >>= fun (version, _) -> match Topkg.String.parse_version version with
  | None -> R.error_msgf "Could not determine the version of opam-publish"
  | Some (m, _, _, _) when m < 2 ->
      R.error_msgf "topkg needs at least opam-publish 2.0.0"
  | Some _ -> Ok ()

let submit ?msg ~opam_file () =
  let msg = match msg with
  | None -> Ok (Cmd.empty)
  | Some msg ->
      OS.File.tmp "topkg-opam-submit-msg-%s"
      >>= fun m -> OS.File.write m msg
      >>= fun () -> Ok Cmd.(v "--msg-file" % p m)
  in
  msg >>= fun msg -> OS.Cmd.run Cmd.(publish %% msg % p opam_file)

(* Packages *)

let ocaml_base_packages = String.Set.of_list
    [ "base-bigarray"; "base-bytes"; "base-threads"; "base-unix"; ]

(* Files *)

module File = struct

  (* Try to compose with the OpamFile.OPAM API *)

  let id x = x
  let list f = fun v -> [f v]
  let field name field conv =
    name, fun acc o -> String.Map.add name (conv (field o)) acc

  let opt_field name field conv =
    name, fun acc o -> match field o with
    | None -> acc
    | Some v -> String.Map.add name (conv v) acc

  let deps_conv d =
    let add_pkg acc (n, _) = OpamPackage.Name.to_string n :: acc in
    OpamFormula.fold_left add_pkg [] d

  let fields = [
    opt_field "name" OpamFile.OPAM.name_opt (list OpamPackage.Name.to_string);
    opt_field "version" OpamFile.OPAM.version_opt
      (list OpamPackage.Version.to_string);
    field "opam-version" OpamFile.OPAM.opam_version
      (list OpamVersion.to_string);
    field "available" OpamFile.OPAM.available (list OpamFilter.to_string);
    field "maintainer" OpamFile.OPAM.maintainer id;
    field "homepage" OpamFile.OPAM.homepage id;
    field "authors" OpamFile.OPAM.author id;
    field "license" OpamFile.OPAM.license id;
    field "doc" OpamFile.OPAM.doc id;
    field "tags" OpamFile.OPAM.tags id;
    field "bug-reports" OpamFile.OPAM.bug_reports id;
    opt_field "dev-repo" OpamFile.OPAM.dev_repo (list OpamUrl.to_string);
    field "depends" OpamFile.OPAM.depends deps_conv;
    field "depopts" OpamFile.OPAM.depopts deps_conv;
    opt_field "synopsis" OpamFile.OPAM.synopsis (list id);
    opt_field "description" OpamFile.OPAM.descr_body (list id);
  ]

  let field_names =
    let add acc (name, field) = String.Set.add name acc in
    List.fold_left add String.Set.empty fields

  let fields file =
    let parse file  =
      let file = OpamFilename.of_string (Fpath.to_string file) in
      let opam = OpamFile.OPAM.read (OpamFile.make file) in
      let known_fields =
        let add_field acc (_, field) = field acc opam in
        List.fold_left add_field String.Map.empty fields
      in
      (* FIXME add OpamFile.OPAM.extensions when supported *)
      known_fields
    in
    Logs.info (fun m -> m "Parsing opam file %a" Fpath.pp file);
    try Ok (parse file) with
    | exn ->
        (* Apparently in at least opam-lib 1.2.2, the error will be logged
             on stdout. *)
        R.error_msgf "%a: could not parse opam file" Fpath.pp file

  let deps ?(opts = true) fields =
    let deps = match String.Map.find "depends" fields with
    | None -> [] | Some deps -> deps
    in
    let dep_opts =
      if not opts then [] else
      match String.Map.find "depopts" fields with
      | None -> []  | Some deps -> deps
    in
    String.Set.of_list (List.rev_append dep_opts deps)
end

module Descr = struct
  type t = string * string

  let of_string s = match String.cuts ~sep:"\n" s with
  | [] ->  R.error_msgf "Cannot extract opam descr."
  | synopsis :: descr -> Ok (synopsis, String.concat ~sep:"\n" descr)

  let to_string (synopsis, descr) = strf "%s\n%s" synopsis descr
  let to_opam_fields (synopsis, descr) =
    strf "synopsis: \"\"\"%s\"\"\"\ndescription: \"\"\"\\\n%s\"\"\""
      synopsis descr

  let of_readme ?flavour r =
    let parse_synopsis l =
      let error l = R.error_msgf "%S: can't extract opam synopsis" l in
      let ok s = Ok String.(Ascii.capitalize @@ String.Sub.to_string s) in
      let not_white c = not (Char.Ascii.is_white c) in
      let skip_non_white l = String.Sub.drop ~sat:not_white l in
      let skip_white l = String.Sub.drop ~sat:Char.Ascii.is_white l in
      let start =
        String.sub l |> skip_white |> skip_non_white |> skip_white
      in
      match String.Sub.head start with
      | None -> error l
      | Some c when Char.Ascii.is_letter c -> ok start
      | Some c -> (* Try to skip a separator. *)
          let start = start |> skip_non_white |> skip_white in
          match String.Sub.head start with
          | None -> error l
          | Some _ -> ok start
    in
    let drop_line l =
      String.is_prefix ~affix:"Home page:" l ||
      String.is_prefix ~affix:"Homepage:" l ||
      String.is_prefix ~affix:"Contact:" l ||
      String.is_prefix ~affix:"%%VERSION" l
    in
    let keep_line l = not (drop_line l) in
    match Topkg_care_text.head ?flavour r with
    | None -> R.error_msgf "Could not extract opam description."
    | Some (title, text) ->
        let sep = "\n" in
        let title = Topkg_care_text.header_title ?flavour title in
        parse_synopsis title
        >>= fun synopsis -> Ok (String.cuts ~sep text)
        >>= fun text -> Ok (List.filter keep_line text)
        >>= fun text -> Ok (synopsis, String.concat ~sep text)

  let of_readme_file file =
    let flavour = Topkg_care_text.flavour_of_fpath file in
    (OS.File.read file
     >>= fun text -> of_readme ?flavour text)
    |> R.reword_error_msg ~replace:true
      (fun m -> R.msgf "%a: %s" Fpath.pp file m)
end

module Url = struct
  type t = string
  let v ~uri ~checksum = strf "archive: \"%s\"\nchecksum: \"%s\"" uri checksum
  let with_distrib_file ~uri distrib_file =
    try
      let checksum = Digest.(to_hex @@ file (Fpath.to_string distrib_file)) in
      Ok (v ~uri ~checksum)
    with Failure msg | Sys_error msg -> R.error_msg msg

  let to_opam_section u = strf "url {\n%s\n}" u
end
