From 43be9e3f7f96f0ab426873c194e690349c3205b2 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Sun, 5 Oct 2025 16:45:04 +0200 Subject: [PATCH] lex: expressions --- src/Lexer.hs | 19 ++++++++++++++++++- test/Spec.hs | 51 +++++++++++++++++++++++++++++++++++++++++++-------- 2 files changed, 61 insertions(+), 9 deletions(-) diff --git a/src/Lexer.hs b/src/Lexer.hs index 9de2255..a43c034 100644 --- a/src/Lexer.hs +++ b/src/Lexer.hs @@ -43,6 +43,8 @@ data Token | Escape | EmphasisOpen | EmphasisClose + | Expression + | ResultLine Text | Header Level | MonospaceOpen | MonospaceClose @@ -102,6 +104,7 @@ lexText = go , textElement , quotes , birdTrack + , expression , other ] rest <- go @@ -164,6 +167,11 @@ delimitedSymmetric s = delimited s s eol :: Parser () eol = void "\n" <|> void "\r\n" <|> Parsec.eof +sol :: Parser () +sol = do + pos <- getPosition + guard $ sourceColumn pos == 1 + header1 :: Lexer header1 = delimitedNoTrailing "= " eol (Header One) @@ -272,7 +280,16 @@ mathInline :: Lexer mathInline = delimited "\\(" "\\)" MathInlineOpen MathInlineClose birdTrack :: Lexer -birdTrack = delimitedNoTrailing ">> " eol BirdTrack +birdTrack = sol *> delimitedNoTrailing ">> " eol BirdTrack + +expression :: Lexer +expression = do + exprs <- sol *> delimitedNoTrailing ">>> " eol Expression + results <- manyTill resultLine endOfResults + pure $ exprs <> results + where + endOfResults = lookAhead $ void newline <|> eof + resultLine = located $ ResultLine <$> (anyUntil eol <* eol) escape :: Lexer escape = delimitedNoTrailing "\\" eol Escape diff --git a/test/Spec.hs b/test/Spec.hs index c75e68a..2794072 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -18,20 +18,23 @@ main = hspec $ do describe "Lexer" do describe "minimal" do it "handles unicode" unicode - it "escapes" escaping + it "emphasis" emphatic + it "bold" bolded + it "monospace" monospace + it "module names" modules + it "labeled link" labeledLink + it "markdown link" link + it "anchors" anchor it "images" images it "maths" math it "numeric entity" numericEntity - it "monospace" monospace it "code blocks" codeBlocks - it "anchors" anchor + it "bird tracks" birdTracks + it "expressions" expressions + + it "escapes" escaping it "space chars" space it "bare string" someString - it "emphasis" emphatic - it "labeled link" labeledLink - it "markdown link" link - it "bird tracks" birdTracks - it "module names" modules it "quotes" quotes it "ignores nesting" ignoreNesting @@ -142,6 +145,30 @@ ignoreNesting = `shouldLexTo` [ (1, 1, Token ">/foo/") ] +expressions :: Expectation +expressions = do + """ + >>> expression + result line 1 + result line 2 + + """ + `shouldLexTo` [ (1, 1, Expression) + , (1, 5, Token "expression") + , (2, 1, ResultLine "result line 1") + , (3, 1, ResultLine "result line 2") + ] + """ + >>> expression + result line 3 + result line 4 + """ + `shouldLexTo` [ (1, 1, Expression) + , (1, 5, Token "expression") + , (2, 1, ResultLine "result line 3") + , (3, 1, ResultLine "result line 4") + ] + birdTracks :: Expectation birdTracks = ">> code" @@ -200,6 +227,14 @@ monospace = , (1, 6, MonospaceClose) ] +bolded :: Expectation +bolded = + "__bold text__" + `shouldLexTo` [ (1, 1, BoldOpen) + , (1, 3, Token "bold text") + , (1, 12, BoldClose) + ] + emphatic :: Expectation emphatic = "/emphatic/"