Reduce stanza definition boilerplate

boot/libs.ml

@@ -615,6 +615,7 @@ let main =
             ; "OpamVariable"
             ; "Source"
             ; "Xdg"
+            ; "Re"
             ]
         }
   }

src/dune_lang/stanza.ml

@@ -29,6 +29,8 @@ module type S = sig
   type repr += T of t
 
   val make_stanza : t -> stanza
+  val decode_stanza : t Decoder.t -> stanza list Decoder.t
+  val decode_stanzas : t list Decoder.t -> stanza list Decoder.t
   val key : t Key.t
 end
 
@@ -53,6 +55,8 @@ struct
   end
 
   let make_stanza (a : S.t) = E (a, (module T))
+  let decode_stanza d = Decoder.map d ~f:(fun x -> [ make_stanza x ])
+  let decode_stanzas d = Decoder.map d ~f:(List.map ~f:make_stanza)
 
   let key : S.t Key.t =
     fun t ->

src/dune_lang/stanza.mli

@@ -20,6 +20,8 @@ module type S = sig
   type repr += T of t
 
   val make_stanza : t -> stanza
+  val decode_stanza : t Decoder.t -> stanza list Decoder.t
+  val decode_stanzas : t list Decoder.t -> stanza list Decoder.t
   val key : t Key.t
 end
 

src/dune_rules/cinaps.ml

@@ -67,13 +67,7 @@ let decode =
 
 let () =
   let open Dune_lang.Decoder in
-  Dune_project.Extension.register_simple
-    syntax
-    (return
-       [ ( name
-         , let+ stanza = decode in
-           [ make_stanza stanza ] )
-       ])
+  Dune_project.Extension.register_simple syntax (return [ name, decode_stanza decode ])
 ;;
 
 let gen_rules sctx t ~dir ~scope =

src/dune_rules/coq/coq_stanza.ml

@@ -67,7 +67,7 @@ module Coqpp = struct
       include Poly
     end)
 
-  let p = "coq.pp", decode >>| fun x -> [ make_stanza x ]
+  let p = "coq.pp", decode_stanza decode
 end
 
 module Buildable = struct
@@ -156,7 +156,7 @@ module Extraction = struct
       include Poly
     end)
 
-  let p = "coq.extraction", decode >>| fun x -> [ make_stanza x ]
+  let p = "coq.extraction", decode_stanza decode
 end
 
 module Theory = struct
@@ -292,8 +292,8 @@ module Theory = struct
     x
   ;;
 
-  let coqlib_p = "coqlib", decode >>| fun x -> [ make_stanza (coqlib_warn x) ]
-  let p = "coq.theory", decode >>| fun x -> [ make_stanza x ]
+  let coqlib_p = "coqlib", decode_stanza (decode >>| coqlib_warn)
+  let p = "coq.theory", decode_stanza decode
 end
 
 let unit_stanzas =

src/dune_rules/cram/cram_stanza.ml

@@ -113,9 +113,4 @@ let decode =
      })
 ;;
 
-let stanza =
-  [ ( "cram"
-    , let+ t = decode in
-      List.singleton (make_stanza t) )
-  ]
-;;
+let stanza = [ "cram", decode_stanza decode ]

src/dune_rules/ctypes/ctypes_field.ml

@@ -203,13 +203,7 @@ let decode =
 
 let () =
   let open Dune_lang.Decoder in
-  Dune_project.Extension.register_simple
-    syntax
-    (return
-       [ ( name
-         , let+ stanza = decode in
-           [ make_stanza stanza ] )
-       ])
+  Dune_project.Extension.register_simple syntax (return [ name, decode_stanza decode ])
 ;;
 
 let type_gen_script ctypes =

src/dune_rules/mdx.ml

@@ -271,13 +271,7 @@ let decode =
 let () =
   let open Dune_lang.Decoder in
   let decode = Dune_lang.Syntax.since Stanza.syntax (2, 4) >>> decode in
