diff --git a/src/Lexer.hs b/src/Lexer.hs index a4b00bb..e12324b 100644 --- a/src/Lexer.hs +++ b/src/Lexer.hs @@ -16,7 +16,6 @@ import Text.Parsec import Text.Parsec qualified as Parsec import Text.Parsec.Pos (updatePosChar) -type Located a = (SourcePos, a) type LocatedToken = (SourcePos, Token) type Lexer = Parser [LocatedToken] @@ -126,49 +125,52 @@ headers = , header6 ] +delimitedMaybe :: Parser a -> Parser a -> Token -> Maybe Token -> Parser [LocatedToken] +delimitedMaybe openMark closeMark openToken closeToken = do + openPos <- getPosition + void openMark + tokenPos <- getPosition + content <- anyUntil closeMark + closePos <- getPosition + void closeMark + + let openTok :: LocatedToken = (openPos, openToken) + res :: LocatedToken = (tokenPos, Token content) + closeToks :: [LocatedToken] = case closeToken of + Just close -> [(closePos, close)] + Nothing -> [] + + pure $ [openTok, res] <> closeToks + anyUntil :: Parser a -> Parser Text anyUntil p = Text.pack <$> manyTill anyChar (lookAhead p) -delimitedAsTuple :: Parser open -> Parser close -> Parser (Located open, LocatedToken, Located close) -delimitedAsTuple openP closeP = - (,,) - <$> located openP - <*> located (Token <$> anyUntil closeP) - <*> located closeP - -delimited :: Parser a -> Parser b -> Token -> Token -> Parser [LocatedToken] -delimited openP closeP openTok closeTok = fuse <$> delimitedAsTuple (openTok <$ openP) (closeTok <$ closeP) - where - fuse (a, tok, b) = [a, tok, b] - -delimitedNoTrailing :: Parser a -> Parser b -> Token -> Parser [LocatedToken] -delimitedNoTrailing openP closeP openTok = fuse <$> delimitedAsTuple (openTok <$ openP) (void closeP) - where - fuse (a, tok, _) = [a, tok] +delimited :: Parser a -> Parser a -> Token -> Token -> Parser [LocatedToken] +delimited a b c d = delimitedMaybe a b c (Just d) delimitedSymmetric :: Parser a -> Token -> Token -> Parser [LocatedToken] delimitedSymmetric s t1 t2 = delimited s s t1 t2 eol :: Parser () -eol = void "\n" <|> void "\r\n" <|> Parsec.eof +eol = void "\n" <|> Parsec.eof header1 :: Lexer -header1 = delimitedNoTrailing "= " eol (Header One) +header1 = delimitedMaybe (void $ "= ") eol (Header One) Nothing header2 :: Lexer -header2 = delimitedNoTrailing "== " eol (Header Two) +header2 = delimitedMaybe (void $ "== ") eol (Header Two) Nothing header3 :: Lexer -header3 = delimitedNoTrailing "=== " eol (Header Three) +header3 = delimitedMaybe (void $ "=== ") eol (Header Three) Nothing header4 :: Lexer -header4 = delimitedNoTrailing "==== " eol (Header Four) +header4 = delimitedMaybe (void $ "==== ") eol (Header Four) Nothing header5 :: Lexer -header5 = delimitedNoTrailing "===== " eol (Header Five) +header5 = delimitedMaybe (void $ "===== ") eol (Header Five) Nothing header6 :: Lexer -header6 = delimitedNoTrailing "====== " eol (Header Six) +header6 = delimitedMaybe (void $ "====== ") eol (Header Six) Nothing -- #anchors# anchors :: Lexer @@ -245,16 +247,16 @@ labeledLink = do ] mathsBracket :: Lexer -mathsBracket = delimited "\\[" "\\]" MathsBracketOpen MathsBracketClose +mathsBracket = delimited (void $ "\\[") (void "\\]") MathsBracketOpen MathsBracketClose mathsParens :: Lexer -mathsParens = delimited "\\(" "\\)" MathsParenOpen MathsParenClose +mathsParens = delimited (void $ "\\(") (void "\\)") MathsParenOpen MathsParenClose birdTrack :: Lexer -birdTrack = delimitedNoTrailing ">> " eol BirdTrack +birdTrack = delimitedMaybe (void ">> ") eol BirdTrack Nothing escape :: Lexer -escape = delimitedNoTrailing "\\" eol Escape +escape = delimitedMaybe (void "\\") eol Escape Nothing quotes :: Lexer quotes = delimitedSymmetric "\"" QuoteOpen QuoteClose diff --git a/test/Spec.hs b/test/Spec.hs index 2545c20..d202ac2 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -106,15 +106,11 @@ maths = do ] escaping :: Expectation -escaping = do +escaping = "\\(" `shouldLexTo` [ (1, 1, Escape) , (1, 2, Token "(") ] - "\\(\r\n" - `shouldLexTo` [ (1, 1, Escape) - , (1, 2, Token "(") - ] unicode :: Expectation unicode =