From 20b5ffac3658a9bf564d90c3d64f3c7997666b17 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9ana=20=E6=B1=9F?= Date: Wed, 24 Sep 2025 20:47:55 +0800 Subject: [PATCH] ref(moduleName): break into multiple smaller functions upperId has been changed to only use isUpper because an non alphabetical character would be false anyway --- src/Lexer.hs | 40 ++++++++++++++++++++-------------------- test/Spec.hs | 9 +++------ 2 files changed, 23 insertions(+), 26 deletions(-) diff --git a/src/Lexer.hs b/src/Lexer.hs index d89ad53..89bafc5 100644 --- a/src/Lexer.hs +++ b/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 = diff --git a/test/Spec.hs b/test/Spec.hs index 2545c20..8207b77 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -44,19 +44,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