+
+-- * Subdomains
+
+
+-- | The data type representing a \"subdomain\" from RFC1035:
+--
+-- <subdomain> ::= <label> | <subdomain> "." <label>
+--
+-- We have reversed the order of the subdomain and label in the
+-- second option, however. This is explained in 'subdomain'.
+--
+data Subdomain =
+ SubdomainSingleLabel Label |
+ SubdomainMultipleLabel Label Subdomain
+ deriving (Eq, Show)
+
+instance Pretty Subdomain where
+ pretty_show (SubdomainSingleLabel l) = pretty_show l
+ pretty_show (SubdomainMultipleLabel l s) =
+ (pretty_show l) ++ "." ++ (pretty_show s)
+
+-- | Parse an RFC1035 \"subdomain\". The given grammar is,
+--
+-- <subdomain> ::= <label> | <subdomain> "." <label>
+--
+-- However, we have reversed the order of the subdomain and label to
+-- prevent infinite recursion. The second option (subdomain + label)
+-- is obviously more specific, we we need to try it first. This
+-- presents a problem: we're trying to parse a subdomain in terms of
+-- a subdomain! The given grammar represents subdomains how we like
+-- to think of them; from right to left. But it's better to parse
+-- from left to right, so we pick off the leading label and then
+-- recurse into the definition of subdomain.
+--
+-- ==== _Examples_
+--
+-- >>> import Text.Parsec ( parseTest )
+--
+-- Make sure we can parse a single character:
+--
+-- >>> parseTest subdomain "a"
+-- SubdomainSingleLabel (Label (Letter 'a') Nothing)
+--
+-- >>> pretty_print $ parse subdomain "" "example.com"
+-- example.com
+--
+-- >>> pretty_print $ parse subdomain "" "www.example.com"
+-- www.example.com
+--
+subdomain :: Parser Subdomain
+subdomain = try both <|> just_one
+ where
+ both :: Parser Subdomain
+ both = do
+ l <- label
+ char '.'
+ s <- subdomain
+ return (SubdomainMultipleLabel l s)
+
+ just_one :: Parser Subdomain
+ just_one = fmap SubdomainSingleLabel label
+
+
+
+-- * Domains
+
+-- | An RFC1035 domain. According to RFC1035 a domain can be either a
+-- subdomain or \" \", which according to RFC2181
+-- <https://tools.ietf.org/html/rfc2181#section-11> means the root:
+--
+-- The zero length full name is defined as representing the root
+-- of the DNS tree, and is typically written and displayed as
+-- \".\".
+--
+-- We let the 'Domain' type remain true to those RFCs, even though
+-- they don't support an absolute domain name of e.g. a single dot.
+-- We have one more data type 'UserDomain' which handles the possibility
+-- of an absolute path.
+--
+data Domain =
+ DomainName Subdomain |
+ DomainRoot
+ deriving (Eq, Show)
+
+instance Pretty Domain where
+ pretty_show DomainRoot = ""
+ pretty_show (DomainName s) = pretty_show s
+
+-- | Parse an RFC1035 \"domain\"
+--
+-- ==== _Examples_
+--
+-- >>> import Text.Parsec ( parseTest )
+--
+-- Make sure we can parse a single character:
+--
+-- >>> parseTest domain "a"
+-- DomainName (SubdomainSingleLabel (Label (Letter 'a') Nothing))
+--
+-- And the empty domain:
+--
+-- >>> parseTest domain ""
+-- DomainRoot
+--
+-- We will in fact parse the \"empty\" domain off the front of
+-- pretty much anything:
+--
+-- >>> parseTest domain "8===D"
+-- DomainRoot
+--
+-- Equality of domains is case-insensitive:
+--
+-- >>> let (Right r1) = parse domain "" "example.com"
+-- >>> let (Right r2) = parse domain "" "ExaMPle.coM"
+-- >>> r1 == r2
+-- True
+--
+-- A single dot IS parsed as the root, but the dot isn't consumed:
+--
+-- >>> parseTest domain "."
+-- DomainRoot
+--