Improved bare link parser

src/Lexer.hs

@@ -42,6 +42,8 @@ data Token
   | MonospaceOpen
   | MonospaceClose
   | Newline
+  | LinkOpen
+  | LinkClose
   | LabeledLinkOpen
   | LabeledLinkClose
   | ParenOpen
@@ -159,30 +161,6 @@ header5 = delimitedMaybe (void $ "===== ") eol (Header Five) Nothing
 header6 :: Lexer
 header6 = delimitedMaybe (void $ "====== ") eol (Header Six) Nothing
 
-link :: Lexer
-link = do
-  pos1 <- getPosition
-  void $ string "["
-  pos2 <- getPosition
-  text <- anyUntil $ Text.pack <$> string "]"
-  pos3 <- getPosition
-  void $ "]"
-  pos4 <- getPosition
-  void $ "("
-  pos5 <- getPosition
-  link' <- anyUntil $ Text.pack <$> string ")"
-  pos6 <- getPosition
-  void $ ")"
-
-  pure $
-    [ (pos1, BracketOpen)
-    , (pos2, Token text)
-    , (pos3, BracketClose)
-    , (pos4, ParenOpen)
-    , (pos5, Token link')
-    , (pos6, ParenClose)
-    ]
-
 -- "Module.Name"
 -- "Module.Name#anchor"
 -- "Module.Name#anchor"
@@ -213,11 +191,43 @@ modules = do
   conChar :: Parser Char
   conChar = satisfy (\c -> isAlphaNum c || c == '_')
 
+linkRaw :: Lexer
+linkRaw = do
+  pos1 <- getPosition
+  void $ string "["
+  pos2 <- getPosition
+  text <- anyUntil $ Text.pack <$> string "]"
+  pos3 <- getPosition
+  void $ "]"
+  pos4 <- getPosition
+  void $ "("
+  pos5 <- getPosition
+  link' <- anyUntil $ Text.pack <$> string ")"
+  pos6 <- getPosition
+  void $ ")"
+
+  pure $
+    [ (pos1, BracketOpen)
+    , (pos2, Token text)
+    , (pos3, BracketClose)
+    , (pos4, ParenOpen)
+    , (pos5, Token link')
+    , (pos6, ParenClose)
+    ]
+
+link :: Lexer
+link = do
+  pos <- getPosition
+  l <- linkRaw
+  -- "unconsume" the last token
+  pos' <- flip incSourceColumn (-1) <$> getPosition
+  pure $ (pos, LinkOpen) : l <> [(pos', LinkClose)]
+
 labeledLink :: Lexer
 labeledLink = do
   pos <- getPosition
   void $ string "<"
-  link' <- link
+  link' <- linkRaw
   pos7 <- getPosition
   label' <- anyUntil $ string ">"
   pos8 <- getPosition

test/Spec.hs

@@ -57,12 +57,14 @@ modules = do
 link :: Expectation
 link =
   "[link to](http://some.website)"
-    `shouldLexTo` [ (1, 1, BracketOpen)
+    `shouldLexTo` [ (1, 1, LinkOpen)
+                  , (1, 1, BracketOpen)
                   , (1, 2, Token "link to")
                   , (1, 9, BracketClose)
                   , (1, 10, ParenOpen)
                   , (1, 11, Token "http://some.website")
                   , (1, 30, ParenClose)
+                  , (1, 30, LinkClose)
                   ]
 
 labeledLink :: Expectation