@@ -333,25 +333,27 @@ romanNumeral upperCase = do
333333-- Parsers for email addresses and URIs
334334
335335emailChar :: Parser [Char] st Char
336−emailChar = alphaNum <|>
337− satisfy (\c -> c == '-' || c == '+' || c == '_' || c == '.')
336+emailChar = alphaNum <|> oneOf "!\"#$%&'*+-/0123456789=?^_{|}~"
338337
339−domainChar :: Parser [Char] st Char
340−domainChar = alphaNum <|> char '-'
341−
342−domain :: Parser [Char] st [Char]
338+domain :: Parser [Char] st String
343339domain = do
344− first <- many1 domainChar
345− dom <- many1 $ try (char '.' >> many1 domainChar )
346− return $ intercalate "." (first:dom)
340+ x <- subdomain
341+ xs <- many (try $ char '.' >> subdomain)
342+ return $ intercalate "." (x:xs)
343+
344+subdomain :: Parser [Char] st String
345+subdomain = many1 (emailChar <|> char '@')
346+
347+emailWord :: Parser [Char] st String
348+emailWord = many1 emailChar -- ignores possibility of quoted strings
347349
348350-- | Parses an email address; returns original and corresponding
349351-- escaped mailto: URI.
350352emailAddress :: Parser [Char] st (String, String)
351353emailAddress = try $ do
352− firstLetter <- alphaNum
353− restAddr <- many emailChar
354− let addr = firstLetter:restAddr
354+ x <- emailWord
355+ xs <- many (try $ char '.' >> emailWord)
356+ let addr = intercalate "." (x:xs)
355357 char '@'
356358 dom <- domain
357359 let full = addr ++ '@':dom