Added maths bracketing

This commit is contained in:
Igor Ranieri 2025-09-21 11:00:22 +02:00
parent 9efc312597
commit 7ef411b134
2 changed files with 48 additions and 12 deletions

View file

@ -29,15 +29,16 @@ data Token
| BirdTrack
| BoldOpen
| BoldClose
| BracketOpen
| BracketClose
| EmphasisOpen
| EmphasisClose
| MonospaceOpen
| MonospaceClose
| Newline
| ParenOpen
| ParenClose
| Escape
| MathsParenOpen
| MathsParenClose
| MathsBracketOpen
| MathsBracketClose
| QuoteOpen
| QuoteClose
| Space
@ -57,7 +58,10 @@ lexText = go
toks <-
choice $
Parsec.try
<$> [ newlineToken
<$> [ mathsBracket
, mathsParens
, escape -- maths go before escape to avoid mismatch
, newlineToken
, spaceToken
, quotes
, textElement
@ -85,8 +89,6 @@ textElement =
<$> [ emphasis
, bold
, monospace
, parens
, brackets
, angles
]
@ -110,8 +112,20 @@ 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" <|> Parsec.eof
mathsBracket :: Lexer
mathsBracket = delimited (void $ "\\[") (void "\\]") MathsBracketOpen MathsBracketClose
mathsParens :: Lexer
mathsParens = delimited (void $ "\\(") (void "\\)") MathsParenOpen MathsParenClose
birdTrack :: Lexer
birdTrack = delimitedMaybe (void ">> ") (void "\n" <|> Parsec.eof) BirdTrack Nothing
birdTrack = delimitedMaybe (void ">> ") eol BirdTrack Nothing
escape :: Lexer
escape = delimitedMaybe (void "\\") eol Escape Nothing
quotes :: Lexer
quotes = delimitedSymmetric "\"" QuoteOpen QuoteClose
@ -125,11 +139,11 @@ bold = delimitedSymmetric "__" BoldOpen BoldClose
monospace :: Lexer
monospace = delimitedSymmetric "@" MonospaceOpen MonospaceClose
parens :: Parser [LocatedToken]
parens = delimited "(" ")" ParenOpen ParenClose
-- parens :: Parser [LocatedToken]
-- parens = delimited "(" ")" ParenOpen ParenClose
brackets :: Lexer
brackets = delimited "[" "]" ParenOpen ParenClose
-- brackets :: Lexer
-- brackets = delimited "[" "]" ParenOpen ParenClose
angles :: Parser [LocatedToken]
angles = delimited "<" ">" AngleOpen AngleClose

View file

@ -17,6 +17,8 @@ main = hspec $ do
describe "Lexer" do
describe "minimal" do
it "handles unicode" unicode
it "escapes" escaping
it "maths" maths
it "space chars" space
it "bare string" someString
it "emphasis" emphatic
@ -35,6 +37,26 @@ main = hspec $ do
-- Tests
------------
maths :: IO ()
maths = do
"\\[some math\\]"
`shouldLexTo` [ (1, 1, MathsBracketOpen)
, (1, 2, Token "some math")
, (1, 13, MathsBracketClose)
]
"\\(other maths\\)"
`shouldLexTo` [ (1, 1, MathsParenOpen)
, (1, 2, Token "other maths")
, (1, 15, MathsParenClose)
]
escaping :: Expectation
escaping =
"\\("
`shouldLexTo` [ (1, 1, Escape)
, (1, 2, Token "(")
]
unicode :: Expectation
unicode =
"ドラゴンクエストの冒険者🐉"