Dune_project refactor

src/dune_lang/dune_project.ml

@@ -1,5 +1,4 @@
 open Import
-open Decoder
 module Versioned_file = Dune_sexp.Versioned_file
 module Execution_parameters = Dune_engine.Execution_parameters
 module Compound_user_error = Dune_rpc_private.Compound_user_error
@@ -42,6 +41,7 @@ module Implicit_transitive_deps = struct
     ;;
 
     let decode =
+      let open Decoder in
       let check ver = Syntax.since Stanza.syntax ver in
       enum'
         [ "true", check (1, 7) >>> return Enabled
@@ -103,9 +103,9 @@ let get () = Decoder.get key
 
 let get_exn () =
   get ()
-  >>| function
-  | Some t -> t
-  | None -> Code_error.raise "Current project is unset" []
+  |> Decoder.map ~f:(function
+    | Some t -> t
+    | None -> Code_error.raise "Current project is unset" [])
 ;;
 
 let equal : t -> t -> bool = ( == )
@@ -268,6 +268,7 @@ module Extension = struct
 
   let register_unit syntax stanzas =
     let unit_stanzas =
+      let open Decoder in
       let+ r = stanzas in
       (), r
     in
@@ -335,44 +336,46 @@ let explicit_extensions_map explicit_extensions =
   | Ok map -> map
 ;;
 
-let interpret_lang_and_extensions ~(lang : Lang.Instance.t) ~explicit_extensions =
-  let extensions = Extension.automatic ~explicitly_selected:explicit_extensions in
-  let parsing_context =
-    let init =
-      let init = Univ_map.singleton (Syntax.key lang.syntax) (Active lang.version) in
-      let extensions =
-        List.fold_left extensions ~init:[] ~f:(fun acc (ext : Extension.automatic) ->
-          match ext with
-          | Not_selected _ -> acc
-          | Selected ext ->
-            let syntax =
-              let (Extension.Packed ext) = ext.extension in
-              ext.syntax
-            in
-            (syntax, ext.version) :: acc)
-      in
-      Univ_map.set
-        init
-        String_with_vars.decoding_env_key
-        (Pform.Env.initial ~stanza:lang.version ~extensions)
+let make_parsing_context ~(lang : Lang.Instance.t) extensions =
+  let init =
+    let init = Univ_map.singleton (Syntax.key lang.syntax) (Active lang.version) in
+    let extensions =
+      List.fold_left extensions ~init:[] ~f:(fun acc (ext : Extension.automatic) ->
+        match ext with
+        | Not_selected _ -> acc
+        | Selected ext ->
+          let syntax =
+            let (Extension.Packed ext) = ext.extension in
+            ext.syntax
+          in
+          (syntax, ext.version) :: acc)
     in
-    List.fold_left extensions ~init ~f:(fun acc (ext : Extension.automatic) ->
-      let syntax =
-        let (Extension.Packed ext) =
-          match ext with
-          | Selected e -> e.extension
-          | Not_selected e -> e
-        in
-        ext.syntax
-      in
-      let status : Syntax.Key.t =
+    Univ_map.set
+      init
+      String_with_vars.decoding_env_key
+      (Pform.Env.initial ~stanza:lang.version ~extensions)
+  in
+  List.fold_left extensions ~init ~f:(fun acc (ext : Extension.automatic) ->
+    let syntax =
+      let (Extension.Packed ext) =
         match ext with
-        | Selected ext -> Active ext.version
-        | Not_selected (Packed e) ->
-          Inactive { lang = e.syntax; dune_lang_ver = lang.version }
+        | Selected e -> e.extension
+        | Not_selected e -> e
       in
-      Univ_map.set acc (Syntax.key syntax) status)
-  in
+      ext.syntax
+    in
+    let status : Syntax.Key.t =
+      match ext with
+      | Selected ext -> Active ext.version
+      | Not_selected (Packed e) ->
+        Inactive { lang = e.syntax; dune_lang_ver = lang.version }
+    in
+    Univ_map.set acc (Syntax.key syntax) status)
+;;
+
+let interpret_lang_and_extensions ~(lang : Lang.Instance.t) ~explicit_extensions =
+  let extensions = Extension.automatic ~explicitly_selected:explicit_extensions in
+  let parsing_context = make_parsing_context ~lang extensions in
   let extension_args, extension_stanzas =
     List.fold_left
       extensions
@@ -381,7 +384,6 @@ let interpret_lang_and_extensions ~(lang : Lang.Instance.t) ~explicit_extensions
         match ext with
         | Not_selected (Packed e) ->
           let stanzas =
-            let open Decoder in
             let stanzas =
               match Syntax.greatest_supported_version e.syntax with
               | None -> []
@@ -395,30 +397,37 @@ let interpret_lang_and_extensions ~(lang : Lang.Instance.t) ~explicit_extensions
                     (Syntax.key e.syntax)
                     (Active greatest_supported_version)
                 in
-                parse (enter e.stanzas) parsing_context (List (Loc.of_pos __POS__, []))
+                Decoder.parse
+                  (Decoder.enter e.stanzas)
+                  parsing_context
+                  (List (Loc.of_pos __POS__, []))
                 |> snd
             in
             List.map stanzas ~f:(fun (name, _) ->
               ( name
-              , let+ _ = Syntax.get_exn e.syntax in
-                (* The above [get_exn] will raise because the extension is
+              , Syntax.get_exn e.syntax
+                |> Decoder.map ~f:(fun _ ->
+                  (* The above [get_exn] will raise because the extension is
                    inactive *)
-                assert false ))
+                  assert false) ))
           in
           args_acc, stanzas :: stanzas_acc
         | Selected instance ->
           let (Packed e) = instance.extension in
           let args_acc, stanzas =
             let args =
