lex: expressions

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

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/"