unikernel/duniverse/dune_/otherlibs/dune-glob/dune

@@ -0,0 +1,2 @@
+(documentation
+ (package dune-glob))

unikernel/duniverse/dune_/otherlibs/dune-glob/index.mld

@@ -0,0 +1,38 @@
+{1 dune-glob - file globbing}
+
+{2 Introduction}
+
+A {e glob} is a way of referring to a set of files that match a certain
+pattern, such as "files with the [.ml] extension" or "files with [test] in
+their name".
+
+[dune-glob] exposes an abstraction so that we can refer to the first group as
+[*.ml] and the second one as [*test*].
+
+This library is used by Dune to implement this syntax in several places in
+[dune] files, but it can be used in other contexts as well.
+
+{2 Example}
+
+This is an executable that takes a glob as a command line argument, and lists
+the contents of the current directory that matches it:
+
+{[
+let () =
+  let glob_string = Sys.argv.(1) in
+  let glob = Dune_glob.V1.of_string glob_string in
+  let files = Sys.readdir "." in
+  ArrayLabels.iter files ~f:(fun n ->
+    if Dune_glob.V1.test glob n then
+      print_endline n)
+]}
+
+{2 API documentation}
+
+The entry point for this library is {!Dune_glob.V1}.
+
+{2 Note on stability}
+
+This library is fairly stable, but does not come with strong stability
+guarantees. In particular, while the module name suggests the API is versioned,
+it is not in the strict sense.

unikernel/duniverse/dune_/otherlibs/dune-glob/src/dune

@@ -0,0 +1,9 @@
+(library
+ (name dune_glob)
+ (public_name dune-glob)
+ (libraries stdune dune-private-libs.dune_re dyn ordering)
+ (flags
+  (:standard -w -50))
+ (synopsis "The glob language as understood by dune."))
+
+(ocamllex lexer)

unikernel/duniverse/dune_/otherlibs/dune-glob/src/dune_glob.ml

@@ -0,0 +1,3 @@
+(** Simple glob support library. *)
+
+module V1 = Glob

unikernel/duniverse/dune_/otherlibs/dune-glob/src/glob.ml

@@ -0,0 +1,76 @@
+open Stdune
+module Re = Dune_re
+
+type t =
+  | Re of
+      { re : Re.re
+      ; repr : string
+      }
+  | Literal of string
+
+let test t s =
+  match t with
+  | Literal t -> String.equal t s
+  | Re { re; repr = _ } -> Re.execp re s
+;;
+
+let empty = Re { re = Re.compile Re.empty; repr = "\000" }
+let universal = Re { re = Re.compile (Re.rep Re.any); repr = "**" }
+
+let of_string_result repr =
+  Lexer.parse_string repr
+  |> Result.map ~f:(function
+    | Lexer.Literal s -> Literal s
+    | Re re -> Re { re = Re.compile re; repr })
+;;
+
+let of_string repr =
+  match of_string_result repr with
+  | Error (_, msg) -> invalid_arg (Printf.sprintf "invalid glob: :%s" msg)
+  | Ok t -> t
+;;
+
+let to_string t =
+  match t with
+  | Re { repr; re = _ } -> repr
+  | Literal s -> s
+;;
+
+let to_dyn t = Dyn.variant "Glob" [ Dyn.string (to_string t) ]
+
+let of_string_exn loc repr =
+  match of_string_result repr with
+  | Error (_, msg) -> User_error.raise ~loc [ Pp.textf "invalid glob: %s" msg ]
+  | Ok t -> t
+;;
+
+let compare x y = String.compare (to_string x) (to_string y)
+let hash t = String.hash (to_string t)
+
+let matching_extensions extensions =
+  let re =
+    let open Re in
+    [ rep any
+    ; char '.'
+    ; List.map extensions ~f:(fun s ->
+        match of_string s with
+        | Literal _ -> str s
+        | Re _ ->
+          (* we cannot allow anything that can be parsed as a regex
+             here b/c we want the string representation to match [of_string]
+          *)
+          Code_error.raise "invalid extension" [ "s", Dyn.string s ])
+      |> alt
+    ]
+    |> seq
+    |> compile
+  in
+  Re
+    { re
+    ; repr =
+        (match extensions with
+         | [] -> Code_error.raise "empty list of extensions" []
+         | [ x ] -> sprintf "*.%s" x
+         | xs -> sprintf "*.{%s}" (String.concat xs ~sep:","))
+    }
+;;

unikernel/duniverse/dune_/otherlibs/dune-glob/src/glob.mli

