diff --git a/src/GenericParser.purs b/src/GenericParser.purs
index 6cebe7a..cc1749d 100644
--- a/src/GenericParser.purs
+++ b/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)
diff --git a/src/GenericParser/EmailAddress.purs b/src/GenericParser/EmailAddress.purs
index a16c520..d35190a 100644
--- a/src/GenericParser/EmailAddress.purs
+++ b/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 '@'
diff --git a/src/GenericParser/IPAddress.purs b/src/GenericParser/IPAddress.purs
index e2ba103..b6ecfa7 100644
--- a/src/GenericParser/IPAddress.purs
+++ b/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
diff --git a/src/GenericParser/Parser.purs b/src/GenericParser/Parser.purs
index 37773c3..a088644 100644
--- a/src/GenericParser/Parser.purs
+++ b/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)
diff --git a/test/Main.purs b/test/Main.purs
index c242003..9a0d8d2 100644
--- a/test/Main.purs
+++ b/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"