From 0891c568f645edcac35442576757ab6fcaa7b6ec Mon Sep 17 00:00:00 2001 From: Mateusz Kowalczyk Date: Tue, 4 Nov 2014 21:04:07 +0000 Subject: Fix parsing of identifiers written in infix way --- .../src/Documentation/Haddock/Parser.hs | 23 +++++++++++----------- .../test/Documentation/Haddock/ParserSpec.hs | 6 ++++++ 2 files changed, 18 insertions(+), 11 deletions(-) (limited to 'haddock-library') diff --git a/haddock-library/src/Documentation/Haddock/Parser.hs b/haddock-library/src/Documentation/Haddock/Parser.hs index 99010897..bea1803a 100644 --- a/haddock-library/src/Documentation/Haddock/Parser.hs +++ b/haddock-library/src/Documentation/Haddock/Parser.hs @@ -507,25 +507,26 @@ autoUrl = mkLink <$> url -- deems to be valid in an identifier. Note that it simply blindly consumes -- characters and does no actual validation itself. parseValid :: Parser String -parseValid = do - vs' <- many' $ utf8String "⋆" <|> return <$> idChar - let vs = concat vs' - c <- peekChar - case c of - Just '`' -> return vs - Just '\'' -> (\x -> vs ++ "'" ++ x) <$> ("'" *> parseValid) - <|> return vs - _ -> fail "outofvalid" +parseValid = p some where idChar = satisfy (`elem` "_.!#$%&*+/<=>?@\\|-~:^") <|> digit <|> letter_ascii + p p' = do + vs' <- p' $ utf8String "⋆" <|> return <$> idChar + let vs = concat vs' + c <- peekChar + case c of + Just '`' -> return vs + Just '\'' -> (\x -> vs ++ "'" ++ x) <$> ("'" *> p many') + <|> return vs + _ -> fail "outofvalid" -- | Parses UTF8 strings from ByteString streams. utf8String :: String -> Parser String utf8String x = decodeUtf8 <$> string (encodeUtf8 x) --- | Parses identifiers with help of 'parseValid'. Asks GHC for 'String' from the --- string it deems valid. +-- | Parses identifiers with help of 'parseValid'. Asks GHC for +-- 'String' from the string it deems valid. identifier :: Parser (DocH mod Identifier) identifier = do o <- idDelim diff --git a/haddock-library/test/Documentation/Haddock/ParserSpec.hs b/haddock-library/test/Documentation/Haddock/ParserSpec.hs index a228a956..5550e836 100644 --- a/haddock-library/test/Documentation/Haddock/ParserSpec.hs +++ b/haddock-library/test/Documentation/Haddock/ParserSpec.hs @@ -85,6 +85,12 @@ spec = do " don't use apostrophe's in the wrong place's" `shouldParseTo` "don't use apostrophe's in the wrong place's" + it "doesn't parse empty identifiers" $ do + "``" `shouldParseTo` "``" + + it "can parse infix identifiers" $ do + "``infix``" `shouldParseTo` "`" <> DocIdentifier "infix" <> "`" + context "when parsing URLs" $ do it "parses a URL" $ do "" `shouldParseTo` hyperlink "http://example.com/" Nothing -- cgit v1.2.3