forked from elland/haddock2
ref(lexer): simplify delimited logic
This commit is contained in:
parent
fdb9070e99
commit
d6087ec3d6
1 changed files with 27 additions and 29 deletions
56
src/Lexer.hs
56
src/Lexer.hs
|
|
@ -16,6 +16,7 @@ import Text.Parsec
|
||||||
import Text.Parsec qualified as Parsec
|
import Text.Parsec qualified as Parsec
|
||||||
import Text.Parsec.Pos (updatePosChar)
|
import Text.Parsec.Pos (updatePosChar)
|
||||||
|
|
||||||
|
type Located a = (SourcePos, a)
|
||||||
type LocatedToken = (SourcePos, Token)
|
type LocatedToken = (SourcePos, Token)
|
||||||
|
|
||||||
type Lexer = Parser [LocatedToken]
|
type Lexer = Parser [LocatedToken]
|
||||||
|
|
@ -125,28 +126,25 @@ headers =
|
||||||
, header6
|
, 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 :: Parser a -> Parser Text
|
||||||
anyUntil p = Text.pack <$> manyTill anyChar (lookAhead p)
|
anyUntil p = Text.pack <$> manyTill anyChar (lookAhead p)
|
||||||
|
|
||||||
delimited :: Parser a -> Parser a -> Token -> Token -> Parser [LocatedToken]
|
delimitedAsTuple :: Parser open -> Parser close -> Parser (Located open, LocatedToken, Located close)
|
||||||
delimited a b c d = delimitedMaybe a b c (Just d)
|
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 = asList <$> delimitedAsTuple (openTok <$ openP) (closeTok <$ closeP)
|
||||||
|
where
|
||||||
|
asList (a, tok, b) = [a, tok, b]
|
||||||
|
|
||||||
|
delimitedNoTrailing :: Parser a -> Parser b -> Token -> Parser [LocatedToken]
|
||||||
|
delimitedNoTrailing openP closeP openTok = asList <$> delimitedAsTuple (openTok <$ openP) (void closeP)
|
||||||
|
where
|
||||||
|
asList (a, tok, _) = [a, tok]
|
||||||
|
|
||||||
delimitedSymmetric :: Parser a -> Token -> Token -> Parser [LocatedToken]
|
delimitedSymmetric :: Parser a -> Token -> Token -> Parser [LocatedToken]
|
||||||
delimitedSymmetric s t1 t2 = delimited s s t1 t2
|
delimitedSymmetric s t1 t2 = delimited s s t1 t2
|
||||||
|
|
@ -155,22 +153,22 @@ eol :: Parser ()
|
||||||
eol = void "\n" <|> void "\r\n" <|> Parsec.eof
|
eol = void "\n" <|> void "\r\n" <|> Parsec.eof
|
||||||
|
|
||||||
header1 :: Lexer
|
header1 :: Lexer
|
||||||
header1 = delimitedMaybe (void $ "= ") eol (Header One) Nothing
|
header1 = delimitedNoTrailing "= " eol (Header One)
|
||||||
|
|
||||||
header2 :: Lexer
|
header2 :: Lexer
|
||||||
header2 = delimitedMaybe (void $ "== ") eol (Header Two) Nothing
|
header2 = delimitedNoTrailing "== " eol (Header Two)
|
||||||
|
|
||||||
header3 :: Lexer
|
header3 :: Lexer
|
||||||
header3 = delimitedMaybe (void $ "=== ") eol (Header Three) Nothing
|
header3 = delimitedNoTrailing "=== " eol (Header Three)
|
||||||
|
|
||||||
header4 :: Lexer
|
header4 :: Lexer
|
||||||
header4 = delimitedMaybe (void $ "==== ") eol (Header Four) Nothing
|
header4 = delimitedNoTrailing "==== " eol (Header Four)
|
||||||
|
|
||||||
header5 :: Lexer
|
header5 :: Lexer
|
||||||
header5 = delimitedMaybe (void $ "===== ") eol (Header Five) Nothing
|
header5 = delimitedNoTrailing "===== " eol (Header Five)
|
||||||
|
|
||||||
header6 :: Lexer
|
header6 :: Lexer
|
||||||
header6 = delimitedMaybe (void $ "====== ") eol (Header Six) Nothing
|
header6 = delimitedNoTrailing "====== " eol (Header Six)
|
||||||
|
|
||||||
-- #anchors#
|
-- #anchors#
|
||||||
anchors :: Lexer
|
anchors :: Lexer
|
||||||
|
|
@ -247,16 +245,16 @@ labeledLink = do
|
||||||
]
|
]
|
||||||
|
|
||||||
mathsBracket :: Lexer
|
mathsBracket :: Lexer
|
||||||
mathsBracket = delimited (void $ "\\[") (void "\\]") MathsBracketOpen MathsBracketClose
|
mathsBracket = delimited "\\[" "\\]" MathsBracketOpen MathsBracketClose
|
||||||
|
|
||||||
mathsParens :: Lexer
|
mathsParens :: Lexer
|
||||||
mathsParens = delimited (void $ "\\(") (void "\\)") MathsParenOpen MathsParenClose
|
mathsParens = delimited "\\(" "\\)" MathsParenOpen MathsParenClose
|
||||||
|
|
||||||
birdTrack :: Lexer
|
birdTrack :: Lexer
|
||||||
birdTrack = delimitedMaybe (void ">> ") eol BirdTrack Nothing
|
birdTrack = delimitedNoTrailing ">> " eol BirdTrack
|
||||||
|
|
||||||
escape :: Lexer
|
escape :: Lexer
|
||||||
escape = delimitedMaybe (void "\\") eol Escape Nothing
|
escape = delimitedNoTrailing "\\" eol Escape
|
||||||
|
|
||||||
quotes :: Lexer
|
quotes :: Lexer
|
||||||
quotes = delimitedSymmetric "\"" QuoteOpen QuoteClose
|
quotes = delimitedSymmetric "\"" QuoteOpen QuoteClose
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue