From 5a3718a098450b4efe91836034df085c78ed5970 Mon Sep 17 00:00:00 2001
From: Josh Berdine <jjb@fb.com>
Date: Mon, 25 Feb 2019 07:07:00 -0800
Subject: [PATCH] [sledge] Move parsing of trace specs from Config to Trace

Summary:
This allows exposing `Trace.parse`, which can be used to call
`Trace.init` in test code.

Reviewed By: mbouaziz

Differential Revision: D14075522

fbshipit-source-id: 4715c643f
---
 sledge/src/config.ml       | 50 ++------------------------------------
 sledge/src/trace/trace.ml  | 49 +++++++++++++++++++++++++++++++++++++
 sledge/src/trace/trace.mli |  1 +
 3 files changed, 52 insertions(+), 48 deletions(-)

diff --git a/sledge/src/config.ml b/sledge/src/config.ml
index 38965931b..60e225350 100644
--- a/sledge/src/config.ml
+++ b/sledge/src/config.ml
@@ -8,55 +8,9 @@
 (** Configuration options *)
 
 let trace_conv =
-  let default = Map.empty (module String) in
   let parse s =
-    try
-      let index_from s i =
-        Option.merge ~f:min
-          (String.index_from s i '+')
-          (String.index_from s i '-')
-      in
-      let rec split s rev_parts i =
-        match index_from s (i + 1) with
-        | Some j when j = i -> split s rev_parts j
-        | Some j ->
-            split s (String.sub s ~pos:i ~len:(j - i) :: rev_parts) j
-        | _ -> List.rev (String.subo s ~pos:i :: rev_parts)
-      in
-      let parts = split s [] 0 in
-      List.fold parts ~init:default ~f:(fun m part ->
-          let parse_part part =
-            let sign, rest =
-              match part.[0] with
-              | '-' -> (false, String.subo part ~pos:1)
-              | '+' -> (true, String.subo part ~pos:1)
-              | _ -> (true, part)
-            in
-            assert (not (String.is_empty rest)) ;
-            assert (Char.is_uppercase rest.[0]) ;
-            match String.lsplit2 rest ~on:'.' with
-            | Some (mod_name, fun_name) ->
-                assert (Char.is_lowercase fun_name.[0]) ;
-                (mod_name, Some fun_name, sign)
-            | None -> (rest, None, sign)
-          in
-          match parse_part part with
-          | mod_name, Some fun_name, enabled ->
-              let {trace_mod; trace_funs} =
-                match Map.find m mod_name with
-                | Some c -> c
-                | None -> {trace_mod= None; trace_funs= default}
-              in
-              Map.set m ~key:mod_name
-                ~data:
-                  { trace_mod
-                  ; trace_funs=
-                      Map.set trace_funs ~key:fun_name ~data:enabled }
-          | mod_name, None, enabled ->
-              Map.set m ~key:mod_name
-                ~data:{trace_mod= Some enabled; trace_funs= default} )
-      |> fun x -> Ok x
-    with _ -> Error (`Msg ("Invalid trace spec: " ^ s))
+    try Ok (Trace.parse s).trace_mods_funs with _ ->
+      Error (`Msg ("Invalid trace spec: " ^ s))
   in
   let print fs c =
     let pf fmt = Format.fprintf fs fmt in
diff --git a/sledge/src/trace/trace.ml b/sledge/src/trace/trace.ml
index c469d47a0..ee966bcca 100644
--- a/sledge/src/trace/trace.ml
+++ b/sledge/src/trace/trace.ml
@@ -23,6 +23,55 @@ let none = {trace_all= false; trace_mods_funs= Map.empty (module String)}
 let all = {none with trace_all= true}
 let config : config ref = ref none
 
+let parse s =
+  let default = Map.empty (module String) in
+  let index_from s i =
+    Option.merge ~f:min
+      (String.index_from s i '+')
+      (String.index_from s i '-')
+  in
+  let rec split s rev_parts i =
+    match index_from s (i + 1) with
+    | Some j when j = i -> split s rev_parts j
+    | Some j -> split s (String.sub s ~pos:i ~len:(j - i) :: rev_parts) j
+    | _ -> List.rev (String.subo s ~pos:i :: rev_parts)
+  in
+  let parts = split s [] 0 in
+  let trace_mods_funs =
+    List.fold parts ~init:default ~f:(fun m part ->
+        let parse_part part =
+          let sign, rest =
+            match part.[0] with
+            | '-' -> (false, String.subo part ~pos:1)
+            | '+' -> (true, String.subo part ~pos:1)
+            | _ -> (true, part)
+          in
+          assert (not (String.is_empty rest)) ;
+          assert (Char.is_uppercase rest.[0]) ;
+          match String.lsplit2 rest ~on:'.' with
+          | Some (mod_name, fun_name) ->
+              assert (Char.is_lowercase fun_name.[0]) ;
+              (mod_name, Some fun_name, sign)
+          | None -> (rest, None, sign)
+        in
+        match parse_part part with
+        | mod_name, Some fun_name, enabled ->
+            let {trace_mod; trace_funs} =
+              match Map.find m mod_name with
+              | Some c -> c
+              | None -> {trace_mod= None; trace_funs= default}
+            in
+            Map.set m ~key:mod_name
+              ~data:
+                { trace_mod
+                ; trace_funs= Map.set trace_funs ~key:fun_name ~data:enabled
+                }
+        | mod_name, None, enabled ->
+            Map.set m ~key:mod_name
+              ~data:{trace_mod= Some enabled; trace_funs= default} )
+  in
+  {none with trace_mods_funs}
+
 let init ?(margin = 300) ~config:c () =
   Format.set_margin margin ;
   Format.set_max_indent (margin - 1) ;
diff --git a/sledge/src/trace/trace.mli b/sledge/src/trace/trace.mli
index 026907bdd..f59f879ab 100644
--- a/sledge/src/trace/trace.mli
+++ b/sledge/src/trace/trace.mli
@@ -23,6 +23,7 @@ type config =
 
 val none : config
 val all : config
+val parse : string -> config
 
 val init : ?margin:int -> config:config -> unit -> unit
 (** Initialize the configuration of debug tracing. *)