refactor: simplify loc/ocamllex/ocamlyacc stanza handling

src/dune_rules/stanzas/rule_conf.ml

@@ -67,11 +67,11 @@ let atom_table =
     ]
 ;;
 
-let short_form =
-  let+ loc, action = located Dune_lang.Action.decode_dune_file in
+let short_form ~loc =
+  let+ action = located Dune_lang.Action.decode_dune_file in
   { targets = Infer
   ; deps = Bindings.empty
-  ; action = loc, action
+  ; action
   ; mode = Standard
   ; locks = []
   ; loc
@@ -92,16 +92,17 @@ let directory_targets_extension =
   Dune_project.Extension.register syntax (Dune_lang.Decoder.return ((), [])) Dyn.unit
 ;;
 
-let long_form =
+let long_form ~loc =
+  fields
+  @@
   let* deps = field "deps" (Bindings.decode Dep_conf.decode) ~default:Bindings.empty in
   let* project = Dune_project.get_exn () in
   let allow_directory_targets =
     Dune_project.is_extension_set project directory_targets_extension
   in
   String_with_vars.add_user_vars_to_decoding_env
     (Bindings.var_names deps)
-    (let+ loc = loc
-     and+ action_o = field_o "action" (located Dune_lang.Action.decode_dune_file)
+    (let+ action_o = field_o "action" (located Dune_lang.Action.decode_dune_file)
      and+ targets = Targets_spec.field ~allow_directory_targets
      and+ locks = Locks.field ()
      and+ () =
@@ -151,13 +152,14 @@ let long_form =
 ;;
 
 let decode =
-  let rec interpret atom = function
-    | Field -> fields long_form
-    | Action -> short_form
+  let rec interpret ~loc atom = function
+    | Field -> long_form ~loc
+    | Action -> short_form ~loc
     | Since (version, inner) ->
       let what = Printf.sprintf "'%s' in short-form 'rule'" atom in
-      Dune_lang.Syntax.since ~what Stanza.syntax version >>> interpret atom inner
+      Dune_lang.Syntax.since ~what Stanza.syntax version >>> interpret ~loc atom inner
   in
+  let* stanza_loc = loc in
   peek_exn
   >>= function
   | List (_, Atom (loc, A s) :: _) ->
@@ -167,32 +169,21 @@ let decode =
          ~loc
          [ Pp.text "Unknown action or rule field." ]
          ~hints:(User_message.did_you_mean s ~candidates:(String.Map.keys atom_table))
-     | Some w -> interpret s w)
+     | Some w -> interpret ~loc:stanza_loc s w)
   | sexp ->
     User_error.raise
       ~loc:(Dune_lang.Ast.loc sexp)
       [ Pp.textf "S-expression of the form (<atom> ...) expected" ]
 ;;
 
 type lex_or_yacc =
-  { modules : string list
+  { loc : Loc.t
+  ; modules : string list
   ; mode : Rule.Mode.t
   ; enabled_if : Blang.t
   }
 
-let ocamllex =
-  (let+ modules = repeat string in
-   { modules; mode = Standard; enabled_if = Blang.true_ })
-  <|> fields
-        (let+ modules = field "modules" (repeat string)
-         and+ mode = Mode.field
-         and+ enabled_if = Enabled_if.decode ~allowed_vars:Any ~since:(Some (1, 4)) () in
-         { modules; mode; enabled_if })
-;;
-
-let ocamlyacc = ocamllex
-
-let ocamllex_to_rule loc { modules; mode; enabled_if } =
+let ocamllex_to_rule { loc; modules; mode; enabled_if } =
   let module S = String_with_vars in
   List.map modules ~f:(fun name ->
     let src = name ^ ".mll" in
@@ -223,7 +214,7 @@ let ocamllex_to_rule loc { modules; mode; enabled_if } =
     })
 ;;
 
-let ocamlyacc_to_rule loc { modules; mode; enabled_if } =
+let ocamlyacc_to_rule { loc; modules; mode; enabled_if } =
   let module S = String_with_vars in
   List.map modules ~f:(fun name ->
     let src = name ^ ".mly" in
@@ -251,3 +242,18 @@ let ocamlyacc_to_rule loc { modules; mode; enabled_if } =
     ; package = None
     })
 ;;
+
+let lex_or_yacc =
+  (let+ loc = loc
+   and+ modules = repeat string in
+   { loc; modules; mode = Standard; enabled_if = Blang.true_ })
+  <|> fields
+        (let+ loc = loc
+         and+ modules = field "modules" (repeat string)
+         and+ mode = Mode.field
+         and+ enabled_if = Enabled_if.decode ~allowed_vars:Any ~since:(Some (1, 4)) () in
+         { loc; modules; mode; enabled_if })
+;;
+
+let ocamllex = lex_or_yacc >>| ocamllex_to_rule
+let ocamlyacc = lex_or_yacc >>| ocamlyacc_to_rule

src/dune_rules/stanzas/rule_conf.mli

@@ -16,13 +16,7 @@ include Stanza.S with type t := t
 
 val decode : t Dune_sexp.Decoder.t
 
-type lex_or_yacc =
-  { modules : string list
-  ; mode : Rule.Mode.t
-  ; enabled_if : Blang.t
-  }
+type lex_or_yacc
 
-val ocamlyacc : lex_or_yacc Dune_lang.Decoder.t
-val ocamllex : lex_or_yacc Dune_lang.Decoder.t
-val ocamllex_to_rule : Loc.t -> lex_or_yacc -> t list
-val ocamlyacc_to_rule : Loc.t -> lex_or_yacc -> t list
+val ocamlyacc : t list Dune_lang.Decoder.t
+val ocamllex : t list Dune_lang.Decoder.t

src/dune_rules/stanzas/stanzas.ml

@@ -76,17 +76,10 @@ let stanzas : constructors =
     ; "executable", Executables.single >>| execs
     ; "executables", Executables.multi >>| execs
     ; ( "rule"
-      , let+ loc = loc
-        and+ x = Rule_conf.decode in
-        [ Rule_conf.make_stanza { x with loc } ] )
-    ; ( "ocamllex"
-      , let+ loc = loc
-        and+ x = Rule_conf.ocamllex in
-        rules (Rule_conf.ocamllex_to_rule loc x) )
-    ; ( "ocamlyacc"
-      , let+ loc = loc
-        and+ x = Rule_conf.ocamlyacc in
-        rules (Rule_conf.ocamlyacc_to_rule loc x) )
+      , let+ x = Rule_conf.decode in
+        [ Rule_conf.make_stanza x ] )
+    ; "ocamllex", Rule_conf.ocamllex >>| rules
+    ; "ocamlyacc", Rule_conf.ocamlyacc >>| rules
     ; ( "install"
       , let+ x = Install_conf.decode in
         [ Install_conf.make_stanza x ] )
@@ -100,9 +93,8 @@ let stanzas : constructors =
       , let+ x = Copy_files.decode in
         [ Copy_files.make_stanza { x with add_line_directive = true } ] )
     ; ( "include"
-      , let+ loc = loc
-        and+ fn = relative_file in
-        [ Include.make_stanza (loc, fn) ] )
+      , let+ x = Include.decode in
+        [ Include.make_stanza x ] )
     ; ( "documentation"
       , let+ d = Documentation.decode in
         [ Documentation.make_stanza d ] )