New IPv4 address parser.

src/GenericParser/IPAddress.purs

@@ -0,0 +1,42 @@
+-- | `IPAddress` is a parser for internet protocol addresses (both IPv4 and IPv6).
+module GenericParser.IPAddress where
+
+import Prelude (bind, pure, ($), (<<<), (>), show, map)
+
+-- import Control.Alt ((<|>))
+-- import Control.Lazy (defer)
+import Data.Array as A
+-- import Data.Either (Either(..))
+import Data.Maybe (Maybe(..))
+-- import Data.String as S
+-- import Data.String.CodeUnits as CU
+
+import GenericParser.Parser (Parser(..)
+                            , failureError
+                            , current_position
+                            , char, nat, eof)
+
+data IPv4Error
+  = NumberTooBig Int
+
+ipv4_byte :: Parser IPv4Error Int
+ipv4_byte = do pos <- current_position
+               number <- nat
+               if number > 255
+               then Parser \_ -> failureError pos ((Just <<< NumberTooBig) number)
+               else pure number
+
+ipv4_generic4bytes :: Parser IPv4Error String
+ipv4_generic4bytes =
+  do b1 <- ipv4_byte
+     _ <- char '.'
+     b2 <- ipv4_byte
+     _ <- char '.'
+     b3 <- ipv4_byte
+     _ <- char '.'
+     b4 <- ipv4_byte
+     _ <- eof
+     pure $ A.fold (A.intersperse "." $ map show [b1,b2,b3,b4])
+
+ipv4 :: Parser IPv4Error String
+ipv4 = ipv4_generic4bytes

src/GenericParser/Parser.purs

@@ -9,6 +9,7 @@ import Data.Array as A
 import Data.Either (Either(..))
 import Data.Int as Int
 import Data.Maybe (Maybe(..))
+import Data.String as S
 import Data.String.CodeUnits (toCharArray, fromCharArray)
 
 import GenericParser.BaseFunctions (concat, isAlpha, isAlphaNum, isDigit, isLower, isSpace, isUpper)
@@ -189,6 +190,11 @@ integer = token int
 symbol :: forall e. String -> Parser e String
 symbol xs = token (string xs)
 
+eof :: forall e. Parser e Unit
+eof = Parser \input -> case S.length input.string of
+  0 -> success input unit
+  _ -> failure input.position
+
 many1 :: forall e v. Parser e v -> Parser e (Array v)
 many1 p = do first <- p
              rest <- A.many p

test/Main.purs

@@ -1,9 +1,11 @@
 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
+import GenericParser.IPAddress (IPv4Error(..))
+import GenericParser.IPAddress as IP
 
 import Prelude (Unit, discard, show, ($), (<>))
 import Data.Either (Either(..))
@@ -19,7 +21,7 @@ logtest fname (Parser p) str r e = do
       Left  { position, error } -> "failed at position " <> show position <> case error of
         Nothing  -> " -> no error reported"
         Just err -> " -> error: " <> e err
-      Right { suffix, result } -> show (r result) <> " '" <> suffix.string <> "'"
+      Right { suffix, result } -> (r result) <> " '" <> suffix.string <> "'"
 
 id :: forall a. a -> a
 id a = a
@@ -30,9 +32,27 @@ showerror (DomainTooLarge size) = "DomainTooLarge (size: " <> show size <> ")"
 showerror (InvalidCharacter)    = "InvalidCharacter"
 showerror (EOFExpected)         = "EOFExpected"
 
-test_series :: forall e v. String -> Parser e v -> (v -> String) -> (e -> String) -> Array String -> Effect Unit
+test_series :: forall e v
+  .  String
+  -> Parser e v
+  -> (v -> String)
+  -> (e -> String)
+  -> Array String
+  -> Effect Unit
 test_series l p v e a = foreachE a (\s -> logtest l p s v e)
 
+showerror_ipv4 :: IP.IPv4Error -> String
+showerror_ipv4 (NumberTooBig x) = "value '" <> show x <> "' is > 255"
+
+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 <> "'"
+
 main :: Effect Unit
 main = do
   let domains = [
@@ -61,3 +81,9 @@ main = do
   test_series "RFC1035.domain" RFC1035.domain id showerror domains
   log ""
   test_series "ModernDomains.domain" ModernDomains.domain id showerror domains
+
+  log ""
+  test_ipv4 "1.2.3.4"
+  test_ipv4 "1..2.3.4"
+  test_ipv4 "1.5.10.255"
+  test_ipv4 "100.200.300.400"