From 6298d283ba7ef39a9601b5273677b6618ae933c5 Mon Sep 17 00:00:00 2001
From: Etienne Millon <me@emillon.org>
Date: Tue, 31 Jul 2018 12:28:19 +0200
Subject: [PATCH] Add switch_file_kind

This expresses all the cases where we dispatch based on the syntax
version.

Signed-off-by: Etienne Millon <me@emillon.org>
---
 src/jbuild.ml           | 38 +++++++++++++++++++-------------------
 src/stanza.ml           | 16 ++++++++++------
 src/stanza.mli          |  8 ++++++++
 src/string_with_vars.ml |  9 +++------
 src/workspace.ml        | 16 ++++++++--------
 5 files changed, 48 insertions(+), 39 deletions(-)

diff --git a/src/jbuild.ml b/src/jbuild.ml
index 0ed0d827..97b2466a 100644
--- a/src/jbuild.ml
+++ b/src/jbuild.ml
@@ -225,11 +225,9 @@ module Pps_and_flags = struct
   end
 
   let t =
-    Syntax.get_exn Stanza.syntax >>= fun ver ->
-    if ver < (1, 0) then
-      Jbuild_syntax.t
-    else
-      Dune_syntax.t
+    switch_file_kind
+      ~jbuild:Jbuild_syntax.t
+      ~dune:Dune_syntax.t
 end
 
 module Bindings = struct
@@ -255,10 +253,11 @@ module Bindings = struct
 
   let singleton x = [Unnamed x]
 
-  let t elem =
-    Stanza.file_kind () >>= function
-    | Jbuild -> list (elem >>| fun x -> Unnamed x)
-    | Dune -> parens_removed_in_dune (
+  let jbuild elem =
+    list (elem >>| fun x -> Unnamed x)
+
+  let dune elem =
+    parens_removed_in_dune (
       let%map l =
         repeat
           (if_paren_colon_form
@@ -283,6 +282,11 @@ module Bindings = struct
       in
       loop String.Set.empty [] l)
 
+  let t elem =
+    switch_file_kind
+      ~jbuild:(jbuild elem)
+      ~dune:(dune elem)
+
   let sexp_of_t sexp_of_a bindings =
     Sexp.List (
       List.map bindings ~f:(function
@@ -1397,11 +1401,9 @@ module Rule = struct
         "S-expression of the form (<atom> ...) expected"
 
   let t =
-    Syntax.get_exn Stanza.syntax >>= fun ver ->
-    if ver < (1, 0) then
-      jbuild_syntax
-    else
-      dune_syntax
+    switch_file_kind
+      ~jbuild:jbuild_syntax
+      ~dune:dune_syntax
 
   type lex_or_yacc =
     { modules : string list
@@ -1443,11 +1445,9 @@ module Rule = struct
             }))
 
   let ocamllex =
-    Syntax.get_exn Stanza.syntax >>= fun ver ->
-    if ver < (1, 0) then
-      ocamllex_jbuild
-    else
-      ocamllex_dune
+    switch_file_kind
+      ~jbuild:ocamllex_jbuild
+      ~dune:ocamllex_dune
 
   let ocamlyacc = ocamllex
 
diff --git a/src/stanza.ml b/src/stanza.ml
index d2112d51..c59d2d6c 100644
--- a/src/stanza.ml
+++ b/src/stanza.ml
@@ -22,8 +22,7 @@ end
 
 let file_kind () =
   let open Sexp.Of_sexp in
-  Syntax.get_exn syntax >>| fun ver ->
-  if ver < (1, 0) then File_kind.Jbuild else Dune
+  Syntax.get_exn syntax >>| File_kind.of_syntax
 
 module Of_sexp = struct
   include Sexp.Of_sexp
@@ -45,11 +44,15 @@ module Of_sexp = struct
             }
         | _ -> None)
 
+  let switch_file_kind ~jbuild ~dune =
+    file_kind () >>= function
+    | Jbuild -> jbuild
+    | Dune -> dune
+
   let parens_removed_in_dune_generic ~is_record t =
-    Syntax.get_exn syntax >>= fun ver ->
-    if ver < (1, 0) then
-      enter t
-    else
+    switch_file_kind
+      ~jbuild:(enter t)
+      ~dune:(
       try_
         t
         (function
@@ -70,6 +73,7 @@ module Of_sexp = struct
               (function
                 | Parens_no_longer_necessary _ as exn -> raise exn
                 | _ -> raise exn))
+    )
 
   let record parse =
     parens_removed_in_dune_generic (fields parse) ~is_record:true
diff --git a/src/stanza.mli b/src/stanza.mli
index 4f5958a6..f8b7249c 100644
--- a/src/stanza.mli
+++ b/src/stanza.mli
@@ -56,4 +56,12 @@ module Of_sexp : sig
       displays a nice error messages when parentheses are used in dune
       files. *)
   val parens_removed_in_dune : 'a t -> 'a t
+
+  (** Use a different parser depending on the syntax in the current file.
+      If the syntax version is strictly less than `(1, 0)`, use `jbuild`.
+      Otherwise use `dune`. *)
+  val switch_file_kind :
+   jbuild:('a, 'b) parser ->
+   dune:('a, 'b) parser ->
+   ('a, 'b) parser
 end
diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml
index 6237ac5e..f41d580f 100644
--- a/src/string_with_vars.ml
+++ b/src/string_with_vars.ml
@@ -113,13 +113,10 @@ let t =
     | Quoted_string (loc, s) -> literal ~quoted:true ~loc s
     | List (loc, _) -> Sexp.Of_sexp.of_sexp_error loc "Unexpected list"
   in
-  Syntax.get_exn Stanza.syntax >>= fun syntax_version ->
-  let template =
-    match syntax_version with
-    | (0, _) -> jbuild
-    | (_, _) -> dune
+  let template_parser = Stanza.Of_sexp.switch_file_kind ~jbuild ~dune in
+  let%map syntax_version = Syntax.get_exn Stanza.syntax
+  and template = template_parser
   in
-  template >>| fun template ->
   {template; syntax_version}
 
 let loc t = t.template.loc
diff --git a/src/workspace.ml b/src/workspace.ml
index 3ab86bbd..9a6cccd8 100644
--- a/src/workspace.ml
+++ b/src/workspace.ml
@@ -117,14 +117,14 @@ module Context = struct
       ]
 
   let t ~profile ~x =
-    Syntax.get_exn syntax >>= function
-    | (0, _) ->
-      (* jbuild-workspace files *)
-      (peek_exn >>= function
-       | List (_, List _ :: _) ->
-         Sexp.Of_sexp.record (Opam.t ~profile ~x) >>| fun x -> Opam x
-       | _ -> t ~profile ~x)
-    | _ -> t ~profile ~x
+    switch_file_kind
+      ~jbuild:
+        (* jbuild-workspace files *)
+        (peek_exn >>= function
+         | List (_, List _ :: _) ->
+           Sexp.Of_sexp.record (Opam.t ~profile ~x) >>| fun x -> Opam x
+         | _ -> t ~profile ~x)
+      ~dune:(t ~profile ~x)
 
   let name = function
     | Default _ -> "default"