primrose/haddock2
1
0
Fork 0
forked from elland/haddock2
Code Pull requests Activity

Embed Anchor content inside token

Browse source
This commit is contained in:
Igor Ranieri 2025-09-24 09:48:01 +02:00
parent 82e1c76fe7
commit 8887476626
3 changed files with 311 additions and 313 deletions
Download patch file Download diff file Expand all files Collapse all files

15
src/Lexer.hs
View file

@ -31,7 +31,7 @@ data Level
data Token data Token
= Token Text = Token Text
| Anchor | Anchor Text
| BirdTrack | BirdTrack
| BoldOpen | BoldOpen
| BoldClose | BoldClose
@ -54,6 +54,7 @@ data Token
| MathsParenClose | MathsParenClose
| MathsBracketOpen | MathsBracketOpen
| MathsBracketClose | MathsBracketClose
| NumericEntity Int
| Module | Module
| QuoteOpen | QuoteOpen
| QuoteClose | QuoteClose
@ -167,22 +168,15 @@ anchors :: Lexer
anchors = do anchors = do
pos <- getPosition pos <- getPosition
void $ try anchor' void $ try anchor'
pos' <- getPosition
txt <- anyUntil anchor' txt <- anyUntil anchor'
pos'' <- getPosition
void $ try anchor' void $ try anchor'
pure pure [(pos, Anchor txt)]
[ (pos, Anchor)
, (pos', Token txt)
, (pos'', Anchor)
]
where where
anchor' = (string "#" <|> string "\\#") anchor' = (string "#" <|> string "\\#")
-- "Module.Name" -- "Module.Name"
-- "Module.Name#anchor" -- "Module.Name#anchor"
-- "Module.Name#anchor"
modules :: Lexer modules :: Lexer
modules = do modules = do
pos <- getPosition pos <- getPosition
@ -192,9 +186,8 @@ modules = do
anch <- option [] do anch <- option [] do
pos'' <- getPosition pos'' <- getPosition
void $ try (string "#" <|> string "\\#") void $ try (string "#" <|> string "\\#")
pos''' <- getPosition
a <- Text.pack <$> many (satisfy (\c -> c /= '"' && not (isSpace c))) a <- Text.pack <$> many (satisfy (\c -> c /= '"' && not (isSpace c)))
pure [(pos'', Anchor), (pos''', Token a)] pure [(pos'', Anchor a)]
void $ char '"' void $ char '"'
pure $ [(pos, Module), (pos', Token modName)] <> anch pure $ [(pos, Module), (pos', Token modName)] <> anch

7
test/Spec.hs
View file

@ -51,8 +51,7 @@ modules = do
"\"OtherModule.Name#myAnchor\"" "\"OtherModule.Name#myAnchor\""
`shouldLexTo` [ (1, 1, Module) `shouldLexTo` [ (1, 1, Module)
, (1, 2, Token "OtherModule.Name") , (1, 2, Token "OtherModule.Name")
, (1, 18, Anchor) , (1, 18, Anchor "myAnchor")
, (1, 19, Token "myAnchor")
] ]
link :: Expectation link :: Expectation
@ -85,9 +84,7 @@ labeledLink =
anchors :: Expectation anchors :: Expectation
anchors = anchors =
"#myAnchor#" "#myAnchor#"
`shouldLexTo` [ (1, 1, Anchor) `shouldLexTo` [ (1, 1, Anchor "myAnchor")
, (1, 2, Token "myAnchor")
, (1, 10, Anchor)
] ]
maths :: IO () maths :: IO ()

12
test/markup.md
View file

@ -27,8 +27,16 @@ ftp\://example.com
![alt text](image.png) ![alt text](image.png)
\(mathematical expression\) \(mathematical 1+3 expression\)
\[mathematical expression\]
\[mathematical
expression
accross lines with + addition and such
\]
&#123
&#x65
&#165
@ @
code block content code block content