Fix parsing of labels beginning with digits.

diff --git a/src/Network/DNS/RBL/Domain.hs b/src/Network/DNS/RBL/Domain.hs
index a405ff1bf6f20f2eec3165bb3a82b9bd68b37b93..73a69884f826945c1aacca3b118c6c7a389e6693 100644 (file)
--- a/src/Network/DNS/RBL/Domain.hs
+++ b/src/Network/DNS/RBL/Domain.hs
@@ -15,7 +15,7 @@
 --   (octets).
 --
 module Network.DNS.RBL.Domain (
 --   (octets).
 --
 module Network.DNS.RBL.Domain (

-  UserDomain,
+  UserDomain(..),

   user_domain )
 where
 
   user_domain )
 where
 


@@ -400,7 +400,7 @@ length_ldh_str_let_dig (LdhStrLetDig (Just ldhstring) _) =
 --     letter or a digit.  Host software MUST support this more liberal
 --     syntax.
 --
 --     letter or a digit.  Host software MUST support this more liberal
 --     syntax.
 --

-data Label = Label Letter (Maybe LdhStrLetDig)
+data Label = Label LetDig (Maybe LdhStrLetDig)

   deriving (Eq, Show)
 
 instance Pretty Label where
   deriving (Eq, Show)
 
 instance Pretty Label where


@@ -428,7 +428,7 @@ instance Pretty Label where
 --   Make sure we can parse a single character:
 --
 --   >>> parseTest label "a"
 --   Make sure we can parse a single character:
 --
 --   >>> parseTest label "a"

---   Label (Letter 'a') Nothing
+--   Label (LetDigLetter (Letter 'a')) Nothing

 --
 --   And longer strings:
 --
 --
 --   And longer strings:
 --


@@ -452,9 +452,14 @@ instance Pretty Label where
 --   >>> pretty_print $ parse label "" (replicate 63 'x')
 --   xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
 --
 --   >>> pretty_print $ parse label "" (replicate 63 'x')
 --   xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
 --

+--   Ensure that a label can begin with a digit:
+--
+--   >>> pretty_print $ parse label "" "3com"
+--   3com
+--

 label :: Parser Label
 label = do
 label :: Parser Label
 label = do

-  l <- letter -- Guaranteed to be there
+  l <- let_dig -- Guaranteed to be there

   maybe_s <- optionMaybe ldh_str_let_dig -- Might not be there
   case maybe_s of
     -- It can only be one character long, from the letter...
   maybe_s <- optionMaybe ldh_str_let_dig -- Might not be there
   case maybe_s of
     -- It can only be one character long, from the letter...


@@ -523,7 +528,7 @@ instance Pretty Subdomain where
 --   Make sure we can parse a single character:
 --
 --   >>> parseTest subdomain "a"
 --   Make sure we can parse a single character:
 --
 --   >>> parseTest subdomain "a"

---   SubdomainSingleLabel (Label (Letter 'a') Nothing)
+--   SubdomainSingleLabel (Label (LetDigLetter (Letter 'a')) Nothing)

 --
 --   >>> pretty_print $ parse subdomain "" "example.com"
 --   example.com
 --
 --   >>> pretty_print $ parse subdomain "" "example.com"
 --   example.com


@@ -654,8 +659,8 @@ instance Pretty Domain where
 --
 --   Make sure we can parse a single character:
 --
 --
 --   Make sure we can parse a single character:
 --

---   >>> parseTest domain "a"
---   DomainName (SubdomainSingleLabel (Label (Letter 'a') Nothing))
+--   >>> pretty_print $ parse domain "" "a"
+--   a

 --
 --   And the empty domain:
 --
 --
 --   And the empty domain:
 --


@@ -665,7 +670,7 @@ instance Pretty Domain where
 --   We will in fact parse the \"empty\" domain off the front of
 --   pretty much anything:
 --
 --   We will in fact parse the \"empty\" domain off the front of
 --   pretty much anything:
 --

---   >>> parseTest domain "8===D"
+--   >>> parseTest domain "!8===D"

 --   DomainRoot
 --
 --   Equality of domains is case-insensitive:
 --   DomainRoot
 --
 --   Equality of domains is case-insensitive: