Email address parser: a first try, very limited and experimental.

src/GenericParser/EmailAddress.purs

@@ -0,0 +1,37 @@
+-- | `EmailAddress` is a parser for simple email addresses.
+-- | This module is experimental and doesn't follow every rule for an email address, yet.
+module GenericParser.EmailAddress where
+
+import Prelude (bind, pure, ($), (<>))
+
+import Control.Alt ((<|>))
+import Data.Maybe (Maybe(..))
+import Data.Either (Either(..))
+import Data.String.CodeUnits as CU
+
+import GenericParser.DomainParser.Common (DomainError)
+import GenericParser.DomainParser (sub_eof)
+import GenericParser.Parser (Parser(..)
+                            , char , digit , letter, many1
+                            , current_input, failureError, parse)
+
+data EmailError
+  = InvalidCharacter
+  | InvalidDomain (Maybe DomainError)
+
+-- | TODO: For now, `login_part` only checks that the first character is a letter,
+-- | the rest can be any letter, digit, '-' or '.', including the last character.
+login_part :: Parser EmailError String
+login_part = do firstchar <- letter
+                rest <- many1 (letter <|> digit <|> char '-' <|> char '.')
+                pure $ CU.fromCharArray $ [firstchar] <> rest
+
+-- | TODO: `email` checks but doesn't consume the domain part of the email address.
+email :: Parser EmailError String
+email = do login <- login_part
+           _ <- char '@'
+           input <- current_input
+           case parse sub_eof { string: input.string, position: input.position } of
+             Left {error, position} ->
+               Parser \_ -> failureError position (Just $ InvalidDomain error)
+             Right {result} -> pure $ login <> "@" <> result

test/Main.purs

@@ -6,10 +6,11 @@ import GenericParser.DomainParserRFC1035 as RFC1035
 import GenericParser.DomainParser as ModernDomains
 import GenericParser.IPAddress (IPv4Error(..))
 import GenericParser.IPAddress as IP
+import GenericParser.EmailAddress as E
 
 import Prelude (Unit, discard, show, ($), (<>))
 import Data.Either (Either(..))
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), maybe)
 import Data.String.CodeUnits (fromCharArray)
 import Effect.Console (log)
 import Effect (Effect, foreachE)
@@ -70,6 +71,19 @@ test_ipv4 ipv4string = do
                Just err -> " -> error: " <> showerror_ipv4 err
              Right { suffix, result } -> "result: " <> result <> " '" <> suffix.string <> "'"
 
+showerror_email :: E.EmailError -> String
+showerror_email E.InvalidCharacter = "InvalidCharacter"
+showerror_email (E.InvalidDomain e) = "invalid domain: " <> maybe "no domain error provided, weird" showerror e
+
+test_email :: String -> Effect Unit
+test_email emailstring = do
+  log $ "(email) parsing '" <> emailstring <> "': "
+        <> case parse E.email { string: emailstring, position: 0 } of
+             Left { position, error } -> "failed at position " <> show position <> case error of
+               Nothing  -> " -> no error reported"
+               Just err -> " -> error: " <> showerror_email err
+             Right { suffix, result } -> "result: " <> result <> " '" <> suffix.string <> "'"
+
 main :: Effect Unit
 main = do
   let domains = [
@@ -114,3 +128,8 @@ main = do
   test_ipv6 "2001:0db8:0000:0000:0000:8a2e:0370:7334:30:1035:3"
   test_ipv6 "2001:0db8:0000:0000:0000:8a2e:0370:7334"
   test_ipv6 "2001:0db8::8a2e:0370:7334"
+
+  log ""
+  test_email "guy@example.com"
+  test_email "guy.name@example.com"
+  test_email "well-look-at-this-domain@.com"