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.

4 files changed, 70 insertions, 19 deletions

diff --git a/Test.hs b/Test.hs
index d5dc6e443..2a0a0113a 100644
--- a/Test.hs
+++ b/Test.hs
@@ -56,6 +56,7 @@ import qualified Utility.Misc
 import qualified Utility.InodeCache
 import qualified Utility.Env
 import qualified Utility.Gpg
+import qualified Utility.Matcher
 #ifndef __WINDOWS__
 import qualified GitAnnex
 #endif
@@ -114,6 +115,7 @@ quickcheck =
 	, check "prop_relPathDirToFile_basics" Utility.Path.prop_relPathDirToFile_basics
 	, check "prop_relPathDirToFile_regressionTest" Utility.Path.prop_relPathDirToFile_regressionTest
 	, check "prop_cost_sane" Config.Cost.prop_cost_sane
+	, check "prop_matcher_sane" Utility.Matcher.prop_matcher_sane
 	, check "prop_HmacSha1WithCipher_sane" Crypto.prop_HmacSha1WithCipher_sane
 	, check "prop_TimeStamp_sane" Logs.UUIDBased.prop_TimeStamp_sane
 	, check "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane
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
diff --git a/debian/changelog b/debian/changelog
index a7d1aa0fb..5bec3f555 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -9,6 +9,8 @@ git-annex (4.20130522) UNRELEASED; urgency=low
   * hook special remote: Added combined hook program support.
   * Android app: Avoid using hard links to app's lib directory, which
     is sometimes on a different filesystem than the data directory.
+  * Fix bug in parsing of parens in some preferred content expressions.
+    This fixes the behavior of the manual mode group.
 
  -- Joey Hess <joeyh@debian.org>  Tue, 21 May 2013 18:22:46 -0400
 
diff --git a/doc/bugs/Manual_content_mode_isn__39__t_manual.mdwn b/doc/bugs/Manual_content_mode_isn__39__t_manual.mdwn
index 3bbf298ed..cb0247766 100644
--- a/doc/bugs/Manual_content_mode_isn__39__t_manual.mdwn
+++ b/doc/bugs/Manual_content_mode_isn__39__t_manual.mdwn
@@ -82,3 +82,8 @@ To /home/valorin/workspace/tmp/test2
 Everything up-to-date
 Everything up-to-date
 """]]
+
+> It turns out there was a bug in the preferred content expression parser,
+> that made it parse the expression for manual mode (but I think no other standard
+> expression) quite wrong, as if it had parens in the wrong place. This explains
+> the broken behavior. [[fixed|done]] --[[Joey]]