+              let open Decoder in
               let+ arg, stanzas = Decoder.set_many parsing_context e.stanzas in
               Univ_map.set args_acc e.key arg, stanzas
             in
             instance.parse_args args
           in
           args_acc, stanzas :: stanzas_acc)
   in
-  let stanzas = List.concat (lang.data :: extension_stanzas) in
-  let stanza_parser = Decoder.(set_many parsing_context (sum stanzas)) in
+  let stanza_parser =
+    let stanzas = List.concat (lang.data :: extension_stanzas) in
+    Decoder.(set_many parsing_context (sum stanzas))
+  in
   parsing_context, stanza_parser, extension_args
 ;;
 
@@ -688,8 +697,12 @@ let wrapped_executables t = t.wrapped_executables
 let map_workspace_root t = t.map_workspace_root
 let executables_implicit_empty_intf t = t.executables_implicit_empty_intf
 let accept_alternative_dune_file_name t = t.accept_alternative_dune_file_name
-let () = Extension.register_simple Action.Action_plugin.syntax (return [])
-let dune_site_extension = Extension.register_unit Site.dune_site_syntax (return [])
+let () = Extension.register_simple Action.Action_plugin.syntax (Decoder.return [])
+
+let dune_site_extension =
+  Extension.register_unit Site.dune_site_syntax (Decoder.return [])
+;;
+
 let strict_package_deps t = t.strict_package_deps
 let allow_approximate_merlin t = t.allow_approximate_merlin
 let cram t = t.cram
@@ -841,6 +854,7 @@ let parse_packages
 ;;
 
 let parse ~dir ~(lang : Lang.Instance.t) ~file =
+  let open Decoder in
   String_with_vars.set_decoding_env
     (Pform.Env.initial ~stanza:lang.version ~extensions:[])
   @@ fields
@@ -1068,6 +1082,7 @@ let load =
 ;;
 
 let _oxcaml_extension =
-  (* This is required to register the extension because OxCaml doesn't have a specific decoder. *)
+  (* This is required to register the extension because OxCaml doesn't have a
+     specific decoder. *)
   Extension.register Oxcaml.syntax (Decoder.return ((), [])) Dyn.unit
 ;;