Add located combinator; improved anchor matches with tests

This commit is contained in:
Igor Ranieri 2025-09-24 10:13:16 +02:00
parent 8887476626
commit 7ae868932d
2 changed files with 18 additions and 9 deletions

View file

@ -175,22 +175,26 @@ anchors = do
where
anchor' = (string "#" <|> string "\\#")
located :: Parser a -> Parser (SourcePos, a)
located p = (,) <$> getPosition <*> p
startPosition :: Parser a -> Parser SourcePos
startPosition = fmap fst . located
-- "Module.Name"
-- "Module.Name#anchor"
-- "Module.Name\#anchor" -- this has been deprecated for 9 years, thanks Ben
modules :: Lexer
modules = do
pos <- getPosition
void $ char '"'
pos' <- getPosition
modName <- modId
startPos <- startPosition $ char '"'
(modPos, modName) <- located modId
anch <- option [] do
pos'' <- getPosition
void $ try (string "#" <|> string "\\#")
a <- Text.pack <$> many (satisfy (\c -> c /= '"' && not (isSpace c)))
pure [(pos'', Anchor a)]
anchPos <- startPosition (string "#" <|> string' "\\#")
txt <- Text.pack <$> many (satisfy (\c -> c /= '"' && not (isSpace c)))
pure [(anchPos, Anchor txt)]
void $ char '"'
pure $ [(pos, Module), (pos', Token modName)] <> anch
pure $ [(startPos, Module), (modPos, Token modName)] <> anch
where
modId = intercalate "." <$> (fmap Text.pack <$> (conId `sepBy1` (char '.')))

View file

@ -54,6 +54,11 @@ modules = do
, (1, 18, Anchor "myAnchor")
]
"\"OtherModule.Name\\#myAnchor\""
`shouldLexTo` [ (1, 1, Module)
, (1, 2, Token "OtherModule.Name")
, (1, 18, Anchor "myAnchor")
]
link :: Expectation
link =
"[link to](http://some.website)"