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

open Topkg_result

(* Environment variables. *)

module Env = struct
  let var name = try Some (Sys.getenv name) with Not_found -> None
  let opt_var name ~absent = match var name with None -> absent | Some v -> v
end

(* Directory operations *)

module Dir = struct

  (* Existence *)

  let exists dir =
    try Ok (Sys.(file_exists dir && is_directory dir)) with
    | Sys_error e -> R.error_msgf "%s: %s" dir e

  let must_exist dir = exists dir >>= function
  | true -> Ok dir
  | false -> R.error_msgf "%s: no such directory" dir

  (* Current working directory *)

  let current () = try Ok (Sys.getcwd ()) with Sys_error e -> R.error_msg e
  let set_current d =
    try Ok (Sys.chdir d) with Sys_error e -> R.error_msgf "%s: %s" d e

  let with_current dir f v =
    current ()
    >>= fun original -> set_current dir
    >>= fun () -> let r = f v in set_current original
    >>= fun () -> Ok r

  (* Directory contents *)

  let contents ?(dotfiles = false) ?(rel = false) p =
    try
      let files = Array.to_list @@ Sys.readdir p in
      if rel && dotfiles then Ok files else
      let rec loop acc = function
      | [] -> List.rev acc
      | f :: fs ->
          let acc =
            if not dotfiles && Topkg_string.is_prefix ~affix:"." f then acc else
            if rel then f :: acc else Topkg_fpath.append p f :: acc
          in
          loop acc fs
      in
      Ok (loop [] files)
    with
    | Sys_error e -> R.error_msgf "%s: %s" p e
end

(* File system operations *)

