From: Eugene Crosser <crosser@average.org>
Date: Sun, 13 Apr 2014 12:11:54 +0000 (+0400)
Subject: better normalization
X-Git-Tag: 0.9.0.0~81
X-Git-Url: http://www.average.org/gitweb/?p=pdns-pipe-nmc.git;a=commitdiff_plain;h=d38ca22c693b85e90a43e301edf3ec525d0d8360;hp=fbe7735ec10867611bc9d202fce4336c36c8af66

better normalization
---

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'