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"