-  Dune_project.Extension.register_simple
-    syntax
-    (return
-       [ ( "mdx"
-         , let+ stanza = decode in
-           [ make_stanza stanza ] )
-       ])
+  Dune_project.Extension.register_simple syntax (return [ "mdx", decode_stanza decode ])
 ;;
 
 (** Returns the list of files (in _build) to be passed to mdx for the given

src/dune_rules/melange/melange_stanzas.ml

@@ -163,9 +163,5 @@ end
 let () =
   Dune_project.Extension.register_simple
     Dune_lang.Melange.syntax
-    (return
-       [ ( "melange.emit"
-         , let+ stanza = Emit.decode in
-           [ Emit.make_stanza stanza ] )
-       ])
+    (return [ ("melange.emit", Emit.(decode_stanza decode)) ])
 ;;

src/dune_rules/menhir/menhir_stanza.ml

@@ -48,11 +48,7 @@ include Stanza.Make (struct
 let () =
   Dune_project.Extension.register_simple
     syntax
-    (return
-       [ ( "menhir"
-         , let+ stanza = decode in
-           [ make_stanza stanza ] )
-       ])
+    (return [ "menhir", decode_stanza decode ])
 ;;
 
 let modules (stanza : t) : string list =

src/dune_rules/sites/site_stanzas.ml

@@ -1,12 +1,7 @@
 open! Import
 
 let all =
-  let open Dune_lang.Decoder in
-  [ ( "generate_sites_module"
-    , let+ t = Generate_sites_module_stanza.decode in
-      [ Generate_sites_module_stanza.make_stanza t ] )
-  ; ( "plugin"
-    , let+ t = Plugin.decode in
-      [ Plugin.make_stanza t ] )
+  [ ("generate_sites_module", Generate_sites_module_stanza.(decode_stanza decode))
+  ; ("plugin", Plugin.(decode_stanza Plugin.decode))
   ]
 ;;

src/dune_rules/stanzas/stanzas.ml

@@ -38,11 +38,6 @@ module Dynamic_include = struct
     end)
 end
 
-let rules l = List.map l ~f:(fun x -> Rule_conf.make_stanza x)
-let execs exe = [ Executables.make_stanza exe ]
-
-type constructors = Stanza.Parser.t list
-
 let with_redirect decode =
   let+ x = decode in
   let base = [ Library.make_stanza x ] in
@@ -51,7 +46,7 @@ let with_redirect decode =
   | Some r -> Library_redirect.Local.make_stanza r :: base
 ;;
 
-let stanzas : constructors =
+let stanzas : Stanza.Parser.t list =
   [ Site_stanzas.all
   ; Cram_stanza.stanza
   ; List.map Source.Dune_file.statically_evaluated_stanzas ~f:(fun stanza ->
@@ -69,74 +64,60 @@ let stanzas : constructors =
       , with_redirect
           (Dune_lang.Syntax.since Dune_lang.Oxcaml.syntax (0, 1) >>> Parameter.decode) )
     ; ( "foreign_library"
-      , let+ () = Dune_lang.Syntax.since Stanza.syntax (2, 0)
-        and+ x = Foreign_library.decode in
-        [ Foreign_library.make_stanza x ] )
-    ; "executable", Executables.single >>| execs
-    ; "executables", Executables.multi >>| execs
-    ; ( "rule"
-      , 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 ] )
-    ; ( "alias"
-      , let+ x = Alias_conf.decode in
-        [ Alias_conf.make_stanza x ] )
-    ; ( "copy_files"
-      , let+ x = Copy_files.decode in
-        [ Copy_files.make_stanza x ] )
+      , Foreign_library.decode_stanza
+          (let* () = Dune_lang.Syntax.since Stanza.syntax (2, 0) in
+           Foreign_library.decode) )
+    ; ("executable", Executables.(decode_stanza single))
+    ; ("executables", Executables.(decode_stanza multi))
+    ; ("rule", Rule_conf.(decode_stanza Rule_conf.decode))
+    ; ("ocamllex", Rule_conf.(decode_stanzas ocamllex))
+    ; ("ocamlyacc", Rule_conf.(decode_stanzas ocamlyacc))
+    ; ("install", Install_conf.(decode_stanza decode))
+    ; ("alias", Alias_conf.(decode_stanza decode))
+    ; ("copy_files", Copy_files.(decode_stanza decode))
     ; ( "copy_files#"
-      , let+ x = Copy_files.decode in
-        [ Copy_files.make_stanza { x with add_line_directive = true } ] )
-    ; ( "include"
-      , let+ x = Include.decode in
-        [ Include.make_stanza x ] )
-    ; ( "documentation"
-      , let+ d = Documentation.decode in
-        [ Documentation.make_stanza d ] )
+      , Copy_files.decode_stanza
+          (let+ x = Copy_files.decode in
+           { x with add_line_directive = true }) )
+    ; ("include", Include.(decode_stanza decode))
+    ; ("documentation", Documentation.(decode_stanza Documentation.decode))
     ; ( "jbuild_version"
       , let+ () = Dune_lang.Syntax.deleted_in Stanza.syntax (1, 0)
         and+ _ = Jbuild_version.decode in
         [] )
     ; ( "tests"
-      , let+ () = Dune_lang.Syntax.since Stanza.syntax (1, 0)
-        and+ t = Tests.multi in
-        [ Tests.make_stanza t ] )
+      , Tests.decode_stanza
+          (let* () = Dune_lang.Syntax.since Stanza.syntax (1, 0) in
+           Tests.multi) )
     ; ( "test"
-      , let+ () = Dune_lang.Syntax.since Stanza.syntax (1, 0)
-        and+ t = Tests.single in
-        [ Tests.make_stanza t ] )
+      , Tests.decode_stanza
+          (let* () = Dune_lang.Syntax.since Stanza.syntax (1, 0) in
+           Tests.single) )
     ; ( "external_variant"
       , let+ () = Dune_lang.Syntax.deleted_in Stanza.syntax (2, 6) in
         [] )