@@ -0,0 +1,31 @@
+open Stdune
+
+(** Simple glob support library. *)
+
+type t
+
+(** A glob that matches nothing *)
+val empty : t
+
+(** A glob that matches anything (including the strings starting with a ".") *)
+val universal : t
+
+(** Tests if string matches the glob. *)
+val test : t -> string -> bool
+
+(** Returns textual representation of a glob. *)
+val to_string : t -> string
+
+(** Converts string to glob. Throws [Invalid_argument] exception if string is
+    not a valid glob. *)
+val of_string : string -> t
+
+val of_string_result : string -> (t, int * string) result
+val to_dyn : t -> Dyn.t
+val of_string_exn : Loc.t -> string -> t
+val compare : t -> t -> Ordering.t
+val hash : t -> int
+
+(** [matching_extensions xs] return a glob that will match any of the extensions
+    in [xs] *)
+val matching_extensions : Filename.Extension.t list -> t

unikernel/duniverse/dune_/otherlibs/dune-glob/src/lexer.mli

@@ -0,0 +1,7 @@
+open Stdune
+
+type t =
+  | Literal of string
+  | Re of Dune_re.t
+
+val parse_string : string -> (t, int * string) Result.result

unikernel/duniverse/dune_/otherlibs/dune-glob/src/lexer.mll

@@ -0,0 +1,88 @@
+{
+open! Stdune
+module Re = Dune_re
+open Re
+
+type t =
+  | Literal of string
+  | Re of Dune_re.t
+
+let no_slash        = diff any (char '/')
+let no_slash_no_dot = diff any (set "./")
+
+type stack =
+  | Bottom
+  | Lbrace of stack
+  | Char   of char * stack
+  | Re     of Re.t * stack
+  | Comma  of stack
+
+let make_group st =
+  let rec loop current_re full_res st =
+    match st with
+    | Bottom       -> failwith "'}' without opening '{'"
+    | Re (re, st)  -> loop (re :: current_re) full_res st
+    | Char (c, st) -> loop (char c :: current_re) full_res st
+    | Comma   st   -> loop [] (seq current_re :: full_res) st
+    | Lbrace  st   -> Re (alt (seq current_re :: full_res), st)
+  in
+  loop [] [] st
+
+let finalize st =
+  let rec loop acc st =
+    match st with
+    | Bottom      -> seq (start :: acc)
+    | Re (re, st) -> loop (re       :: acc) st
+    | Char (c, st)  -> loop (char c :: acc) st
+    | Comma   st  -> loop (char ',' :: acc) st
+    | Lbrace  _   -> failwith "unclosed '{'"
+  in
+  let rec try_str (acc : char list) st =
+    match st with
+    | Bottom -> Literal (String.of_list acc)
+    | Comma st -> try_str (',' :: acc) st
+    | Char (c, st) -> try_str (c :: acc) st
+    | st ->
+      let re =
+        let re = [stop] in
+        match acc with
+        | [] -> re
+        | _ :: _ -> str (String.of_list acc) :: re
+      in
+      Re (loop re st)
+  in
+  try_str [] st
+}
+
+rule initial = parse
+  | "**" { glob (Re (rep any, Bottom)) lexbuf }
+  | "*"  { glob (Re (seq [no_slash_no_dot; rep no_slash], Bottom)) lexbuf }
+  | ""   { glob Bottom lexbuf }
+
+and glob st = parse
+  | eof
+  | '\\' eof      { finalize st }
+  | '\\' (_ as c) { glob (Char (c                                 , st)) lexbuf }
+  | "**"          { glob (Re (seq [no_slash_no_dot; rep no_slash] , st)) lexbuf }
+  | '*'           { glob (Re (rep no_slash                        , st)) lexbuf }
+  | '?'           { glob (Re (no_slash                            , st)) lexbuf }
+  | '{'           { glob (Lbrace                                    st ) lexbuf }
+  | ','           { glob (Comma                                     st ) lexbuf }
+  | '}'           { glob (make_group st)                                 lexbuf }
+  | '['           { char_set st                                          lexbuf }
+  | ']'           { failwith "']' without opening '['"                          }
+  | _ as c        { glob (Char (c                                 , st)) lexbuf }
+
+and char_set st = parse
+  | '!' ([^ ']']* as s) "]" { glob (Re (diff any (set s) , st)) lexbuf }
+  |     ([^ ']']* as s) "]" { glob (Re (set s            , st)) lexbuf }
+  | ""                     { failwith "unclosed character set"        }
+
+{
+  let parse_string s =
+    let lb = Lexing.from_string s in
+    match initial lb with
+    | re -> Result.Ok re
+    | exception Failure msg ->
+      Error (Lexing.lexeme_start lb, msg)
+}

