Source file oCamlResScanners.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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
open OCamlRes
module PathFilter = struct
type t = Path.t -> bool
let any : t =
fun _ -> true
let none : t =
fun _ -> false
let exclude (f : t) : t =
fun path -> not (f path)
let all_of (fs : t list) : t =
fun path -> List.fold_left (fun r f -> r && (f path)) true fs
let any_of (fs : t list) : t =
fun path -> List.fold_left (fun r f -> r || (f path)) false fs
let limit (lvl : int) : t =
let rec loop lvl dirs =
match dirs with
| [] -> true
| _ :: tl when lvl > 0 -> loop (pred lvl) tl
| _ :: tl -> false
in
fun path -> loop lvl (fst path)
let has_extension (exts : string list) : t =
let module SS = Set.Make (String) in
let exts = List.fold_right SS.add exts SS.empty in
fun path ->
match path with
| (_, Some (_, Some ext)) -> SS.mem ext exts
| (_, None) -> true
| _ -> false
end
module ResFilter = struct
type 'a t = 'a Res.node -> bool
let any : _ t =
fun _ -> true
let none : _ t =
fun _ -> false
let exclude (f : 'a t) : 'a t =
fun res -> not (f res)
let all_of (fs : 'a t list) : 'a t =
fun res -> List.fold_left (fun r f -> r && (f res)) true fs
let any_of (fs : 'a t list) : 'a t =
fun res -> List.fold_left (fun r f -> r || (f res)) false fs
let empty_dir : _ t = function Res.Dir (_, []) -> true | _ -> false
end
let scan_unix_dir
(type t)
?(prefilter = PathFilter.any)
?(postfilter = ResFilter.any)
?(prefixed_file = false)
(module SF : OCamlResSubFormats.SubFormat with type t = t) base =
let open Res in
let rec scan path name pstr =
let res = try
if not (Sys.file_exists pstr) then
Some (Error (Printf.sprintf "no such file %S" pstr))
else if Sys.is_directory pstr then
if prefilter (name :: path, None) then
Some (scan_dir path name pstr)
else None
else if prefilter (name :: path, Some (Path.split_ext name)) then
match Path.of_string pstr with
| _, None -> assert false
| prefix, Some name ->
let name = Path.string_of_name name in
let node = scan_file (path @ prefix) name pstr in
if prefixed_file && prefix <> [] then
Some (Res.add_prefix ("root" :: prefix) node)
else
Some node
else None
with exn ->
let msg =
Printf.sprintf "scanning file %S, %s" pstr (Printexc.to_string exn) in
Some (Error msg)
in
match res with
| Some r when postfilter r -> res
| _ -> None
and scan_dir path name pstr =
let files = Array.to_list (Sys.readdir pstr) in
let pstrs = List.map (fun n -> n, pstr ^ "/" ^ n) files in
let npath = name :: path in
let contents = List.map (fun (n, p) -> scan npath n p) pstrs in
let contents =
List.fold_left
(fun r opt -> match opt with None -> r | Some p -> p :: r)
[] contents
in
Dir (name, contents)
and scan_file path name pstr =
let contents =
let chan = open_in_bin pstr in
let len = in_channel_length chan in
let buffer = Bytes.create len in
really_input chan buffer 0 len ;
close_in chan ;
Bytes.unsafe_to_string buffer
in
File (name, SF.from_raw (path, Some (Path.split_ext name)) contents)
in
match scan [] "root" base with
| Some (Dir (_, l)) -> l
| Some (File (_, ctns)) -> [ File (Filename.basename base, ctns) ]
| Some (Error _ as err) -> [ err ]
| None -> []