]> gitweb.michael.orlitzky.com - list-remote-forwards.git/blobdiff - src/Forward.hs
Introduce a NormalDomain newtype to ensure comparisons are made safely.
[list-remote-forwards.git] / src / Forward.hs
index 3e9ad88fba5c0275443e1934034685ce5423739c..d4936eda5c2169fbbcdc3130689125cb111195cd 100644 (file)
@@ -11,7 +11,7 @@ where
 
 import Data.String.Utils ( split, strip )
 
-import DNS ( normalize_string_domain )
+import DNS ( NormalDomain, normalize_string )
 
 -- | Type synonym to make the signatures below a little more clear.
 --   WARNING: Also defined in the "Report" module.
@@ -22,14 +22,14 @@ type Domain = String
 --   a 'String'. This differs from a 'Goto' in that it should only
 --   appear on the left-hand-side of a alias -> goto relationship.
 --
-newtype Address = Address String deriving ( Show )
+newtype Address = Address String deriving ( Eq, Show )
 
 
 -- | A type-safe wrapper around an email address that's represented as
 --   a 'String'. This differs from 'Address' in that 'Goto' addresses
 --   are the destinations of mail that is forwarded, rather than the
 --   source.
-newtype Goto = Goto String deriving ( Show )
+newtype Goto = Goto String deriving ( Eq, Show )
 
 
 -- | A data type representing a "forward." That is, an email address
@@ -41,7 +41,7 @@ newtype Goto = Goto String deriving ( Show )
 --
 data Forward =
   Forward Address Goto
-  deriving (Show)
+  deriving ( Eq, Show )
 
 
 -- | Shortcut constructor for creating 'Forward' objects.
@@ -220,27 +220,23 @@ domain_part address =
     parts = split "@" address
 
 
--- | Given a list of 'Domain's @domains@ and a list of 'Forward's
+-- | Given a list of 'NormalDomain's @domains@ and a list of 'Forward's
 --   @forwards@, filter out all elements of @forwards@ that have a
 --   goto domain in the list of @domains@.
 --
 --   ==== __Examples__
 --
---   >>> let ds = ["example.com", "example.net"]
+--   >>> let ds = map normalize_string ["example.com", "example.net"]
 --   >>> let f1 = fwd "a@example.com" "a@example.com"
 --   >>> let f2 = fwd "a@example.com" "a1@example.net"
 --   >>> let f3 = fwd "a@example.com" "a2@example.org"
 --   >>> map pretty_print (dropby_goto_domains ds [f1,f2,f3])
 --   ["a@example.com -> a2@example.org"]
 --
-dropby_goto_domains :: [Domain] -> [Forward] -> [Forward]
-dropby_goto_domains domains =
+dropby_goto_domains :: [NormalDomain] -> [Forward] -> [Forward]
+dropby_goto_domains normal_domains =
   filter (not . is_bad)
   where
-    -- If we don't normalize these first, comparison (i.e. `elem`)
-    -- doesn't work so great.
-    normalized_domains = map normalize_string_domain domains
-
     -- | A 'Forward' is bad if its goto domain appears in the list, or
     --   if we can't figure out its goto domain.
     --
@@ -248,4 +244,5 @@ dropby_goto_domains domains =
     is_bad f =
       case (goto_domain f) of
         Nothing -> True -- Drop these, too.
-        Just d  -> (normalize_string_domain d) `elem` normalized_domains
+        -- Nice, we can't compare unless we normalize @d@!
+        Just d  -> (normalize_string d) `elem` normal_domains