better normalization

diff --git a/NmcDom.hs b/NmcDom.hs
index 03eeb98582275db94d2554b48fb4d4a80bb15cf6..10f3a8b074359dafae74f416c9a2aa5af452e970 100644 (file)
--- a/NmcDom.hs
+++ b/NmcDom.hs
@@ -171,10 +171,9 @@ mergeImport queryOp base = do
 mergeSelf :: NmcDom -> NmcDom
 mergeSelf base =
   let
 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
     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
 
 -- | 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 ::
 
 -- | 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
 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'
     d:ds ->
       case base' of
         Left err     -> return base'