src/Lexer.hs

@@ -56,7 +56,7 @@ data Token
     | MathsBracketOpen
     | MathsBracketClose
     | NumericEntity Int
-    | Module
+    | Module Text
     | QuoteOpen
     | QuoteClose
     | Space
@@ -180,31 +180,31 @@ anchors =
         [ between anchorHash anchorHash (Anchor <$> anyUntil anchorHash)
         ]
 
+
+moduleName :: Parser Text
+moduleName = intercalate "." . fmap Text.pack <$> upperId `sepBy1` char '.'
+
+upperId :: Parser String
+upperId = (:) <$> satisfy isUpper <*> many1 identifierChar
+
+identifierChar :: Parser Char
+identifierChar = satisfy (\c -> isAlphaNum c || c == '_')
+
 -- "Module.Name"
 -- "Module.Name#anchor"
 -- "Module.Name\#anchor" -- this has been deprecated for 9 years, thanks Ben
 modules :: Lexer
-modules = do
-    startPos <- startPosition $ char '"'
-    (modPos, modName) <- located modId
-    anch <- option [] do
-        anchPos <- startPosition (string "#" <|> string' "\\#")
-        txt <- Text.pack <$> many (satisfy (\c -> c /= '"' && not (isSpace c)))
-        pure [(anchPos, Anchor txt)]
-
-    void $ char '"'
-    pure $ [(startPos, Module), (modPos, Token modName)] <> anch
+modules = between (char '"') (char '"') inner
   where
-    modId = intercalate "." <$> (fmap Text.pack <$> (conId `sepBy1` (char '.')))
+    inner = do
+        module_ <- located $ Module <$> moduleName
+        mAnchor <- optionMaybe (located $ anchorHash *> (Anchor <$> anchorText))
+        pure $ case mAnchor of
+            Just anchor -> [module_, anchor]
+            Nothing -> [module_]
 
-    conId :: Parser String
-    conId =
-        (:)
-            <$> satisfy (\c -> isAlpha c && isUpper c)
-            <*> many1 conChar
-
-    conChar :: Parser Char
-    conChar = satisfy (\c -> isAlphaNum c || c == '_')
+    anchorText :: Parser Text
+    anchorText = Text.pack <$> many (satisfy (\c -> c /= '"' && not (isSpace c)))
 
 linkRaw :: Lexer
 linkRaw =

test/Spec.hs

@@ -45,19 +45,16 @@ main = hspec $ do
 modules :: Expectation
 modules = do
     "\"MyModule.Name\""
-        `shouldLexTo` [ (1, 1, Module)
-                      , (1, 2, Token "MyModule.Name")
+        `shouldLexTo` [ (1, 2, Module "MyModule.Name")
                       ]
 
     "\"OtherModule.Name#myAnchor\""
-        `shouldLexTo` [ (1, 1, Module)
-                      , (1, 2, Token "OtherModule.Name")
+        `shouldLexTo` [ (1, 2, Module "OtherModule.Name")
                       , (1, 18, Anchor "myAnchor")
                       ]
 
     "\"OtherModule.Name\\#myAnchor\""
-        `shouldLexTo` [ (1, 1, Module)
-                      , (1, 2, Token "OtherModule.Name")
+        `shouldLexTo` [ (1, 2, Module "OtherModule.Name")
                       , (1, 18, Anchor "myAnchor")
                       ]
 link :: Expectation