From d38ca22c693b85e90a43e301edf3ec525d0d8360 Mon Sep 17 00:00:00 2001
From: Eugene Crosser <crosser@average.org>
Date: Sun, 13 Apr 2014 16:11:54 +0400
Subject: [PATCH] better normalization

---
 NmcDom.hs | 26 ++++++++++++++------------
 1 file changed, 14 insertions(+), 12 deletions(-)

diff --git a/NmcDom.hs b/NmcDom.hs
index 03eeb98..10f3a8b 100644
--- a/NmcDom.hs
+++ b/NmcDom.hs
@@ -171,10 +171,9 @@ mergeImport queryOp base = do
 mergeSelf :: NmcDom -> NmcDom
 mergeSelf base =
   let
-    nbase = normalizeDom base
-    map   = domMap nbase
-    base' = nbase {domMap = removeSelf map}
-    removeSelf (Nothing)  = Nothing
+    map   = domMap base
+    base' = base {domMap = removeSelf map}
+    removeSelf Nothing    = Nothing
     removeSelf (Just map) = if size map' == 0 then Nothing else Just map'
       where map' = M.delete "" map
   in
@@ -187,13 +186,16 @@ mergeSelf base =
 
 -- | Presence of some elements require removal of some others
 normalizeDom :: NmcDom -> NmcDom
-normalizeDom dom
-  | domNs        dom /= Nothing = emptyNmcDom { domNs    = domNs dom
-                                              , domEmail = domEmail dom
-                                              }
-  | domDelegate  dom /= Nothing = emptyNmcDom -- FIXME
-  | domTranslate dom /= Nothing = dom { domMap = Nothing }
-  | otherwise                   = dom
+normalizeDom dom = foldr id dom [ nsNormalizer
+                                , translateNormalizer
+                                ]
+  where
+    nsNormalizer dom = case domNs dom of
+      Nothing  -> dom
+      Just ns  -> emptyNmcDom { domNs = domNs dom, domEmail = domEmail dom }
+    translateNormalizer dom = case domTranslate dom of
+      Nothing  -> dom
+      Just tr  -> dom { domMap = Nothing }
 
 -- | Merge imports and Selfs and follow the maps tree to get dom
 descendNmcDom ::
@@ -204,7 +206,7 @@ descendNmcDom ::
 descendNmcDom queryOp subdom base = do
   base' <- mergeImport queryOp base
   case subdom of
-    []   -> return base'
+    []   -> return $ fmap normalizeDom base'
     d:ds ->
       case base' of
         Left err     -> return base'
-- 
2.39.2