X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fharbl.git;a=blobdiff_plain;f=harbl%2Fsrc%2FNetwork%2FDNS%2FRBL%2FHost.hs;h=0b93e04cef58a07c98af109faee7b194a46641cb;hp=93deeb88f1f10fcf98cf0b4abfb4ced09905c12e;hb=5c8702f0be60474482c587ba353e01ddf24f79cc;hpb=b55e5db2a68be5d69b970bbe4b5ad447881abd3d

diff --git a/harbl/src/Network/DNS/RBL/Host.hs b/harbl/src/Network/DNS/RBL/Host.hs
index 93deeb8..0b93e04 100644
--- a/harbl/src/Network/DNS/RBL/Host.hs
+++ b/harbl/src/Network/DNS/RBL/Host.hs
@@ -1,19 +1,19 @@
-module Network.DNS.RBL.Host
+module Network.DNS.RBL.Host (
+  Host(..),
+  host )
 where
 
-import Data.ByteString.Char8 (
-  intercalate,
-  pack,
-  split )
-import qualified Network.DNS as DNS ( Domain )
 import Text.Parsec (
   (<|>),
   char,
   try )
 import Text.Parsec.String ( Parser )
 
-import Network.DNS.RBL.Domain ( Domain, domain )
+import Network.DNS.RBL.Domain.Domain (
+  Domain(..),
+  domain )
 import Network.DNS.RBL.Pretty ( Pretty(..) )
+import Network.DNS.RBL.Reversible ( Reversible(..) )
 
 
 -- | This type helps clarify some murkiness in the DNS \"domain\" name
@@ -50,27 +50,27 @@ instance Pretty Host where
 --
 --   We can really parse the root now!
 --
---   >>> parseTest user_domain "."
+--   >>> parseTest host "."
 --   HostAbsolute DomainRoot
 --
 --   But multiple dots aren't (only the first):
 --
---   >>> pretty_print $ parse user_domain "" ".."
+--   >>> pretty_print $ parse host "" ".."
 --   .
 --
 --   We can also optionally have a trailing dot at the end of a
 --   non-empty name:
 --
---   >>>  pretty_print $ parse user_domain "" "www.example.com"
+--   >>>  pretty_print $ parse host "" "www.example.com"
 --   www.example.com
 --
---   >>>  pretty_print $ parse user_domain "" "www.example.com."
+--   >>>  pretty_print $ parse host "" "www.example.com."
 --   www.example.com.
 --
 --   A \"relative root\" can also be parsed, letting the user's
 --   resolver deal with it:
 --
---   >>> parseTest user_domain ""
+--   >>> parseTest host ""
 --   HostRelative DomainRoot
 --
 host :: Parser Host
@@ -86,45 +86,23 @@ host = try absolute <|> relative
     relative = fmap HostRelative domain
 
 
-
--- | Reverse the labels of this host in preparation for making a
---   lookup (using the DNS library). We need to reverse the labels
---   (the stuff between the dots) whether we're looking up a host or a
---   name. The only tricky part here is that we need to turn an
---   absolute 'Host' into a relative one.
---
---   ==== _Examples_
---
---   >>> import Text.Parsec ( parse )
---
---   >>> let (Right r) = parse host "" "1.2.3.4"
---   >>> reverse_labels r
---   "4.3.2.1"
---
---   >>> let (Right r) = parse host "" "www.example.com"
---   >>> reverse_labels r
---   "com.example.www"
---
---   Make sure absolute names are made relative:
---
---   >>> let (Right r) = parse host "" "www.example.com."
---   >>> reverse_labels r
---   "com.example.www"
---
-reverse_labels :: Host -> DNS.Domain
-reverse_labels h = reversed
-  where
-    -- | It's possible that we are given an absolute domain name to
-    --   look up. This is legit; say I want to look up
-    --   \"www.example.com.\" That's fine, but before we make the
-    --   actual query we'll need to make it relative and then append
-    --   the DNSBL's suffix to it.
-    relative_host_string :: String
-    relative_host_string =
-      case h of
-        (HostRelative _) -> pretty_show h
-        (HostAbsolute d) -> pretty_show d
-
-    dot = pack "."
-    labels = split '.' (pack relative_host_string)
-    reversed = intercalate dot (reverse labels)
+instance Reversible Host where
+  -- | Reverse the labels of this 'Host' in preparation for making a
+  --   lookup (using the DNS library). We need to reverse the labels
+  --   (the stuff between the dots) whether we're looking up a host or a
+  --   name.
+  --
+  --   ==== _Examples_
+  --
+  --   >>> import Text.Parsec ( parse )
+  --
+  --   >>> let (Right r) = parse host "" "1.2.3.4"
+  --   >>> pretty_print $ backwards r
+  --   4.3.2.1
+  --
+  --   >>> let (Right r) = parse host "" "new.www.example.com"
+  --   >>> pretty_print $ backwards r
+  --   com.example.www.new
+  --
+  backwards (HostRelative d) = HostRelative $ backwards d
+  backwards (HostAbsolute d) = HostAbsolute $ backwards d