use Data.Default.Class for empty NmcDom
authorEugene Crosser <crosser@average.org>
Sun, 27 Apr 2014 18:41:05 +0000 (22:41 +0400)
committerEugene Crosser <crosser@average.org>
Sun, 27 Apr 2014 18:41:05 +0000 (22:41 +0400)
NmcDom.hs
NmcTransform.hs
PowerDns.hs

index 3ab8c7fd40aa6213e8e47f63459a9fac296edeb1..79402e7da1b8f185421842552195c06a8b895812 100644 (file)
--- a/NmcDom.hs
+++ b/NmcDom.hs
@@ -5,7 +5,6 @@ module NmcDom   ( NmcDom(..)
                 , NmcRRI2p(..)
                 , NmcRRTls(..)
                 , NmcRRDs(..)
                 , NmcRRI2p(..)
                 , NmcRRTls(..)
                 , NmcRRDs(..)
-                , emptyNmcDom
                 , mergeNmcDom
                 ) where
 
                 , 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 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
 
 -- 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)
 
                         , 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'
 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
                           where
                             s' = unpack s
                             isIPv4 x = all isNibble $ splitOn "." x
@@ -227,8 +232,3 @@ instance Mergeable NmcDom where
 
 mergeNmcDom :: NmcDom -> NmcDom -> NmcDom
 mergeNmcDom = merge
 
 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
index c30bc1f8efe525ffb3f2c8950b14476153449756..3cd37dfe314e46cbdb09918c12fb5f646bf6ef71 100644 (file)
@@ -9,6 +9,7 @@ import Data.Map.Lazy (empty, lookup, delete, size, singleton
                      , foldrWithKey, insert, insertWith)
 import Control.Monad (foldM)
 import Data.Aeson (decode)
                      , foldrWithKey, insert, insertWith)
 import Control.Monad (foldM)
 import Data.Aeson (decode)
+import Data.Default.Class (def)
 
 import NmcDom
 
 
 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
     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
   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
         where
           addSrvMx sr acc = sub1 `mergeNmcDom` acc
             where
-              sub1 = emptyNmcDom { domMap = Just (singleton proto sub2)
+              sub1 = def { domMap = Just (singleton proto sub2)
                                  , domMx = maybemx}
                                  , 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"
               proto = "_" ++ (srvProto sr)
               srvid = "_" ++ (srvName sr)
               srvStr =  (show (srvPrio sr)) ++ "\t"
@@ -111,7 +112,7 @@ splitSubdoms base =
   in
     case domMap base of
       Nothing -> 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
         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 ([], 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
  
 -- | 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
   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 }
     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
         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
             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
                 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])}
index 457cdcae5b3be03b3160b0dc1f87e38b6b015bc6..ece3ac79a5dadb4d96469bfcbb77ea2d776afdcc 100644 (file)
@@ -9,6 +9,7 @@ module PowerDns ( RRType(..)
 
 import Data.Text.Lazy (splitOn, pack)
 import Data.Map.Lazy (foldrWithKey)
 
 import Data.Text.Lazy (splitOn, pack)
 import Data.Map.Lazy (foldrWithKey)
+import Data.Default.Class (def)
 
 import NmcDom
 
 
 import NmcDom
 
@@ -177,7 +178,7 @@ dataRR RRTypeSOA   = \ gen name dom ->
       Nothing   -> "hostmaster." ++ name ++ "."
       Just addr -> dotmail addr
   in
       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
     else
     -- Follows a relatively ugly hack to figure if we are at the top
     -- level domain ("something.bit"). Only in such case we provide