primrose/haddock2
1
0
Fork 0
forked from elland/haddock2
Code Pull requests Activity

Check delimiters by hand to keep accurate source pos

Browse source
This commit is contained in:
Igor Ranieri 2025-09-21 12:34:30 +02:00
parent 7ef411b134
commit 4ef8d2c28c
2 changed files with 15 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

15
src/Lexer.hs
View file

@ -11,6 +11,7 @@ import Data.Char (isAlphaNum, isPrint)
import Data.Functor (($>)) import Data.Functor (($>))
import Data.Text (Text) import Data.Text (Text)
import Data.Text qualified as Text import Data.Text qualified as Text
import Debug.Trace (traceM)
import GHC.Stack (HasCallStack) import GHC.Stack (HasCallStack)
import ParserMonad (Parser, initialParserState) import ParserMonad (Parser, initialParserState)
import Text.Parsec import Text.Parsec
@ -94,12 +95,16 @@ textElement =
delimitedMaybe :: Parser a -> Parser a -> Token -> Maybe Token -> Parser [LocatedToken] delimitedMaybe :: Parser a -> Parser a -> Token -> Maybe Token -> Parser [LocatedToken]
delimitedMaybe op cl ot ct = do delimitedMaybe op cl ot ct = do
pos <- getPosition openPos <- getPosition
(text, content) <- match $ between op cl any' void op -- opening
let openTok :: LocatedToken = (setSourceColumn pos 1, ot) tokenPos <- getPosition
res :: LocatedToken = (setSourceColumn pos 2, Token content) content <- any'
closePos <- getPosition
void cl
let openTok :: LocatedToken = (openPos, ot)
res :: LocatedToken = (tokenPos, Token content)
closeToks :: [LocatedToken] = case ct of closeToks :: [LocatedToken] = case ct of
Just close -> [(setSourceColumn pos (Text.length text), close)] Just close -> [(closePos, close)]
Nothing -> [] Nothing -> []
pure $ [openTok, res] <> closeToks pure $ [openTok, res] <> closeToks

10
test/Spec.hs
View file

@ -41,13 +41,13 @@ maths :: IO ()
maths = do maths = do
"\\[some math\\]" "\\[some math\\]"
`shouldLexTo` [ (1, 1, MathsBracketOpen) `shouldLexTo` [ (1, 1, MathsBracketOpen)
, (1, 2, Token "some math") , (1, 3, Token "some math")
, (1, 13, MathsBracketClose) , (1, 12, MathsBracketClose)
] ]
"\\(other maths\\)" "\\(other maths\\)"
`shouldLexTo` [ (1, 1, MathsParenOpen) `shouldLexTo` [ (1, 1, MathsParenOpen)
, (1, 2, Token "other maths") , (1, 3, Token "other maths")
, (1, 15, MathsParenClose) , (1, 14, MathsParenClose)
] ]
escaping :: Expectation escaping :: Expectation
@ -74,7 +74,7 @@ birdTracks :: Expectation
birdTracks = birdTracks =
">> code" ">> code"
`shouldLexTo` [ (1, 1, BirdTrack) `shouldLexTo` [ (1, 1, BirdTrack)
, (1, 2, Token "code") , (1, 4, Token "code")
] ]
quotes :: Expectation quotes :: Expectation