-    ; ( "env"
-      , let+ x = Dune_env.decode in
-        [ Dune_env.make_stanza x ] )
+    ; ("env", Dune_env.(decode_stanza decode))
     ; ( "include_subdirs"
-      , let+ t =
-          Include_subdirs.decode
-            ~qualified:
-              (let* project = Dune_project.get_exn () in
-               if Dune_project.is_extension_set project Coq_stanza.key
-               then return ()
-               else Syntax.since Stanza.syntax (3, 7))
-        in
-        [ Include_subdirs.make_stanza t ] )
+      , Include_subdirs.(
+          decode_stanza
+          @@ decode
+               ~qualified:
+                 (let* project = Dune_project.get_exn () in
+                  if Dune_project.is_extension_set project Coq_stanza.key
+                  then return ()
+                  else Syntax.since Stanza.syntax (3, 7))) )
     ; ( "toplevel"
-      , let+ () = Dune_lang.Syntax.since Stanza.syntax (1, 7)
-        and+ t = Toplevel_stanza.decode in
-        [ Toplevel_stanza.make_stanza t ] )
+      , Toplevel_stanza.decode_stanza
+          (let* () = Dune_lang.Syntax.since Stanza.syntax (1, 7) in
+           Toplevel_stanza.decode) )
     ; ( "deprecated_library_name"
-      , let+ () = Dune_lang.Syntax.since Stanza.syntax (2, 0)
-        and+ t = Deprecated_library_name.decode in
-        [ Deprecated_library_name.make_stanza t ] )
+      , Deprecated_library_name.decode_stanza
+          (let* () = Dune_lang.Syntax.since Stanza.syntax (2, 0) in
+           Deprecated_library_name.decode) )
     ; ( "dynamic_include"
-      , let+ () = Dune_lang.Syntax.since Stanza.syntax (3, 14)
-        and+ include_ = Include.decode in
-        [ Dynamic_include.make_stanza include_ ] )
+      , Dynamic_include.decode_stanza
+          (let* () = Dune_lang.Syntax.since Stanza.syntax (3, 14) in
+           Include.decode) )
     ]
   ]
   |> List.concat