Source file fileSys.ml

(*****************************************************************************)
(*                                                                           *)
(*  Copyright (C) 2026 Yves Ndiaye                                           *)
(*                                                                           *)
(* This Source Code Form is subject to the terms of the Mozilla Public       *)
(* License, v. 2.0. If a copy of the MPL was not distributed with this       *)
(* file, You can obtain one at https://mozilla.org/MPL/2.0/.                 *)
(*                                                                           *)
(*****************************************************************************)

(** [dir_exists path] checks if the file at [path] exists and is a directory *)
let dir_exists path =
  match Sys.file_exists path with
  | false ->
      false
  | true ->
      Sys.is_directory path

let create_folder ?(perm = 0o700) ~on_error folder =
  let to_path_string = folder in
  match Sys.file_exists to_path_string with
  | true ->
      Ok to_path_string
  | false ->
      let r =
        match Sys.mkdir to_path_string perm with
        | exception _ ->
            Error on_error
        | () ->
            Ok folder
      in
      r

let create_file ?(on_file = ignore) ~on_error file =
  try
    let () = ignore @@ Out_channel.with_open_bin file on_file in
    Ok file
  with _exn -> Error on_error

let split_path s =
  let regex = Re.(compile @@ str Filename.dir_sep) in
  Re.split regex s

let rec rmrf path =
  match Sys.is_directory path with
  | true -> (
      let () =
        Array.iter
          (fun name -> rmrf (Filename.concat path name))
          (Sys.readdir path)
      in
      let stats = Unix.lstat path in
      match stats.st_kind with
      | Unix.S_DIR ->
          Unix.rmdir path
      | S_REG | S_LNK | S_CHR | S_SOCK | S_FIFO ->
          Unix.unlink path
      | S_BLK ->
          ()
    )
  | false ->
      Sys.remove path
  | exception e ->
      raise e

(** [mkdirp root componenent] creates directories which start at [root] and
    recursively [componenent] *)
let rec mkdirp root componenent =
  let ( let* ) = Result.bind in
  let ok = Result.ok in
  let err = Result.error in
  match componenent with
  | [] ->
      ok root
  | t :: q ->
      let path = Filename.concat root t in
      let* () =
        match dir_exists path with
        | true ->
            ok ()
        | false -> (
            match Sys.mkdir path 0o755 with
            | () ->
                ok ()
            | exception _ ->
                err path
          )
      in
      mkdirp path q

let mkfilep ?outchan root componenent file =
  let ( let* ) = Result.bind in
  let* dir = mkdirp root componenent in
  let path = Filename.concat dir file in
  try
    let chan = Out_channel.open_text path in
    let () = Option.iter (( |> ) chan) outchan in
    let () = close_out_noerr chan in
    Ok path
  with _ -> Error path

let mk ~file ?outchan path =
  let s = split_path path in
  let root = Filename.dir_sep in
  match file with
  | false ->
      mkdirp root s
  | true -> (
      let spath, file = ListUtil.remove_last s in
      match file with
      | None ->
          Result.error path
      | Some file ->
          mkfilep ?outchan root spath file
    )

let read_chan chan =
  let buffer = Buffer.create 4_096 in
  let size = 1024 in
  let bytes = Bytes.create size in
  let continue = ref true in

  let () =
    while !continue do
      let read = input chan bytes 0 size in
      let () = Buffer.add_subbytes buffer bytes 0 read in
      continue := read = size
    done
  in
  Buffer.contents buffer

let read_all_chan ch = really_input_string ch (in_channel_length ch)
let read_all string = In_channel.with_open_bin string read_all_chan

let rec remove_prefix prefix path =
  match (prefix, path) with
  | [], [] | _ :: _, [] ->
      String.empty
  | [], (_ :: _ as s) ->
      String.concat Filename.dir_sep s
  | t1 :: q1, (t2 :: q2 as s) ->
      if String.equal t1 t2 then
        remove_prefix q1 q2
      else
        String.concat Filename.dir_sep s

let remove_prefix prefix path =
  let prefix = Unix.realpath prefix in
  let path = Unix.realpath path in
  let prefix = split_path prefix in
  let path = split_path path in
  remove_prefix prefix path

let cp_rm src dst =
  let created =
    mk ~file:true
      ~outchan:(fun oc ->
        let content = read_all src in
        output_string oc content
      )
      dst
  in
  Result.map (fun _ -> rmrf src) created

(** [move strategy src dst] *)
let move strategy src dst =
  match strategy with
  | `Move -> (
      try Ok (Unix.rename src dst)
      with Unix.Unix_error (EXDEV, _, _) -> cp_rm src dst
    )
  | `Copy ->
      let content = read_all src in
      let () =
        Out_channel.with_open_bin dst (fun oc -> output_string oc content)
      in
      Ok ()