WIP RFC5234.

src/GenericParser/RFC5234.purs

@@ -2,37 +2,41 @@
 -- | This module implements core rules found in appendix B.1.
 module GenericParser.RFC5234 where
 
-import Prelude (Unit, unit, bind, pure, ($), (<>), (==), (||), between, void)
+import Prelude (Unit, between, bind, 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 (repeat, isHexaDecimal)
+import GenericParser.BaseFunctions (isHexaDecimal)
 
-import GenericParser.Parser (Parser(..)
+import GenericParser.Parser (Parser, char, sat)
-                            , 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           =  %x01-7F
+-- | CHAR (renamed `asciichar` to fix naming conflict with `GenericParser.char`):
---                  ; any 7-bit US-ASCII character,
+-- | any 7-bit US-ASCII character, excluding NUL.
---                  ;  excluding NUL
+-- |
---
+-- | CHAR           =  %x01-7F
---CR             =  %x0D
+asciichar :: forall e. Parser e Char
---                  ; carriage return
+asciichar = sat (\x -> between 1 127 $ C.toCharCode x)
---
+
---CRLF           =  CR LF
+-- | CR: carriage return.
---                  ; Internet standard newline
+-- |
---
+-- | 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'
+
 --CTL            =  %x00-1F / %x7F
 --                  ; controls
 --
@@ -87,9 +91,3 @@ 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(..), parse)
+import GenericParser.Parser (Parser(..))
 import GenericParser.DomainParser.Common (ldh_str, DomainError(..))
 import GenericParser.DomainParserRFC1035 as RFC1035
 import GenericParser.DomainParser as ModernDomains
@@ -49,41 +49,14 @@ 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 = [
@@ -114,30 +87,36 @@ main = do
   test_series "ModernDomains.domain" ModernDomains.domain id showerror domains
 
   log ""
-  test_ipv4 "10..1."
+  let ipv4_addresses = [ "10..1."
-  test_ipv4 "10..1"
+                       , "10..1"
-  test_ipv4 "1..2"
+                       , "1..2"
-  test_ipv4 "1.2.3.4"
+                       , "1.2.3.4"
-  test_ipv4 "192.168..1"
+                       , "192.168..1"
-  test_ipv4 "1..2.3.4"
+                       , "1..2.3.4"
-  test_ipv4 "1.5.10.255"
+                       , "1.5.10.255"
-  test_ipv4 "100.200.300.400"
+                       , "100.200.300.400"
+                       ]
+  test_series "IP.ipv4" IP.ipv4 id showerror_ipv4 ipv4_addresses
 
   log ""
-  test_ipv6 "2001:0"
+  let ipv6_addresses = [ "2001:0"
-  test_ipv6 "2001::x:0"
+                       , "2001::x:0"
-  test_ipv6 "2001:x::0"
+                       , "2001:x::0"
-  test_ipv6 "2001::0"
+                       , "2001::0"
-  test_ipv6 "2001::1:"
+                       , "2001::1:"
-  test_ipv6 "::"
+                       , "::"
-  test_ipv6 "2001::"
+                       , "2001::"
-  test_ipv6 "::1"
+                       , "::1"
-  test_ipv6 "2001:0db8:0000:0000:0000:8a2e:0370:7334:30:1035:3"
+                       , "2001:0db8:0000:0000:0000:8a2e:0370:7334:30:1035:3"
-  test_ipv6 "2001:0db8:0000:0000:0000:8a2e:0370:7334"
+                       , "2001:0db8:0000:0000:0000:8a2e:0370:7334"
-  test_ipv6 "2001:0db8::8a2e:0370:7334"
+                       , "2001:0db8::8a2e:0370:7334"
+                       ]
+  test_series "IP.ipv6" IP.ipv6 id showerror_ipv6 ipv6_addresses
 
   log ""
-  test_email "guy@example.com"
+  let email_addresses = [ "guy@example.com"
-  test_email "guy.name@example.com"
+                        , "guy.name@example.com"
-  test_email "well-look-at-this-domain@.com"
+                        , "well-look-at-this-domain@.com"
-  test_email "guy-@example.com"
+                        , "guy-@example.com"
+                        ]
+  test_series "E.email" E.email id showerror_email email_addresses