unikernel/duniverse/dune_/otherlibs/dune-glob/test/dune

@@ -0,0 +1,14 @@
+(library
+ (name dune_glob_unit_tests)
+ (inline_tests)
+ (libraries
+  stdune
+  dune_glob
+  ;; This is because of the (implicit_transitive_deps false)
+  ;; in dune-project
+  ppx_expect.config
+  ppx_expect.config_types
+  base
+  ppx_inline_test.config)
+ (preprocess
+  (pps ppx_expect)))

unikernel/duniverse/dune_/otherlibs/dune-glob/test/dune_glob_tests.ml

@@ -0,0 +1,87 @@
+open! Stdune
+module Glob = Dune_glob.V1
+
+let printf = Printf.printf
+
+let test glob s ~expect =
+  let res = Glob.test glob s in
+  let status = if res = expect then "pass" else "fail" in
+  printf "[%s] %S matches %S == %b" status (Glob.to_string glob) s res
+;;
+
+let%expect_test _ =
+  let glob = Glob.of_string "test" in
+  printf "%S" (Glob.to_string glob);
+  [%expect {| "test" |}]
+;;
+
+let%expect_test _ =
+  let glob = Glob.of_string "te*" in
+  test glob "test" ~expect:true;
+  [%expect {| [pass] "te*" matches "test" == true |}];
+  test glob "t" ~expect:false;
+  [%expect {| [pass] "te*" matches "t" == false |}];
+  test glob "te" ~expect:true;
+  [%expect {| [pass] "te*" matches "te" == true |}]
+;;
+
+let%expect_test _ =
+  let glob = Glob.of_string "*st" in
+  test glob "test" ~expect:true;
+  [%expect {| [pass] "*st" matches "test" == true |}];
+  test glob "t" ~expect:false;
+  [%expect {| [pass] "*st" matches "t" == false |}];
+  (* This is surprising, but documented *)
+  test glob "st" ~expect:false;
+  [%expect {| [pass] "*st" matches "st" == false |}];
+  test glob ".st" ~expect:false;
+  [%expect {| [pass] "*st" matches ".st" == false |}]
+;;
+
+let%expect_test _ =
+  let glob = Glob.of_string "foo.{ml,mli}" in
+  test glob "foo.ml" ~expect:true;
+  [%expect {| [pass] "foo.{ml,mli}" matches "foo.ml" == true |}];
+  test glob "foo.mli" ~expect:true;
+  [%expect {| [pass] "foo.{ml,mli}" matches "foo.mli" == true |}];
+  test glob "foo." ~expect:false;
+  [%expect {| [pass] "foo.{ml,mli}" matches "foo." == false |}]
+;;
+
+let%expect_test _ =
+  let glob = Glob.of_string "foo**" in
+  test glob "foo.ml" ~expect:false;
+  [%expect {| [pass] "foo**" matches "foo.ml" == false |}];
+  test glob "fooml" ~expect:true;
+  [%expect {| [pass] "foo**" matches "fooml" == true |}]
+;;
+
+let%expect_test _ =
+  let glob = Glob.of_string "**" in
+  test glob "foo/bar" ~expect:true;
+  [%expect {| [pass] "**" matches "foo/bar" == true |}];
+  test glob "" ~expect:true;
+  [%expect {| [pass] "**" matches "" == true |}];
+  test glob "foo.bar" ~expect:true;
+  [%expect {| [pass] "**" matches "foo.bar" == true |}]
+;;
+
+let%expect_test _ =
+  let glob = Glob.of_string "*" in
+  test glob ".foo" ~expect:false;
+  [%expect {| [pass] "*" matches ".foo" == false |}];
+  test glob "foo.ml" ~expect:true;
+  [%expect {| [pass] "*" matches "foo.ml" == true |}];
+  test glob "foo/" ~expect:false;
+  [%expect {| [pass] "*" matches "foo/" == false |}]
+;;
+
+let%expect_test _ =
+  let glob = Glob.of_string "[!._]*" in
+  test glob ".foo" ~expect:false;
+  [%expect {| [pass] "[!._]*" matches ".foo" == false |}];
+  test glob "foo.ml" ~expect:true;
+  [%expect {| [pass] "[!._]*" matches "foo.ml" == true |}];
+  test glob "a" ~expect:true;
+  [%expect {| [pass] "[!._]*" matches "a" == true |}]
+;;