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

View file

@ -17,6 +17,8 @@ main = hspec $ do
describe "Lexer" do describe "Lexer" do
describe "minimal" do describe "minimal" do
it "handles unicode" unicode it "handles unicode" unicode
it "escapes" escaping
it "maths" maths
it "space chars" space it "space chars" space
it "bare string" someString it "bare string" someString
it "emphasis" emphatic it "emphasis" emphatic
@ -35,6 +37,26 @@ main = hspec $ do
-- Tests -- 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 :: Expectation
unicode = unicode =
"ドラゴンクエストの冒険者🐉" "ドラゴンクエストの冒険者🐉"