Feature: Add case match annotation

config/cfg_ppx.ml

@@ -107,6 +107,45 @@ let apply_config_on_types (tds : type_declaration list) =
       | _ -> Some td)
     tds
 
+let apply_config_on_cases (cases : cases) =
+  List.filter
+    (fun case ->
+      if should_keep case.pc_rhs.pexp_attributes = `keep then true else false)
+    cases
+
+let rec apply_config_on_expression (exp : expression) =
+  let pexp_desc =
+    match exp.pexp_desc with
+    | Pexp_try (exp, cases) ->
+        let exp = apply_config_on_expression exp in
+        let cases = apply_config_on_cases cases in
+        Pexp_try (exp, cases)
+    | Pexp_match (exp, cases) ->
+        let exp = apply_config_on_expression exp in
+        let cases = apply_config_on_cases cases in
+        Pexp_match (exp, cases)
+    | Pexp_fun (arg_label, exp_opt, pat, exp) ->
+        let exp = apply_config_on_expression exp in
+        Pexp_fun (arg_label, exp_opt, pat, exp)
+    | Pexp_function cases ->
+        let cases = apply_config_on_cases cases in
+        Pexp_function cases
+    | Pexp_let (rec_flag, vbs, exp) ->
+      let exp = apply_config_on_expression exp in
+      Pexp_let (rec_flag, vbs, exp)
+    | _ -> exp.pexp_desc
+  in
+  let { pexp_loc; pexp_loc_stack; pexp_attributes; _ } = exp in
+  { pexp_loc; pexp_loc_stack; pexp_attributes; pexp_desc }
+
+let apply_config_on_value_bindings (vbs : value_binding list) =
+  List.map
+    (fun vb ->
+      let { pvb_loc; pvb_attributes; pvb_pat; pvb_expr } = vb in
+      let _pvb_expr = apply_config_on_expression pvb_expr in
+      { pvb_loc; pvb_attributes; pvb_pat; pvb_expr = _pvb_expr })
+    vbs
+
 let apply_config_on_structure_item stri =
   try
     match stri.pstr_desc with
@@ -119,9 +158,10 @@ let apply_config_on_structure_item stri =
     | Pstr_eval (_, attrs)
     | Pstr_module { pmb_attributes = attrs; _ } ->
         if should_keep attrs = `keep then Some stri else None
-    | Pstr_value (_, vbs) ->
+    | Pstr_value (recflag, vbs) ->
         if should_keep_many vbs (fun vb -> vb.pvb_attributes) = `keep then
-          Some stri
+          let vbs = apply_config_on_value_bindings vbs in
+          Some { stri with pstr_desc = Pstr_value (recflag, vbs) }
         else None
     | Pstr_type (recflag, tds) ->
         if should_keep_many tds (fun td -> td.ptype_attributes) = `keep then

config/ppx.t/cond_type_var_constructor.ml

@@ -1,22 +1,27 @@
 type band = 
   | Rush
   | Yes
-  | KingCrimson [@config (made_up = true)]
+  | KingCrimson [@config (made_up = "false")]
 
-(* this pattern matching is exhaustive because the config removes the
-   KingCrimson constructor *)
 let best_band_in_the_world x =
   match x with
   | Rush -> true
   | Yes -> false
+  | KingCrimson -> false [@config (made_up = "false")]
+
+and worst_band_in_the_world = function 
+| Rush -> false
+| Yes -> false
+| KingCrimson -> true [@config (made_up = "false")]
 
 type band_polyvar = [
   | `Rush
   | `Yes
-  | `KingCrimson [@config (made_up=true)]
+  | `KingCrimson [@config (made_up = true)]
 ]
 
 let the_best_band_in_the_world (x: band_polyvar) =
   match x with
   | `Rush -> true
   | `Yes -> false
+  | `KingCrimson -> false [@config (made_up = true)]

config/ppx.t/cond_value.ml

@@ -4,5 +4,11 @@ let best_band_in_the_world () = "rush"
 let print_band () = print_endline (best_band_in_the_world ())
 [@@config (made_up = true)]
 
+(* Applying config on a single value binding 
+   should remove all value bindings. *)
+let () = print_band () and 
+print_name1 name = print_endline name 
+[@@config (made_up = true)]
+
 (** ignored comments *)
 let hello = "world"

config/ppx.t/run.t

@@ -120,6 +120,10 @@
                           all ((target_os = "windows"), (target_arch = "arm"))]
   let () = Printf.printf "sys=%s env=%s" Sys.name Env.name
 
+  $ dune clean
+  $ made_up=false dune exec ./main.exe
+  sys=unix env=unknown
+
   $ dune clean
   $ dune exec ./main.exe
   sys=unix env=unknown