src/GenericParser/RFC5234.purs

@@ -2,41 +2,37 @@
 -- | This module implements core rules found in appendix B.1.
 module GenericParser.RFC5234 where
 
-import Prelude (Unit, between, bind, void, ($))
+import Prelude (Unit, unit, bind, pure, ($), (<>), (==), (||), between, void)
 
 import Control.Alt ((<|>))
+import Data.Array as A
 import Data.Char as C
+import Data.Either (Either(..))
+import Data.Maybe (Maybe(..))
+import Data.String.CodeUnits as CU
 
-import GenericParser.BaseFunctions (isHexaDecimal)
+import GenericParser.BaseFunctions (repeat, isHexaDecimal)
 
-import GenericParser.Parser (Parser, char, sat)
+import GenericParser.Parser (Parser(..)
+                            , sat, char , digit , letter, item, many1, tryMaybe
+                            , current_input, failureError, parse, rollback, until)
 
 -- | RFC 5234:
 
 --ALPHA          =  %x41-5A / %x61-7A   ; A-Z / a-z
-
+--
 --BIT            =  "0" / "1"
-
--- | CHAR (renamed `asciichar` to fix naming conflict with `GenericParser.char`):
--- | any 7-bit US-ASCII character, excluding NUL.
--- |
--- | CHAR           =  %x01-7F
-asciichar :: forall e. Parser e Char
-asciichar = sat (\x -> between 1 127 $ C.toCharCode x)
-
--- | CR: carriage return.
--- |
--- | CR             =  %x0D
-cr :: forall e. Parser e Unit
-cr = void $ char '\r'
-
--- | CRLF: Internet standard newline.
--- |
--- | CRLF           =  CR LF
-crlf :: forall e. Parser e Unit
-crlf = do _ <- char '\r'
-          void $ char '\n'
-
+--
+--CHAR           =  %x01-7F
+--                  ; any 7-bit US-ASCII character,
+--                  ;  excluding NUL
+--
+--CR             =  %x0D
+--                  ; carriage return
+--
+--CRLF           =  CR LF
+--                  ; Internet standard newline
+--
 --CTL            =  %x00-1F / %x7F
 --                  ; controls
 --
@@ -91,3 +87,9 @@ vchar = sat (\x -> between 33 126 $ C.toCharCode x)
 -- | WSP            =  SP / HTAB
 wsp :: forall e. Parser e Char
 wsp = sp <|> htab
+
+
+crlf :: forall e. Parser e Unit
+crlf = do _ <- char '\r'
+          _ <- char '\n'
+          pure unit

test/Main.purs

@@ -1,6 +1,6 @@
 module Test.Main where
 
-import GenericParser.Parser (Parser(..))
+import GenericParser.Parser (Parser(..), parse)
 import GenericParser.DomainParser.Common (ldh_str, DomainError(..))
 import GenericParser.DomainParserRFC1035 as RFC1035
 import GenericParser.DomainParser as ModernDomains
@@ -49,14 +49,41 @@ showerror_ipv6 (IP.NotEnoughChunks)                 = "NotEnoughChunks"
 showerror_ipv6 (IP.TooManyChunks)                   = "TooManyChunks"
 showerror_ipv6 IP.IPv6UnrelevantShortRepresentation = "useless double dots"
 
+test_ipv6 :: String -> Effect Unit
+test_ipv6 ipv6string = do
+  log $ "(ipv6) parsing '" <> ipv6string <> "': "
+        <> case parse IP.ipv6 { string: ipv6string, position: 0 } of
+             Left { position, error } -> "failed at position " <> show position <> case error of
+               Nothing  -> " -> no error reported"
+               Just err -> " -> error: " <> showerror_ipv6 err
+             Right { suffix, result } -> "result: " <> result <> " '" <> suffix.string <> "'"
+
 showerror_ipv4 :: IP.IPv4Error -> String
 showerror_ipv4 (NumberTooBig x) = "value '" <> show x <> "' is > 255"
 showerror_ipv4 IPv4UnrelevantShortRepresentation = "useless double dots"
 
+test_ipv4 :: String -> Effect Unit
+test_ipv4 ipv4string = do
+  log $ "(ipv4) parsing '" <> ipv4string <> "': "
+        <> case parse IP.ipv4 { string: ipv4string, position: 0 } of
+             Left { position, error } -> "failed at position " <> show position <> case error of
+               Nothing  -> " -> no error reported"
+               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 = [
@@ -87,36 +114,30 @@ main = do
   test_series "ModernDomains.domain" ModernDomains.domain id showerror domains
 
   log ""
-  let ipv4_addresses = [ "10..1."
-                       , "10..1"
-                       , "1..2"
-                       , "1.2.3.4"
-                       , "192.168..1"
-                       , "1..2.3.4"
-                       , "1.5.10.255"
-                       , "100.200.300.400"
-                       ]
-  test_series "IP.ipv4" IP.ipv4 id showerror_ipv4 ipv4_addresses
+  test_ipv4 "10..1."
+  test_ipv4 "10..1"
+  test_ipv4 "1..2"
+  test_ipv4 "1.2.3.4"
+  test_ipv4 "192.168..1"
+  test_ipv4 "1..2.3.4"
+  test_ipv4 "1.5.10.255"
+  test_ipv4 "100.200.300.400"
 
   log ""
-  let ipv6_addresses = [ "2001:0"
-                       , "2001::x:0"
-                       , "2001:x::0"
-                       , "2001::0"
-                       , "2001::1:"
-                       , "::"
-                       , "2001::"
-                       , "::1"
-                       , "2001:0db8:0000:0000:0000:8a2e:0370:7334:30:1035:3"
-                       , "2001:0db8:0000:0000:0000:8a2e:0370:7334"
-                       , "2001:0db8::8a2e:0370:7334"
-                       ]
-  test_series "IP.ipv6" IP.ipv6 id showerror_ipv6 ipv6_addresses
+  test_ipv6 "2001:0"
+  test_ipv6 "2001::x:0"
+  test_ipv6 "2001:x::0"
+  test_ipv6 "2001::0"
+  test_ipv6 "2001::1:"
+  test_ipv6 "::"
+  test_ipv6 "2001::"
+  test_ipv6 "::1"
+  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 ""
-  let email_addresses = [ "guy@example.com"
-                        , "guy.name@example.com"
-                        , "well-look-at-this-domain@.com"
-                        , "guy-@example.com"
-                        ]
-  test_series "E.email" E.email id showerror_email email_addresses
+  test_email "guy@example.com"
+  test_email "guy.name@example.com"
+  test_email "well-look-at-this-domain@.com"
+  test_email "guy-@example.com"