From: Eugene Crosser 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://average.org/gitweb/?a=commitdiff_plain;h=d38ca22c693b85e90a43e301edf3ec525d0d8360;p=pdns-pipe-nmc.git 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'