From a1ba7b3ef698b046083c6581d496ac2039366556 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Tue, 21 Aug 2007 18:32:25 +0000 Subject: [PATCH] Added a useful function to TreeUtil that allows you to replace a given sub-pattern of a Pattern with the DontCare value --- TreeUtil.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/TreeUtil.hs b/TreeUtil.hs index 467b1d9..e3af0c5 100644 --- a/TreeUtil.hs +++ b/TreeUtil.hs @@ -16,7 +16,7 @@ You should have received a copy of the GNU General Public License along with this program. If not, see . -} -module TreeUtil (MatchErrors, AnyDataItem(..), Items, assertPatternMatch, getMatchedItems, mkPattern, tag0, tag1, tag2, tag3, tag4, tag5, tag6, tag7) where +module TreeUtil (MatchErrors, AnyDataItem(..), Items, assertPatternMatch, getMatchedItems, mkPattern, tag0, tag1, tag2, tag3, tag4, tag5, tag6, tag7, stopCaringPattern) where import Test.HUnit hiding (State) import qualified Data.Map as Map @@ -197,6 +197,18 @@ mkPattern x = case ((cast x) :: Maybe Pattern) of Just x' -> x' Nothing -> Match (toConstr x) (gmapQ mkPattern x) + +-- | Replaces (mkPattern a) with DontCare everywhere in the given pattern +stopCaringPattern :: Data a => a -> Pattern -> Pattern +-- We can't use everywhere, because Pattern doesn't have a proper gunfold implementation +stopCaringPattern item = stopCaringPattern' (mkPattern item) + where + stopCaringPattern' :: Pattern -> Pattern -> Pattern + stopCaringPattern' replace p@(DontCare) = p + stopCaringPattern' replace p@(Named n p') = if (p == replace) then DontCare else (Named n $ stopCaringPattern' replace p') + stopCaringPattern' replace p@(Match c ps) = if (p == replace) then DontCare else (Match c $ map (stopCaringPattern' replace) ps) + + --I'm not sure tag0 is ever needed, but just in case: tag0 :: (Data a) => a -> Pattern tag0 con = (Match (toConstr con) [])