unify and complete the [is_prefix]/[is_suffix] interface

Signed-off-by: Arseniy Alekseyev <aalekseyev@janestreet.com>

src/dune_file.ml

@@ -173,10 +173,10 @@ module Pps_and_flags = struct
       in
       let pps, more_flags =
         List.partition_map l ~f:(fun s ->
-          if String.is_prefix ~prefix:"-"
-            (String_with_vars.known_prefix s) then
+          match String_with_vars.is_prefix ~prefix:"-" s with
+          | Yes ->
             Right s
-          else
+          | No | Unknown _ ->
             let loc = String_with_vars.loc s in
             match String_with_vars.text_only s with
             | None -> no_templates loc "in the ppx library names"
@@ -188,11 +188,11 @@ module Pps_and_flags = struct
       if syntax_version < (1, 10) then
         List.iter ~f:
           (fun flag ->
-            if String_with_vars.has_vars flag then
-              Syntax.Error.since (String_with_vars.loc flag)
-                Stanza.syntax
-                (1, 10)
-                  ~what:"Using variables in pps flags"
+             if String_with_vars.has_vars flag then
+               Syntax.Error.since (String_with_vars.loc flag)
+                 Stanza.syntax
+                 (1, 10)
+                 ~what:"Using variables in pps flags"
           ) all_flags;
       (pps, all_flags)
   end

src/install.ml

@@ -255,10 +255,10 @@ module Entry = struct
     in
     let src_basename () =
       match src with
-      | Expanded e -> Filename.basename e
+      | Expanded s -> Filename.basename s
       | Unexpanded src ->
-        match (String_with_vars.get_known_suffix src) with
-        | Full _ -> assert false
+        match String_with_vars.known_suffix src with
+        | Full s -> Filename.basename s
         | Partial (var, suffix) ->
           match String.rsplit2 ~on:'/' suffix with
           | Some (_, basename) ->

src/string_with_vars.ml

@@ -230,23 +230,55 @@ module Var = struct
        | Some _ -> { t with payload = Some ".." })
 end
 
-type get_known_suffix =
+type known_suffix =
   | Full of string
   | Partial of (Var.t * string)
 
-let get_known_suffix =
+let known_suffix =
   let rec go t acc = match t with
     | Text s :: rest -> go rest (s :: acc)
     | [] -> Full (String.concat ~sep:"" acc)
     | Var v :: _ -> Partial (v, String.concat ~sep:"" acc)
   in
-  fun { template = { parts; _ }; _ } -> go (List.rev parts) []
+  fun t -> go (List.rev t.template.parts) []
+
+type known_prefix =
+  | Full of string
+  | Partial of (string * Var.t)
+
+let known_prefix =
+  let rec go t acc = match t with
+    | Text s :: rest -> go rest (s :: acc)
+    | [] -> Full (String.concat ~sep:"" (List.rev acc))
+    | Var v :: _ -> Partial (String.concat ~sep:"" (List.rev acc), v)
+  in
+  fun t -> go t.template.parts []
 
 type 'a expander = Var.t -> Syntax.Version.t -> 'a
 
 type yes_no_unknown =
   | Yes | No | Unknown of Var.t
 
+let is_suffix t ~suffix:want =
+  match known_suffix t with
+  | Full s -> if String.is_suffix ~suffix:want s then Yes else No
+  | Partial (v, have) ->
+    if String.is_suffix ~suffix:want have then Yes
+    else
+    if String.is_suffix ~suffix:have want then Unknown v
+    else
+      No
+
+let is_prefix t ~prefix:want =
+  match known_prefix t with
+  | Full s -> if String.is_prefix ~prefix:want s then Yes else No
+  | Partial (have, v) ->
+    if String.is_prefix ~prefix:want have then Yes
+    else
+    if String.is_prefix ~prefix:have want then Unknown v
+    else
+      No
+
 module Private = struct
   module Partial = struct
     type nonrec 'a t =
@@ -257,21 +289,19 @@ module Private = struct
       | Expanded t -> Expanded (f t)
       | Unexpanded t -> Unexpanded t
 
-    let is_suffix t ~suffix:want_suffix =
-      let full s =
-        if String.is_suffix ~suffix:want_suffix s then Yes else No
-      in
+    let is_suffix t ~suffix =
       match t with
       | Expanded s ->
-        full s
-      | Unexpanded t -> match get_known_suffix t with
-        | Full s -> full s
-        | Partial (v, have_suffix) ->
-          if String.is_suffix ~suffix:want_suffix have_suffix then Yes
-          else
-          if String.is_suffix ~suffix:have_suffix want_suffix then Unknown v
-          else
-            No
+        if String.is_suffix ~suffix s then Yes else No
+      | Unexpanded t ->
+        is_suffix t ~suffix
+
+    let is_prefix t ~prefix =
+      match t with
+      | Expanded s ->
+        if String.is_prefix ~prefix s then Yes else No
+      | Unexpanded t ->
+        is_prefix t ~prefix
 
   end
 end
@@ -352,13 +382,6 @@ let text_only t =
   | [Text s] -> Some s
   | _ -> None
 
-let known_prefix =
-  let rec go acc = function
-    | Text s :: rest -> go (s :: acc) rest
-    | _ -> String.concat ~sep:"" (List.rev acc)
-  in
-  fun t -> go [] t.template.parts
-
 let has_vars t = Option.is_none (text_only t)
 
 let encode t =

src/string_with_vars.mli

@@ -37,8 +37,6 @@ val has_vars : t -> bool
 (** If [t] contains no variable, returns the contents of [t]. *)
 val text_only : t -> string option
 
-val known_prefix : t -> string
-
 module Mode : sig
   type _ t =
     | Single : Value.t t
@@ -76,13 +74,25 @@ module Partial : sig
   val map : 'a t -> f:('a -> 'b) -> 'b t
 
   val is_suffix : string t -> suffix:string -> yes_no_unknown
+
+  val is_prefix : string t -> prefix:string -> yes_no_unknown
 end
 
-type get_known_suffix =
+type known_suffix =
   | Full of string
   | Partial of (Var.t * string)
 
-val get_known_suffix : t -> get_known_suffix
+type known_prefix =
+  | Full of string
+  | Partial of (string * Var.t)
+
+val known_suffix : t -> known_suffix
+
+val known_prefix : t -> known_prefix
+
+val is_suffix : t -> suffix:string -> yes_no_unknown
+
+val is_prefix : t -> prefix:string -> yes_no_unknown
 
 type 'a expander = Var.t -> Syntax.Version.t -> 'a