Add located combinator; improved anchor matches with tests
This commit is contained in:
parent
8887476626
commit
7ae868932d
2 changed files with 18 additions and 9 deletions
22
src/Lexer.hs
22
src/Lexer.hs
|
|
@ -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 '.')))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue