open! Core
open! Async
module E = Deferred.Or_error

let permission_exe = 0o700
let echo = ref false
let verbose = ref false

let set_defaults ?verbose:(v = !verbose) ?echo:(e = !echo) () =
  echo := e;
  verbose := v;
  ()
;;

module Process_flag = struct
  let echo = Command.Param.(flag "-shell-echo" no_arg ~doc:" show external shell calls")

  let verbose =
    Command.Param.(
      flag
        "-shell-verbose"
        no_arg
        ~doc:" let external shell call be more verbose (imply -shell-echo)")
  ;;

  let all =
    Command.Param.(
      map2 echo verbose ~f:(fun echo verbose -> set_defaults ~echo ~verbose ()))
  ;;
end

let flags = Process_flag.all
let endline std = if String.is_empty std then std else std ^ "\n"

let make_run from_output ?working_dir ?env ?(quiet_or_error = false) prog args =
  let command_text = lazy (prog :: args |> [%sexp_of: string list] |> Sexp.to_string) in
  if !echo then Core.Printf.printf "Shell: %s\n%!" (force command_text);
  let%bind.E process = Process.create ?working_dir ?env ~prog ~args () in
  let%map output = Process.collect_output_and_wait process in
  let { Process.Output.stdout; stderr; exit_status } = output in
  let error_and_status =
    match exit_status with
    | Error status -> Error (Some status)
    | Ok () ->
      if quiet_or_error && ((not (String.is_empty stdout)) || not (String.is_empty stderr))
      then Error None
      else Ok ()
  in
  if !verbose then Core.Printf.printf "%s%s%!" (endline stdout) (endline stderr);
  match error_and_status with
  | Ok () -> Ok (from_output output)
  | Error status ->
    let working_dir =
      match working_dir with
      | Some working_dir -> working_dir
      | None -> "none (cwd)"
    in
    let error =
      Error.of_lazy
        (lazy
          ((* not using an sexp_of_t because it makes the output unreadable by escaping
              newlines *)
            let status =
              match status with
              | Some status ->
                Sexp.to_string ([%sexp_of: Core_unix.Exit_or_signal.error] status)
              | None -> "error trace on stdout or stderr"
            in
            sprintf
              "working_dir: %s\n%sstatus: %s\ncommand: %s\n%s%s"
              working_dir
              (match env with
               | None -> ""
               | Some env -> sprintf !"environment: %{sexp#mach:Unix.env}" env)
              status
              (force command_text)
              stdout
              (if String.is_empty stdout then stderr else "\n" ^ stderr)))
    in
    Error error
;;

let run = make_run ignore

let run_lines =
  make_run ~quiet_or_error:false (function { Process.Output.stdout; _ } ->
    List.filter_map (String.split ~on:'\n' stdout) ~f:(fun s ->
      let s = String.rstrip s in
      if String.is_empty s then None else Some s))
;;

let getcwd () =
  Deferred.Or_error.try_with ~rest:`Log ~name:"Ocaml_plugin.Shell.getcwd" Sys.getcwd
;;

let chmod pathname ~perm =
  Deferred.Or_error.try_with ~rest:`Log ~extract_exn:true (fun () ->
    Unix.chmod pathname ~perm)
;;

let raw_temp_dir
      ~in_dir
      ?(prefix = "ocaml_plugin_")
      ?(suffix = ".build")
      ?(perm = permission_exe)
      ()
  =
  let fct () = Filename_unix.temp_dir ~perm ~in_dir prefix suffix in
  Deferred.Or_error.try_with ~rest:`Log ~extract_exn:true (fun () ->
    let%bind () = Unix.mkdir ~p:() ~perm in_dir in
    In_thread.run fct)
;;

let absolute_pathname filename =
  if Filename.is_relative filename
  then (
    let%map.E prefix = getcwd () in
    prefix ^/ filename)
  else Deferred.return (Ok filename)
;;

let absolute_pathnames filenames =
  let relative = ref false in
  let map filename =
    if Filename.is_relative filename
    then (
      relative := true;
      `relative filename)
    else `absolute filename
  in
  let filenames = List.rev_map ~f:map filenames in
  if !relative
  then (
    let%map.E cwd = getcwd () in
    let files =
      List.rev_map filenames ~f:(function
        | `absolute filename -> filename
        | `relative filename -> cwd ^/ filename)
    in
    files)
  else (
    let files =
      List.rev_map filenames ~f:(function
        | `absolute filename -> filename
        | `relative _ -> assert false)
    in
    Deferred.return (Ok files))
;;

(* this should return an absolute pathname *)
let temp_dir ~in_dir ?prefix ?suffix ?perm () =
  raw_temp_dir ~in_dir ?prefix ?suffix ?perm () >>=? absolute_pathname
;;

let rm ?r ?f paths =
  let r = Option.map r ~f:(fun () -> "-r") in
  let f = Option.map f ~f:(fun () -> "-f") in
  run "/bin/rm" (List.filter_map ~f:Fn.id [ r; f ] @ ("--" :: paths))
;;

let rmdir dir = run "/bin/rmdir" [ dir ]
let cp ~source ~dest = run "/bin/cp" [ source; dest ]
let readdir dir = Deferred.Or_error.try_with ~rest:`Log (fun () -> Sys.readdir dir)

 not using an sexp_of_t because it makes the output unreadable by escaping
              newlines 
 this should return an absolute pathname 