module File = struct

  (* Famous file paths *)

  let null = match Sys.os_type with
  | "Win32" -> "NUL"
  | _ -> "/dev/null"

  let dash = "-"

  (* Existence and deletion *)

  let exists f =
    try Ok (Sys.(file_exists f && not (is_directory f))) with
    | Sys_error e -> R.error_msgf "%s: %s" f e

  let must_exist f = exists f >>= function
  | true -> Ok f
  | false -> R.error_msgf "%s: no such file" f

  let delete ?(must_exist = false) f =
    try
      if not must_exist && not (Sys.file_exists f) then Ok () else
      Ok (Sys.remove f)
    with
    | Sys_error e -> R.error_msgf "%s: %s" f e

  (* Folding over files *)

  let fold ?(skip = fun _ -> false) f acc paths =
    let is_dir d = try Sys.is_directory d with Sys_error _ -> false in
    let readdir d =
      try Array.to_list (Sys.readdir d) with Sys_error _ -> []
    in
    let keep p = not (skip p) in
    let process acc file = f file acc in
    let rec aux f acc = function
    | (d :: ds) :: up ->
        let paths = List.rev_map (Filename.concat d) (readdir d) in
        let paths = List.find_all keep paths in
        let dirs, files = List.partition is_dir paths in
        let acc = List.fold_left process acc files in
        aux f acc (dirs :: ds :: up)
    | [] :: [] -> acc
    | [] :: up -> aux f acc up
    | _ -> assert false
    in
    let paths = List.find_all keep paths in
    let dirs, files = List.partition is_dir paths in
    let acc = List.fold_left process acc files in
    Ok (aux f acc (dirs :: []))

  (* Reading and writing *)

  let with_parent_check op op_name file =
    let err_no_parent op_name file =
      Topkg_string.strf
        "%s: Cannot %s file, parent directory does not exist" file op_name
    in
    (Dir.must_exist (Topkg_fpath.dirname file)
     >>= fun _ -> Ok (op file))
    |> R.reword_error @@ fun _ -> `Msg (err_no_parent op_name file)

  let safe_open_in_bin = with_parent_check open_in_bin "read"
  let safe_open_out_bin = with_parent_check open_out_bin "write"

  let read file =
    try
      let close ic = if file = dash then () else close_in_noerr ic in
      (if file = dash then Ok stdin else safe_open_in_bin file) >>= fun ic ->
      try
        let len = in_channel_length ic in
        let buf = Bytes.create len in
        really_input ic buf 0 len; close ic;
        Ok (Bytes.unsafe_to_string buf)
      with exn -> close ic; raise exn
    with Sys_error e -> R.error_msgf "%s: %s" file e

  let write file s =
    try
      let close oc = if file = dash then () else close_out_noerr oc in
      (if file = dash then Ok stdout else safe_open_out_bin file) >>= fun oc ->
      try output_string oc s; flush oc; close oc; Ok ()
      with exn -> close oc; raise exn
    with Sys_error e -> R.error_msgf "%s: %s" file e

  let write_subst file vars s = (* very ugly mister, too lazy to rewrite *)
    try
      let close oc = if file = dash then () else close_out_noerr oc in
      (if file = dash then Ok stdout else safe_open_out_bin file) >>= fun oc ->
      try
        let start = ref 0 in
        let last = ref 0 in
        let len = String.length s in
        while (!last < len - 4) do
          if not (s.[!last] = '%' && s.[!last + 1] = '%') then incr last else
          begin
            let start_subst = !last in
            let last_id = ref (!last + 2) in
            let stop = ref false in
            while (!last_id < len - 1 && not !stop) do
              if not (s.[!last_id] = '%' && s.[!last_id + 1] = '%') then begin
                if s.[!last_id] <> ' ' then (incr last_id) else
                (stop := true; last := !last_id)
              end else begin
                let id_start = start_subst + 2 in
                let id = String.sub s (id_start) (!last_id - id_start) in
                try
                  let subst = List.assoc id vars in
                  output oc (Bytes.unsafe_of_string s)
                    !start (start_subst - !start);
                  output_string oc subst;
                  stop := true;
                  start := !last_id + 2;
                  last := !last_id + 2;
                with Not_found ->
                  stop := true;
                  last := !last_id
              end
            done;
            (* we exited the loop because we reached eof *)
            if not !stop then last := !last_id
          end
        done;
        output oc (Bytes.unsafe_of_string s) !start (len - !start);
        flush oc;
        close oc;
        Ok ()
      with exn -> close oc; raise exn
    with Sys_error e -> R.error_msgf "%s: %s" file e

  let tmp () =
    try
      let f = Filename.temp_file (Filename.basename Sys.argv.(0)) "topkg" in
      at_exit (fun () -> ignore (delete f)); Ok f
    with Sys_error e -> R.error_msg e
end

(* Running commands *)

module Cmd = struct

  let err_empty_line = "no command, empty command line"

  let line ?stdout ?stderr cmd =
    let strf = Printf.sprintf in
    if Topkg_cmd.is_empty cmd then failwith err_empty_line else
    let cmd = List.rev_map Filename.quote (Topkg_cmd.to_rev_list cmd) in
    let cmd = String.concat " " cmd in
    let redirect fd f = strf " %d>%s" fd (Filename.quote f) in
    let stdout = match stdout with None -> "" | Some f -> redirect 1 f in
    let stderr = match stderr with None -> "" | Some f -> redirect 2 f in
    let win_quote = if Sys.win32 then "\"" else "" in
    strf "%s%s%s%s%s" win_quote cmd stdout stderr win_quote

  let exec ?stdout ?stderr cmd =
    try
      let line = line ?stdout ?stderr cmd in
      Topkg_log.debug (fun m -> m ~header:"EXEC" "@[<1>[%s]@]" line);
      Ok ((), (cmd, `Exited (Sys.command line)))
    with Sys_error e | Failure e -> R.error_msg e

  (* Command existence *)

  let test_cmd = match Sys.os_type with
  | "Win32" -> Topkg_cmd.v "where"
  | _ -> Topkg_cmd.(v "command" % "-v")

  let cmd_bin cmd =
    try List.hd (Topkg_cmd.to_list cmd) with
    | Failure _ -> failwith err_empty_line

  let exists cmd =
    try
      let bin = cmd_bin cmd in
      let cmd = Topkg_cmd.(test_cmd % bin) in
      match exec ~stdout:File.null ~stderr:File.null cmd with
      | Ok (_, (_, `Exited 0)) -> Ok true
      | Ok _ -> Ok false
      | Error _ as e -> e
    with
    Failure e -> R.error_msg e

  let must_exist cmd = exists cmd >>= function
  | false -> R.error_msgf "%s: no such command" (cmd_bin cmd)
  | true -> Ok cmd

  (* Running commands *)

  type run_status = Topkg_cmd.t * [ `Exited of int ]

  let success r = r >>= function
    | (v, (_, `Exited 0)) -> Ok v
    | (v, (cmd, `Exited c)) ->
        R.error_msgf "cmd %a: exited with %d" Topkg_cmd.dump cmd c

  let run ?err:stderr cmd = exec ?stderr cmd |> success
  let run_status ?err:stderr cmd =
    exec ?stderr cmd >>= function ((), (_, st)) -> Ok st

  type run_out = { cmd : Topkg_cmd.t; err : Topkg_fpath.t option }

  let out_string ?(trim = true) o =
    File.tmp ()
    >>= fun file -> exec ?stderr:o.err ~stdout:file o.cmd
    >>= fun ((), st) -> File.read file
    >>= fun out -> Ok ((if trim then String.trim out else out), st)

  let out_lines ?trim o =
    out_string ?trim o >>= function (s, st) ->
    Ok ((if s = "" then [] else Topkg_string.cuts ~sep:'\n' s), st)

  let out_file stdout o = exec ?stderr:o.err ~stdout o.cmd
  let out_stdout o = exec ?stderr:o.err ?stdout:None o.cmd

  let to_string ?trim o = out_string ?trim o |> success
  let to_lines ?trim o = out_lines ?trim o |> success
  let to_file stdout o = out_file stdout o |> success
  let run_out ?err cmd = { cmd; err }
end
