Source file dune_filesystem_stubs.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
module File_kind = struct
  type t = Unix.file_kind =
    | S_REG
    | S_DIR
    | S_CHR
    | S_BLK
    | S_LNK
    | S_FIFO
    | S_SOCK

  module Option = struct
    [@@@warning "-37"]

    (* The values are constructed on the C-side *)
    type t =
      | S_REG
      | S_DIR
      | S_CHR
      | S_BLK
      | S_LNK
      | S_FIFO
      | S_SOCK
      | UNKNOWN

    let elim ~none ~some t =
      match t with
      | S_REG -> some (S_REG : Unix.file_kind)
      | S_DIR -> some S_DIR
      | S_CHR -> some S_CHR
      | S_BLK -> some S_BLK
      | S_LNK -> some S_LNK
      | S_FIFO -> some S_FIFO
      | S_SOCK -> some S_SOCK
      | UNKNOWN -> none ()
  end
end

module Readdir_result = struct
  [@@@warning "-37"]

  (* The values are constructed on the C-side *)
  type t =
    | End_of_directory
    | Entry of string * File_kind.Option.t
end

external readdir_with_kind_if_available_unix :
  Unix.dir_handle -> Readdir_result.t = "caml__dune_filesystem_stubs__readdir"

let readdir_with_kind_if_available_win32 : Unix.dir_handle -> Readdir_result.t =
 fun dir ->
  (* Windows also gives us the information about file kind and it's discarded by
     [readdir]. We could do better here, but the Windows code is more
     complicated. (there's an additional OCaml abstraction layer) *)
  match Unix.readdir dir with
  | exception End_of_file -> Readdir_result.End_of_directory
  | entry -> Entry (entry, UNKNOWN)

let readdir_with_kind_if_available : Unix.dir_handle -> Readdir_result.t =
  if Stdlib.Sys.win32 then
    readdir_with_kind_if_available_win32
  else
    readdir_with_kind_if_available_unix

let read_directory_with_kinds_exn dir_path =
  let dir = Unix.opendir dir_path in
  Fun.protect
    ~finally:(fun () -> Unix.closedir dir)
    (fun () ->
      let rec loop acc =
        match readdir_with_kind_if_available dir with
        | Entry (("." | ".."), _) -> loop acc
        | End_of_directory -> acc
        | Entry (base, kind) ->
          let k kind = loop ((base, kind) :: acc) in
          let skip () = loop acc in
          File_kind.Option.elim kind
            ~none:(fun () ->
              match Unix.lstat (Filename.concat dir_path base) with
              | exception _ ->
                (* File disappeared between readdir & lstat system calls. Handle
                   as if readdir never told us about it *)
                skip ()
              | stat -> k stat.st_kind)
            ~some:k
      in
      loop [])

let catch_unix_error f x =
  match f x with
  | exception Unix.Unix_error (error, _, _) -> Error error
  | res -> Ok res

let read_directory_with_kinds dir_path =
  catch_unix_error read_directory_with_kinds_exn dir_path

let read_directory_exn dir_path =
  let dir = Unix.opendir dir_path in
  Fun.protect
    ~finally:(fun () -> Unix.closedir dir)
    (fun () ->
      let rec loop acc =
        match readdir_with_kind_if_available dir with
        | Entry (("." | ".."), _) -> loop acc
        | End_of_directory -> acc
        | Entry (base, _) -> loop (base :: acc)
      in
      loop [])

let read_directory dir_path = catch_unix_error read_directory_exn dir_path