Remove wrong validation for switch names

Previously, switch names were validated to be valid context names. This
is wrong as it prevent us from using local switches which are in fact
specified by their path. We remove this unnecessary validation and now
we can use local switches to define contexts.

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

CHANGES.md

@@ -1,3 +1,9 @@
+Unreleased
+----------
+
+- Allow contexts to be defined with local switches in workspace files (#3265,
+  fix #3264, @rgrinberg)
+
 2.4.0 (06/03/2020)
 ------------------
 

src/dune/context.ml

@@ -6,7 +6,7 @@ module Kind = struct
   module Opam = struct
     type t =
       { root : string option
-      ; switch : Context_name.t
+      ; switch : string
       }
   end
 
@@ -18,10 +18,7 @@ module Kind = struct
     | Default -> Dyn.Encoder.string "default"
     | Opam o ->
       Dyn.Encoder.(
-        record
-          [ ("root", option string o.root)
-          ; ("switch", Context_name.to_dyn o.switch)
-          ])
+        record [ ("root", option string o.root); ("switch", string o.switch) ])
 end
 
 module Env_nodes = struct
@@ -643,7 +640,7 @@ let create_for_opam ~root ~env ~env_nodes ~targets ~profile ~switch ~name
       ; ( match root with
         | None -> []
         | Some root -> [ "--root"; root ] )
-      ; [ "--switch"; Context_name.to_string switch; "--sexp" ]
+      ; [ "--switch"; switch; "--sexp" ]
       ; ( if version < (2, 0, 0) then
           []
         else

src/dune/context.mli

@@ -26,7 +26,7 @@ module Kind : sig
   module Opam : sig
     type t =
       { root : string option
-      ; switch : Context_name.t
+      ; switch : string
       }
   end
 

src/dune/workspace.ml

@@ -156,7 +156,7 @@ module Context = struct
   module Opam = struct
     type t =
       { base : Common.t
-      ; switch : Context_name.t
+      ; switch : string
       ; root : string option
       ; merlin : bool
       }
@@ -165,29 +165,38 @@ module Context = struct
       let open Dyn.Encoder in
       record
         [ ("base", Common.to_dyn base)
-        ; ("switch", Context_name.to_dyn switch)
+        ; ("switch", string switch)
         ; ("root", option string root)
         ; ("merlin", bool merlin)
         ]
 
     let equal { base; switch; root; merlin } t =
       Common.equal base t.base
-      && Context_name.equal switch t.switch
+      && String.equal switch t.switch
       && Option.equal String.equal root t.root
       && Bool.equal merlin t.merlin
 
     let t ~profile ~x =
-      let+ switch = field "switch" Context_name.decode
+      let+ loc_switch, switch = field "switch" (located string)
       and+ name = field_o "name" Context_name.decode
       and+ root = field_o "root" string
       and+ merlin = field_b "merlin"
       and+ base = Common.t ~profile in
-      let default =
-        (* TODO this needs proper error handling with locations *)
-        let name = Context_name.to_string switch ^ Common.fdo_suffix base in
-        Context_name.parse_string_exn (Loc.none, name)
+      let name =
+        match name with
+        | Some s -> s
+        | None -> (
+          let name = Filename.basename switch ^ Common.fdo_suffix base in
+          match Context_name.of_string_opt name with
+          | Some s -> s
+          | None ->
+            User_error.raise ~loc:loc_switch
+              [ Pp.textf "Generated context name %S is invalid" name
+              ; Pp.text
+                  "Please specify a context name manually with the (name ..) \
+                   field"
+              ] )
       in
-      let name = Option.value ~default name in
       let base = { base with targets = Target.add base.targets x; name } in
       { base; switch; root; merlin }
   end

src/dune/workspace.mli

@@ -34,7 +34,9 @@ module Context : sig
   module Opam : sig
     type t =
       { base : Common.t
-      ; switch : Context_name.t
+            (** Either a switch name or a path to a local switch. This argument
+                is left opaque as we leave to opam to interpret it. *)
+      ; switch : string
       ; root : string option
       ; merlin : bool
       }