lookahead, IPv6 '::1' shortened representation.

src/GenericParser.purs

@@ -6,4 +6,4 @@ module GenericParser
 
 import GenericParser.DomainParser.Common (DomainError(..), ldh_str, let_dig, let_dig_hyp, max_domain_length, max_label_length, Size)
 import GenericParser.DomainParser (domain, label, subdomain, sub_eof)
-import GenericParser.Parser (alphanum, char, current_input, current_position, digit, eof, Error, failure, failureError, ident, identifier, Input, int, integer, item, letter, lower, many1, nat, natural, parse, parse_last_char, Parser(..), Position, PositionString, Result, rollback, sat, space, string, success, symbol, token, try, tryMaybe, until, upper, Value)
+import GenericParser.Parser (alphanum, char, current_input, current_position, digit, eof, Error, failure, failureError, ident, identifier, Input, int, integer, item, letter, lookahead, lower, many1, nat, natural, parse, parse_last_char, Parser(..), Position, PositionString, Result, rollback, sat, space, string, success, symbol, token, try, tryMaybe, until, upper, Value)

src/GenericParser/EmailAddress.purs

@@ -34,6 +34,7 @@ login_part = do firstchar <- letter
                         _ <- char '@'
                         pure c
 
+-- | `email` is the parser for email addresses.
 email :: Parser EmailError String
 email = do login <- login_part
            _ <- char '@'

src/GenericParser/IPAddress.purs

@@ -1,7 +1,7 @@
 -- | `IPAddress` is a parser for internet protocol addresses (both IPv4 and IPv6).
 module GenericParser.IPAddress where
 
-import Prelude (Ordering(..), compare, (<>), (<), (+), (-), bind, pure, ($), (<<<), (>), show, map)
+import Prelude (Ordering(..), compare, (==), (<>), (<), (+), (-), bind, pure, ($), (<<<), (>), show, map, unit)
 
 import Control.Alt ((<|>))
 import Data.Array as A
@@ -10,8 +10,9 @@ import Data.String.CodeUnits as CU
 
 import GenericParser.Parser (Parser(..)
                             , failureError
-                            , current_position, current_input
-                            , many1, rollback
+                            , current_position
+                            , string
+                            , many1, lookahead
                             , sat, char, nat)
 import GenericParser.BaseFunctions (repeat, isHexaDecimal)
 
@@ -58,18 +59,22 @@ ipv6_full = do chunks <- many1 ipv6_chunk'
 -- | `ipv6_shortened` parses a shortened representation of an IPv6 address.
 ipv6_shortened :: Parser IPv6Error String
 ipv6_shortened =
-  do chunks_part1 <- many1 ipv6_chunk'
-     input <- current_input
-     _ <- char ':'
-     _ <- rollback input
-     chunks_part2 <- many1 ipv6_chunk''
-     let part1 = A.fold (A.intersperse ":" (chunks_part1))
-         part2 = A.fold (A.intersperse ":" (chunks_part2))
-         nb_zero_filling = 8 - (A.length chunks_part1 + A.length chunks_part2)
-         filling = A.fold (A.intersperse ":" $ repeat nb_zero_filling "0000")
+  do chunks_part1 <- A.many ipv6_chunk'
+     _ <- if A.length chunks_part1 == 0
+          then do _ <- lookahead (string "::")
+                  char ':'
+          else do lookahead (char ':')
+     pos <- current_position
+     chunks_part2 <- A.many ipv6_chunk''
+     _ <- if A.length chunks_part2 == 0
+          then do _ <- char ':'
+                  pure unit
+          else pure unit
+     let nb_zero_filling = 8 - (A.length chunks_part1 + A.length chunks_part2)
+         filling = repeat nb_zero_filling "0000"
      if nb_zero_filling < 1
-     then Parser \_ -> failureError input.position (Just IPv6UnrelevantShortRepresentation)
-     else pure $ A.fold (A.intersperse ":" [part1, filling, part2])
+     then Parser \_ -> failureError pos (Just IPv6UnrelevantShortRepresentation)
+     else pure $ A.fold (A.intersperse ":" $ A.concat [chunks_part1, filling, chunks_part2])
 
 -- | TODO: accept IPv6 addresses between brackets ([ipv6]).
 ipv6 :: Parser IPv6Error String
@@ -110,16 +115,15 @@ ipv4_generic4bytes =
 ipv4_shortened :: Parser IPv4Error String
 ipv4_shortened =
   do chunks_part1 <- many1 ipv4_byte'
-     input <- current_input
-     _ <- char '.'
-     _ <- rollback input
+     _ <- lookahead (char '.')
+     pos <- current_position
      chunks_part2 <- many1 ipv4_byte''
      let part1 = A.fold (A.intersperse "." (map show chunks_part1))
          part2 = A.fold (A.intersperse "." (map show chunks_part2))
          nb_zero_filling = 4 - (A.length chunks_part1 + A.length chunks_part2)
          filling = A.fold (A.intersperse "." $ repeat nb_zero_filling "0")
      if nb_zero_filling < 1
-     then Parser \_ -> failureError input.position (Just IPv4UnrelevantShortRepresentation)
+     then Parser \_ -> failureError pos (Just IPv4UnrelevantShortRepresentation)
      else pure $ A.fold (A.intersperse "." [part1, filling, part2])
 
 ipv4 :: Parser IPv4Error String

src/GenericParser/Parser.purs

@@ -218,6 +218,13 @@ many1 p = do first <- p
              rest <- A.many p
              pure $ A.cons first rest
 
+-- | `lookahead` reads an input but doesn't consume it.
+lookahead :: forall e v. Parser e v -> Parser e v
+lookahead p = do input <- current_input
+                 v <- p
+                 _ <- rollback input
+                 pure $ v
+
 -- | `until` parses the input until an ending parser succeed.
 -- | Arguments are the end-parser then the parser to read the input.
 until :: forall e v. Parser e v -> Parser e v -> Parser e (Array v)

test/Main.purs

@@ -127,6 +127,9 @@ main = do
   test_ipv6 "2001: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"