uuidtrip: add support for V7 UUID (#14).

B0.ml

@@ -25,7 +25,7 @@ let test_uuidm =
 let uuidtrip =
   let doc = "Generates universally unique identifiers (UUIDs)" in
   let srcs = [`File ~/"test/uuidtrip.ml"] in
-  let requires = [uuidm; cmdliner] in
+  let requires = [uuidm; unix; cmdliner] in
   B0_ocaml.exe "uuidtrip" ~public:true ~doc ~srcs ~requires
 
 (* Packs *)

CHANGES.md

@@ -18,6 +18,8 @@
   `Uuidm.{to,of}_[mixed_endian_]binary_string` (follow `Stdlib` terminology).
 - Require OCaml 4.14.
 - `uuidtrip` set standard output to binary when outputing binary uuids.
+- `uuidtrip` add options `--v3`, `--v4`, `--v5`, `--v7`.
+- `uuidtrip` add support for v7 time and random based v7 UUIDs generation.
 
 v0.9.8 2022-02-09 La Forclaz (VS)
 ---------------------------------

_tags

@@ -4,4 +4,4 @@ true : bin_annot, safe_string
 <src> : include
 <test> : include
 
-<test/uuidtrip.*> : package(cmdliner)
+<test/uuidtrip.*> : package(cmdliner unix)

test/uuidtrip.ml

@@ -5,11 +5,14 @@
 
 let strf = Printf.sprintf
 
-let gen version ns name upper binary =
+let gen ~version ~ns ~name ~upper ~binary =
   let u = match version with
   | `V3 -> Uuidm.v3 ns name
   | `V4 -> Uuidm.v4_gen (Random.State.make_self_init ()) ()
   | `V5 -> Uuidm.v5 ns name
+  | `V7 ->
+      let now_ms () = Int64.of_float (Unix.gettimeofday () *. 1000.) in
+      Uuidm.v7_non_monotonic_gen ~now_ms (Random.State.make_self_init ()) ()
   in
   let s = match binary with
   | true -> Uuidm.to_binary_string u
@@ -21,23 +24,29 @@ let gen version ns name upper binary =
 (* Command line interface *)
 
 open Cmdliner
+open Cmdliner.Term.Syntax
 
 let version =
   let v3 =
     let doc =
       "Generate a MD5 name based UUID version 3, see option $(b,--name)." in
-    `V3, Arg.info ["md5"] ~doc
+    `V3, Arg.info ["v3"; "md5"] ~doc
   in
   let v4 =
     let doc = "Generate a random based UUID version 4 (default)." in
-    `V4, Arg.info ["r"; "random"] ~doc
+    `V4, Arg.info ["v4"; "r"; "random"] ~doc
   in
   let v5 =
     let doc =
-      "Generate a SHA-1 name based UUID version 5, see option $(b,--name)." in
-    `V5, Arg.info ["sha1"] ~doc
+      "Generate a SHA-1 name based UUID version 5, see option $(b,--name)."
+    in
+    `V5, Arg.info ["v5"; "sha1"] ~doc
+  in
+  let v7 =
+    let doc = "Generate a time and random based UUID version 7." in
+    `V7, Arg.info ["v7"] ~doc
   in
-  Arg.(value & vflag `V4 [v3; v4; v5])
+  Arg.(value & vflag `V4 [v3; v4; v5; v7])
 
 let ns =
   let ns_arg =
@@ -52,7 +61,7 @@ let ns =
   in
   Arg.(value & opt ns_arg Uuidm.ns_dns & info ["ns"; "namespace"] ~doc)
 
-let name_ =
+let name =
   let doc = "Name for name based UUIDs (version 4 or 5)." in
   Arg.(value & opt string "www.example.org" & info ["name"] ~doc)
 
@@ -61,28 +70,28 @@ let upper =
   Arg.(value & flag & info ["u"; "uppercase"] ~doc)
 
 let binary =
-  let doc = "Output the UUID as its 16 bytes binary representation."
-  in
+  let doc = "Output the UUID as its 16 bytes binary representation." in
   Arg.(value & flag & info ["b"; "binary"] ~doc)
 
 let cmd =
   let doc = "Generates universally unique identifiers (UUIDs)" in
   let man = [
     `S "DESCRIPTION";
     `P "$(tname) generates 128 bits universally unique identifiers version
-        3, 5 (name based with MD5, SHA-1 hashing) and 4 (random based)
-        according to RFC 4122.";
-    `P "Invoked without any option, a random based version 4 UUID is
+        3, 5 (name based with MD5, SHA-1 hashing), 4 (random based) and
+        7 (time and random based) according to RFC 4122.";
+    `P "Invoked without any option, a random based version 4 UUID is \
         generated and written on stdout.";
     `S "SEE ALSO";
     `P "P. Leach et al. A universally unique identifier (UUID) URN Namespace,
         2005. $(i, http://tools.ietf.org/html/rfc4122)";
     `S "BUGS";
     `P "This program is distributed with the Uuidm OCaml library.
-        See %%PKG_HOMEPAGE%% for contact information."; ]
+        See https://erratique.ch/software/uuidm for contact information."; ]
   in
   Cmd.v (Cmd.info "uuidtrip" ~version:"%%VERSION%%" ~doc ~man) @@
-  Term.(const gen $ version $ ns $ name_ $ upper $ binary)
+  let+ version and+ ns and+ name and+ upper and+ binary in
+  gen ~version ~ns ~name ~upper ~binary
 
 let main () = Cmd.eval cmd