From: Eugene Crosser Date: Sun, 27 Apr 2014 18:41:05 +0000 (+0400) Subject: use Data.Default.Class for empty NmcDom X-Git-Tag: 0.9.0.0~8 X-Git-Url: http://average.org/gitweb/?a=commitdiff_plain;h=aa91db8940672a57169b1bb400fa3c1a1e9dd335;p=pdns-pipe-nmc.git use Data.Default.Class for empty NmcDom --- diff --git a/NmcDom.hs b/NmcDom.hs index 3ab8c7f..79402e7 100644 --- a/NmcDom.hs +++ b/NmcDom.hs @@ -5,7 +5,6 @@ module NmcDom ( NmcDom(..) , NmcRRI2p(..) , NmcRRTls(..) , NmcRRDs(..) - , emptyNmcDom , mergeNmcDom ) where @@ -20,6 +19,7 @@ import Data.Map (Map, unionWith) import qualified Data.HashMap.Strict as H (lookup) import Data.Aeson import Data.Aeson.Types +import Data.Default.Class -- Variant of Aeson's `.:?` that interprets a String as a -- single-element list, so it is possible to have either @@ -157,14 +157,19 @@ data NmcDom = NmcDom { domService :: Maybe [NmcRRService] , domSrv :: Maybe [String] -- Synthetic } deriving (Show, Eq) +instance Default NmcDom where + def = NmcDom Nothing Nothing Nothing Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing Nothing Nothing + instance FromJSON NmcDom where -- Wherever we expect a domain object, there may be a string -- containing IPv4 address. Interpret it as such. -- Question: shall we try to recognize IPv6 addresses too? parseJSON (String s) = return $ if isIPv4 s' - then emptyNmcDom { domIp = Just [s'] } - else emptyNmcDom + then def { domIp = Just [s'] } + else def where s' = unpack s isIPv4 x = all isNibble $ splitOn "." x @@ -227,8 +232,3 @@ instance Mergeable NmcDom where mergeNmcDom :: NmcDom -> NmcDom -> NmcDom mergeNmcDom = merge - -emptyNmcDom = NmcDom Nothing Nothing Nothing Nothing Nothing Nothing - Nothing Nothing Nothing Nothing Nothing Nothing - Nothing Nothing Nothing Nothing Nothing Nothing - Nothing Nothing diff --git a/NmcTransform.hs b/NmcTransform.hs index c30bc1f..3cd37df 100644 --- a/NmcTransform.hs +++ b/NmcTransform.hs @@ -9,6 +9,7 @@ import Data.Map.Lazy (empty, lookup, delete, size, singleton , foldrWithKey, insert, insertWith) import Control.Monad (foldM) import Data.Aeson (decode) +import Data.Default.Class (def) import NmcDom @@ -45,7 +46,7 @@ mergeIncl queryOp depth base = do else case ((domDelegate mbase), (domImport mbase)) of (Nothing, Nothing ) -> return $ Right base' (Nothing, Just keys) -> foldM mergeIncl1 (Right base') keys - (Just key, _ ) -> mergeIncl1 (Right emptyNmcDom) key + (Just key, _ ) -> mergeIncl1 (Right def) key where mergeIncl1 (Left err) _ = return $ Left err -- can never happen mergeIncl1 (Right acc) key = do @@ -85,10 +86,10 @@ expandSrv base = where addSrvMx sr acc = sub1 `mergeNmcDom` acc where - sub1 = emptyNmcDom { domMap = Just (singleton proto sub2) + sub1 = def { domMap = Just (singleton proto sub2) , domMx = maybemx} - sub2 = emptyNmcDom { domMap = Just (singleton srvid sub3) } - sub3 = emptyNmcDom { domSrv = Just [srvStr] } + sub2 = def { domMap = Just (singleton srvid sub3) } + sub3 = def { domSrv = Just [srvStr] } proto = "_" ++ (srvProto sr) srvid = "_" ++ (srvName sr) srvStr = (show (srvPrio sr)) ++ "\t" @@ -111,7 +112,7 @@ splitSubdoms base = in case domMap base of Nothing -> base' - Just sdmap -> (emptyNmcDom { domMap = Just sdmap' }) `mergeNmcDom` base' + Just sdmap -> (def { domMap = Just sdmap' }) `mergeNmcDom` base' where sdmap' = foldrWithKey stow empty sdmap stow fqdn sdom acc = insertWith mergeNmcDom fqdn' sdom' acc @@ -122,7 +123,7 @@ splitSubdoms base = nest ([], v) = (fqdn, v) -- can split result be empty? nest ([k], v) = (k, v) nest (k:ks, v) = - nest (ks, emptyNmcDom { domMap = Just (singleton k v) }) + nest (ks, def { domMap = Just (singleton k v) }) -- | Presence of some elements require removal of some others normalizeDom :: NmcDom -> NmcDom @@ -132,7 +133,7 @@ normalizeDom dom = foldr id dom [ translateNormalizer where nsNormalizer dom = case domNs dom of Nothing -> dom - Just ns -> emptyNmcDom { domNs = domNs dom, domEmail = domEmail dom } + Just ns -> def { domNs = domNs dom, domEmail = domEmail dom } translateNormalizer dom = case domTranslate dom of Nothing -> dom Just tr -> dom { domMap = Nothing } @@ -152,14 +153,14 @@ descendNmcDom queryOp subdom base = do Left err -> return base' Right base'' -> case domMap base'' of - Nothing -> return $ Right emptyNmcDom + Nothing -> return $ Right def Just map -> case lookup d map of - Nothing -> return $ Right emptyNmcDom + Nothing -> return $ Right def Just sub -> descendNmcDom queryOp ds sub -- | Initial NmcDom populated with "import" only, suitable for "descend" seedNmcDom :: String -- ^ domain key (without namespace prefix) -> NmcDom -- ^ resulting seed domain -seedNmcDom dn = emptyNmcDom { domImport = Just (["d/" ++ dn])} +seedNmcDom dn = def { domImport = Just (["d/" ++ dn])} diff --git a/PowerDns.hs b/PowerDns.hs index 457cdca..ece3ac7 100644 --- a/PowerDns.hs +++ b/PowerDns.hs @@ -9,6 +9,7 @@ module PowerDns ( RRType(..) import Data.Text.Lazy (splitOn, pack) import Data.Map.Lazy (foldrWithKey) +import Data.Default.Class (def) import NmcDom @@ -177,7 +178,7 @@ dataRR RRTypeSOA = \ gen name dom -> Nothing -> "hostmaster." ++ name ++ "." Just addr -> dotmail addr in - if dom == emptyNmcDom then [] + if dom == def then [] else -- Follows a relatively ugly hack to figure if we are at the top -- level domain ("something.bit"). Only in such case we provide