Fix bug in parsing of parens in some preferred content expressions. This fixes the behavior of the manual mode group.

The current manual mode preferred content expression is:

"present and (((exclude=*/archive/* and exclude=archive/*) or (not (copies=archive:1 or copies=smallarchive:1))) or (not copies=semitrusted+:1))"

The old matcher misparsed this, to basically:

OR (present and (...)) (not copies=semitrusted+:1))

The paren handling and indeed the whole conversion from tokens to the
matcher was just wrong. The new way may not be the cleverest, but I think
it is correct, and you can see how it pattern matches structurally against
the expressions when parsing them.

That expression is now parsed to:

MAnd (MOp <function>)
  (MOr (MOr (MAnd (MOp <function>) (MOp <function>)) (MNot (MOr (MOp <function>) (MOp <function>))))
    (MNot (MOp <function>)))

Which appears correct, and behaves correct in testing.

Also threw in a simplifier, so the final generated Matcher has less
unnecessary clutter in it. Mostly so that I could more easily read &
confirm them.

Also, added a simple test of the Matcher to the test suite.

There is a small chance of badly formed preferred content expressions
behaving differently than before due to this rewrite.

1 files changed, 61 insertions, 19 deletions

diff --git a/Utility/Matcher.hs b/Utility/Matcher.hs
index 89a4e7d0c..d872d9234 100644
--- a/Utility/Matcher.hs
+++ b/Utility/Matcher.hs
@@ -10,7 +10,7 @@
  - Is forgiving about misplaced closing parens, so "foo and (bar or baz"
  - will be handled, as will "foo and ( bar or baz ) )"
  -
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2013 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -26,7 +26,9 @@ module Utility.Matcher (
 	match,
 	matchM,
 	matchMrun,
-	isEmpty
+	isEmpty,
+
+	prop_matcher_sane
 ) where
 
 import Common
@@ -57,26 +59,52 @@ tokens = words "and or not ( )"
 
 {- Converts a list of Tokens into a Matcher. -}
 generate :: [Token op] -> Matcher op
-generate = go MAny
+generate = simplify . process MAny . tokenGroups
   where
-	go m [] = m
-	go m ts = uncurry go $ consume m ts
-
-{- Consumes one or more Tokens, constructs a new Matcher,
- - and returns unconsumed Tokens. -}
-consume :: Matcher op -> [Token op] -> (Matcher op, [Token op])
-consume m [] = (m, [])
-consume m (t:ts) = go t
+	process m [] = m
+	process m ts = uncurry process $ consume m ts
+
+	consume m ((One And):y:rest) = (m `MAnd` process MAny [y], rest)
+	consume m ((One Or):y:rest) = (m `MOr` process MAny [y], rest)
+	consume m ((One Not):x:rest) = (m `MAnd` MNot (process MAny [x]), rest)
+	consume m ((One (Operation o)):rest) = (m `MAnd` MOp o, rest)
+	consume m (Group g:rest) = (process m g, rest)
+	consume m (_:rest) = consume m rest
+	consume m [] = (m, [])
+
+	simplify (MAnd MAny x) = simplify x
+	simplify (MAnd x MAny) = simplify x
+	simplify (MAnd x y) = MAnd (simplify x) (simplify y)
+	simplify (MOr x y) = MOr (simplify x) (simplify y)
+	simplify (MNot x) = MNot (simplify x)
+	simplify x = x
+
+data TokenGroup op = One (Token op) | Group [TokenGroup op]
+	deriving (Show, Eq)
+
+tokenGroups :: [Token op] -> [TokenGroup op]
+tokenGroups [] = []
+tokenGroups (t:ts) = go t
   where
-	go And = cont $ m `MAnd` next
-	go Or = cont $ m `MOr` next
-	go Not = cont $ m `MAnd` MNot next
-	go Open = let (n, r) = consume next rest in (m `MAnd` n, r)
-	go Close = (m, ts)
-	go (Operation o) = (m `MAnd` MOp o, ts)
+  	go Open =
+		let (gr, rest) = findClose ts
+		in gr : tokenGroups rest
+	go Close = tokenGroups ts -- not picky about missing Close
+	go _ = One t : tokenGroups ts
 
-	(next, rest) = consume MAny ts
-	cont v = (v, rest)
+findClose :: [Token op] -> (TokenGroup op, [Token op])
+findClose l = 
+	let (g, rest) = go [] l
+	in (Group (reverse g), rest)
+  where
+  	go c [] = (c, []) -- not picky about extra Close
+	go c (t:ts) = handle t
+	  where
+		handle Close = (c, ts)
+		handle Open = 
+			let (c', ts') = go [] ts
+			in go (Group (reverse c') : c) ts'
+		handle _ = go (One t:c) ts
 
 {- Checks if a Matcher matches, using a supplied function to check
  - the value of Operations. -}
@@ -109,3 +137,17 @@ matchMrun m run = go m
 isEmpty :: Matcher a -> Bool
 isEmpty MAny = True
 isEmpty _ = False
+
+prop_matcher_sane :: Bool
+prop_matcher_sane = all (\m -> match dummy m ()) $ map generate
+	[ [Operation True]
+	, []
+	, [Operation False, Or, Operation True, Or, Operation False]
+	, [Operation True, Or, Operation True]
+	, [Operation True, And, Operation True]
+	, [Not, Open, Operation True, And, Operation False, Close]
+	, [Not, Open, Not, Open, Not, Operation False, Close, Close]
+	, [Not, Open, Not, Open, Not, Open, Not, Operation True, Close, Close]
+	]
+  where
+	dummy b _ = b