diff --git a/lib/glob.ml b/lib/glob.ml new file mode 100644 index 0000000..72b40ad --- /dev/null +++ b/lib/glob.ml @@ -0,0 +1,57 @@ +let rec wildcard pat s pi si = + let pn = String.length pat and sn = String.length s in + if pi >= pn then si >= sn + else + match pat.[pi] with + | '*' -> + let rec try_at k = k <= sn && (wildcard pat s (pi + 1) k || try_at (k + 1)) in + try_at si + | '?' -> si < sn && wildcard pat s (pi + 1) (si + 1) + | c -> si < sn && s.[si] = c && wildcard pat s (pi + 1) (si + 1) + +let matches pat s = wildcard pat s 0 0 +let has_magic s = String.exists (fun c -> c = '*' || c = '?') s + +let entries dir = + match Sys.readdir (if dir = "" then "." else dir) with + | a -> + let l = Array.to_list a in + List.sort compare (List.filter (fun e -> e <> "" && e.[0] <> '.') l) + | exception Sys_error _ -> [] + +let join dir name = if dir = "" then name else dir ^ "/" ^ name + +let rec walk dir segs = + match segs with + | [] -> if Sys.file_exists (if dir = "" then "." else dir) then [ dir ] else [] + | "**" :: rest -> + let here = walk dir rest in + let subs = List.filter (fun e -> Fs.is_dir (join dir e)) (entries dir) in + here @ List.concat_map (fun e -> walk (join dir e) ("**" :: rest)) subs + | seg :: rest when has_magic seg -> + entries dir + |> List.filter (fun e -> matches seg e) + |> List.concat_map (fun e -> walk (join dir e) rest) + | seg :: rest -> + let p = join dir seg in + if Sys.file_exists (if p = "" then "." else p) then walk p rest else [] + +let expand pattern = + if not (has_magic pattern) then if Sys.file_exists pattern then [ pattern ] else [] + else walk "" (String.split_on_char '/' pattern) + +let rec seg_match ps ss = + match (ps, ss) with + | [], [] -> true + | "**" :: pr, _ -> seg_match pr ss || (match ss with [] -> false | _ :: sr -> seg_match ps sr) + | p :: pr, s :: sr -> matches p s && seg_match pr sr + | _ -> false + +let match_path pattern path = + seg_match (String.split_on_char '/' pattern) (String.split_on_char '/' path) + +let expand_with ~extra pattern = + let real = expand pattern in + let virt = if has_magic pattern then List.filter (match_path pattern) extra + else List.filter (fun p -> p = pattern) extra in + List.sort_uniq compare (real @ virt)