Improvements relating to pathspec patterns

doc/unison-manual.tex

@@ -1859,7 +1859,7 @@
 \end{alltt}
 adds \ARG{pattern} to the list of patterns to be ignored.
 
-\item Each \ARG{pattern} can have one of three forms.  The most
+\item Each \ARG{pattern} can have one of four forms.  The most
 general form is a Posix extended regular expression introduced by the
 keyword \verb|Regex|.  (The collating sequences and character classes of
 full Posix regexps are not currently supported).

src/pred.ml

@@ -72,25 +72,22 @@ let compile_pattern clause =
     | (p, Some v) -> (p, Some (Util.trimWhitespace v)) in
   let compiled =
     begin try
+      let checkpath prefix str =
+        let msg =
+          "Malformed pattern: \"" ^ p ^ "\"\n"
+          ^ "'" ^ prefix ^ "' patterns may not begin with a slash; "
+          ^ "only relative paths are allowed." in
+        if str<>"" && str.[0] = '/' then
+          raise (Prefs.IllegalValue msg) in
       select (String.sub p 1 ((String.length p)-1)) (* Remove prepended space *)
-        [("Name ", fun str -> Rx.seq [Rx.rx "(.*/)?"; Rx.globx str]);
+        [("Name ", fun str -> `Alt (Rx.seq [Rx.rx "(.*/)?"; Rx.globx str]));
          ("Path ", fun str ->
-            if str<>"" && str.[0] = '/' then
-              raise (Prefs.IllegalValue
-                       ("Malformed pattern: "
-                        ^ "\"" ^ p ^ "\"\n"
-                        ^ "'Path' patterns may not begin with a slash; "
-                        ^ "only relative paths are allowed."));
-            Rx.globx str);
+            checkpath "Path" str;
+            `Alt (Rx.globx str));
          ("BelowPath ", fun str ->
-            if str<>"" && str.[0] = '/' then
-              raise (Prefs.IllegalValue
-                       ("Malformed pattern: "
-                        ^ "\"" ^ p ^ "\"\n"
-                        ^ "'BelowPath' patterns may not begin with a slash; "
-                        ^ "only relative paths are allowed."));
-            Rx.seq [Rx.globx str; Rx.rx "(/.*)?"]);
-         ("Regex ", Rx.rx)]
+            checkpath "BelowPath" str;
+            `Alt (Rx.seq [Rx.globx str; Rx.rx "(/.*)?"]));
+         ("Regex ", fun str -> `Alt (Rx.rx str))]
         (fun str -> raise (Prefs.IllegalValue (error_msg p)))
     with
       Rx.Parse_error | Rx.Not_supported ->
@@ -120,13 +117,13 @@ let alias p n = Prefs.alias p.pref n
 let recompile mode p =
   let pref = Prefs.read p.pref in
   let compiledList = Safelist.map compile_pattern (Safelist.append p.default pref) in
-  let compiled = Rx.alt (Safelist.map fst compiledList) in
+  let compiled = Rx.alt (Safelist.map (fun (`Alt rx, _) -> rx) compiledList) in
   let handleCase rx =
     if (Case.ops())#caseInsensitiveMatch then Rx.case_insensitive rx
     else rx
   in
   let strings = Safelist.filterMap
-                  (fun (rx,vo) ->
+                  (fun (`Alt rx, vo) ->
                      match vo with
                        None -> None
                      | Some v -> Some (handleCase rx,v))

src/pred.mli

@@ -19,9 +19,10 @@
      <TYPE> <PAT> [ -> <ASSOCIATED STRING> ]
    The associated string is ignored by [test] but can be looked up by [assoc].
 
-   Three forms of <TYPE>/<PAT> are recognized:
+   Four forms of <TYPE>/<PAT> are recognized:
    "Name <name>": ..../<name> (using globx)
    "Path <path>": <path>, not starting with "/" (using globx)
+   "BelowPath <path>": <path>, not starting with "/" (using globx)
    "Regex <regex>": <regex> (using rx)
 *)