open! Core
open! Async
module E = Deferred.Or_error

let permission_exe = 0o700
let echo = ref false
let verbose = ref false

let set_defaults ?verbose:(v = !verbose) ?echo:(e = !echo) () =
  echo := e;
  verbose := v;
  ()
;;

module Process_flag = struct
  let echo = Command.Param.(flag "-shell-echo" no_arg ~doc:" show external shell calls")

  let verbose =
    Command.Param.(
      flag
        "-shell-verbose"
        no_arg
        ~doc:" let external shell call be more verbose (imply -shell-echo)")
  ;;

  let all =
    Command.Param.(
      map2 echo verbose ~f:(fun echo verbose -> set_defaults ~echo ~verbose ()))
  ;;
end

let flags = Process_flag.all
let endline std = if String.is_empty std then std else std ^ "\n"

let make_run from_output ?working_dir ?env ?(quiet_or_error = false) prog args =
  let command_text = lazy (prog :: args |> [%sexp_of: string list] |> Sexp.to_string) in
  if !echo then Core.Printf.printf "Shell: %s\n%!" (force command_text);
  let%bind.E process = Process.create ?working_dir ?env ~prog ~args () in
  let%map output = Process.collect_output_and_wait process in
  let { Process.Output.stdout; stderr; exit_status } = output in
  let error_and_status =
    match exit_status with
    | Error status -> Error (Some status)
    | Ok () ->
      if quiet_or_error && ((not (String.is_empty stdout)) || not (String.is_empty stderr))
      then Error None
      else Ok ()
  in
  if !verbose then Core.Printf.printf "%s%s%!" (endline stdout) (endline stderr);
  match error_and_status with
  | Ok () -> Ok (from_output output)
  | Error status ->
    let working_dir =
      match working_dir with
      | Some working_dir -> working_dir
      | None -> "none (cwd)"
    in
    let error =
      Error.of_lazy
        (lazy
            let status =
              match status with
              | Some status ->
                Sexp.to_string ([%sexp_of: Core_unix.Exit_or_signal.error] status)
              | None -> "error trace on stdout or stderr"
            in
            sprintf
              "working_dir: %s\n%sstatus: %s\ncommand: %s\n%s%s"
              working_dir
              (match env with
               | None -> ""
               | Some env -> sprintf !"environment: %{sexp#mach:Unix.env}" env)
              status
              (force command_text)
              stdout
              (if String.is_empty stdout then stderr else "\n" ^ stderr)))
    in
    Error error
;;

let run = make_run ignore

let run_lines =
  make_run ~quiet_or_error:false (function { Process.Output.stdout; _ } ->
    List.filter_map (String.split ~on:'\n' stdout) ~f:(fun s ->
      let s = String.rstrip s in
      if String.is_empty s then None else Some s))
;;

let getcwd () =
  Deferred.Or_error.try_with ~rest:`Log ~name:"Ocaml_plugin.Shell.getcwd" Sys.getcwd
;;

let chmod pathname ~perm =
  Deferred.Or_error.try_with ~rest:`Log ~extract_exn:true (fun () ->
    Unix.chmod pathname ~perm)
;;

let raw_temp_dir
      ~in_dir
      ?(prefix = "ocaml_plugin_")
      ?(suffix = ".build")
      ?(perm = permission_exe)
      ()
  =
  let fct () = Filename_unix.temp_dir ~perm ~in_dir prefix suffix in
  Deferred.Or_error.try_with ~rest:`Log ~extract_exn:true (fun () ->
    let%bind () = Unix.mkdir ~p:() ~perm in_dir in
    In_thread.run fct)
;;

let absolute_pathname filename =
  if Filename.is_relative filename
  then (
    let%map.E prefix = getcwd () in
    prefix ^/ filename)
  else Deferred.return (Ok filename)
;;

let absolute_pathnames filenames =
  let relative = ref false in
  let map filename =
    if Filename.is_relative filename
    then (
      relative := true;
      `relative filename)
    else `absolute filename
  in
  let filenames = List.rev_map ~f:map filenames in
  if !relative
  then (
    let%map.E cwd = getcwd () in
    let files =
      List.rev_map filenames ~f:(function
        | `absolute filename -> filename
        | `relative filename -> cwd ^/ filename)
    in
    files)
  else (
    let files =
      List.rev_map filenames ~f:(function
        | `absolute filename -> filename
        | `relative _ -> assert false)
    in
    Deferred.return (Ok files))
;;

let temp_dir ~in_dir ?prefix ?suffix ?perm () =
  raw_temp_dir ~in_dir ?prefix ?suffix ?perm () >>=? absolute_pathname
;;

let rm ?r ?f paths =
  let r = Option.map r ~f:(fun () -> "-r") in
  let f = Option.map f ~f:(fun () -> "-f") in
  run "/bin/rm" (List.filter_map ~f:Fn.id [ r; f ] @ ("--" :: paths))
;;

let rmdir dir = run "/bin/rmdir" [ dir ]
let cp ~source ~dest = run "/bin/cp" [ source; dest ]
let readdir dir = Deferred.Or_error.try_with ~rest:`Log (fun () -> Sys.readdir dir)
