forked from elland/haddock2
Embed Anchor content inside token
This commit is contained in:
parent
82e1c76fe7
commit
8887476626
3 changed files with 311 additions and 313 deletions
227
test/Spec.hs
227
test/Spec.hs
|
|
@ -14,28 +14,28 @@ import Text.Parsec.Pos
|
|||
|
||||
main :: IO ()
|
||||
main = hspec $ do
|
||||
describe "Lexer" do
|
||||
describe "minimal" do
|
||||
it "handles unicode" unicode
|
||||
it "escapes" escaping
|
||||
it "maths" maths
|
||||
it "anchors" anchors
|
||||
it "space chars" space
|
||||
it "bare string" someString
|
||||
it "emphasis" emphatic
|
||||
it "monospace" monospace
|
||||
it "labeled link" labeledLink
|
||||
it "markdown link" link
|
||||
it "bird tracks" birdTracks
|
||||
it "module names" modules
|
||||
it "quotes" quotes
|
||||
it "ignores nesting" ignoreNesting
|
||||
describe "Lexer" do
|
||||
describe "minimal" do
|
||||
it "handles unicode" unicode
|
||||
it "escapes" escaping
|
||||
it "maths" maths
|
||||
it "anchors" anchors
|
||||
it "space chars" space
|
||||
it "bare string" someString
|
||||
it "emphasis" emphatic
|
||||
it "monospace" monospace
|
||||
it "labeled link" labeledLink
|
||||
it "markdown link" link
|
||||
it "bird tracks" birdTracks
|
||||
it "module names" modules
|
||||
it "quotes" quotes
|
||||
it "ignores nesting" ignoreNesting
|
||||
|
||||
describe "Parser" do
|
||||
it "Bold" do
|
||||
"__bold__" `shouldParseTo` (DocBold (DocString "bold"))
|
||||
it "Emphasis" do
|
||||
"/emphasis/" `shouldParseTo` (DocEmphasis (DocString "emphasis"))
|
||||
describe "Parser" do
|
||||
it "Bold" do
|
||||
"__bold__" `shouldParseTo` (DocBold (DocString "bold"))
|
||||
it "Emphasis" do
|
||||
"/emphasis/" `shouldParseTo` (DocEmphasis (DocString "emphasis"))
|
||||
|
||||
------------
|
||||
-- Tests
|
||||
|
|
@ -43,134 +43,131 @@ main = hspec $ do
|
|||
|
||||
modules :: Expectation
|
||||
modules = do
|
||||
"\"MyModule.Name\""
|
||||
`shouldLexTo` [ (1, 1, Module)
|
||||
, (1, 2, Token "MyModule.Name")
|
||||
]
|
||||
"\"MyModule.Name\""
|
||||
`shouldLexTo` [ (1, 1, Module)
|
||||
, (1, 2, Token "MyModule.Name")
|
||||
]
|
||||
|
||||
"\"OtherModule.Name#myAnchor\""
|
||||
`shouldLexTo` [ (1, 1, Module)
|
||||
, (1, 2, Token "OtherModule.Name")
|
||||
, (1, 18, Anchor)
|
||||
, (1, 19, Token "myAnchor")
|
||||
]
|
||||
"\"OtherModule.Name#myAnchor\""
|
||||
`shouldLexTo` [ (1, 1, Module)
|
||||
, (1, 2, Token "OtherModule.Name")
|
||||
, (1, 18, Anchor "myAnchor")
|
||||
]
|
||||
|
||||
link :: Expectation
|
||||
link =
|
||||
"[link to](http://some.website)"
|
||||
`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)
|
||||
]
|
||||
"[link to](http://some.website)"
|
||||
`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
|
||||
labeledLink =
|
||||
"<[link here](http://to.here) label>"
|
||||
`shouldLexTo` [ (1, 1, LabeledLinkOpen)
|
||||
, (1, 2, BracketOpen)
|
||||
, (1, 3, Token "link here")
|
||||
, (1, 12, BracketClose)
|
||||
, (1, 13, ParenOpen)
|
||||
, (1, 14, Token "http://to.here")
|
||||
, (1, 28, ParenClose)
|
||||
, (1, 29, Token " label")
|
||||
, (1, 35, LabeledLinkClose)
|
||||
]
|
||||
"<[link here](http://to.here) label>"
|
||||
`shouldLexTo` [ (1, 1, LabeledLinkOpen)
|
||||
, (1, 2, BracketOpen)
|
||||
, (1, 3, Token "link here")
|
||||
, (1, 12, BracketClose)
|
||||
, (1, 13, ParenOpen)
|
||||
, (1, 14, Token "http://to.here")
|
||||
, (1, 28, ParenClose)
|
||||
, (1, 29, Token " label")
|
||||
, (1, 35, LabeledLinkClose)
|
||||
]
|
||||
|
||||
anchors :: Expectation
|
||||
anchors =
|
||||
"#myAnchor#"
|
||||
`shouldLexTo` [ (1, 1, Anchor)
|
||||
, (1, 2, Token "myAnchor")
|
||||
, (1, 10, Anchor)
|
||||
]
|
||||
"#myAnchor#"
|
||||
`shouldLexTo` [ (1, 1, Anchor "myAnchor")
|
||||
]
|
||||
|
||||
maths :: IO ()
|
||||
maths = do
|
||||
"\\[some math\\]"
|
||||
`shouldLexTo` [ (1, 1, MathsBracketOpen)
|
||||
, (1, 3, Token "some math")
|
||||
, (1, 12, MathsBracketClose)
|
||||
]
|
||||
"\\(other maths\\)"
|
||||
`shouldLexTo` [ (1, 1, MathsParenOpen)
|
||||
, (1, 3, Token "other maths")
|
||||
, (1, 14, MathsParenClose)
|
||||
]
|
||||
"\\[some math\\]"
|
||||
`shouldLexTo` [ (1, 1, MathsBracketOpen)
|
||||
, (1, 3, Token "some math")
|
||||
, (1, 12, MathsBracketClose)
|
||||
]
|
||||
"\\(other maths\\)"
|
||||
`shouldLexTo` [ (1, 1, MathsParenOpen)
|
||||
, (1, 3, Token "other maths")
|
||||
, (1, 14, MathsParenClose)
|
||||
]
|
||||
|
||||
escaping :: Expectation
|
||||
escaping =
|
||||
"\\("
|
||||
`shouldLexTo` [ (1, 1, Escape)
|
||||
, (1, 2, Token "(")
|
||||
]
|
||||
"\\("
|
||||
`shouldLexTo` [ (1, 1, Escape)
|
||||
, (1, 2, Token "(")
|
||||
]
|
||||
|
||||
unicode :: Expectation
|
||||
unicode =
|
||||
"ドラゴンクエストの冒険者🐉"
|
||||
`shouldLexTo` [ (1, 1, Token "ドラゴンクエストの冒険者🐉")
|
||||
]
|
||||
"ドラゴンクエストの冒険者🐉"
|
||||
`shouldLexTo` [ (1, 1, Token "ドラゴンクエストの冒険者🐉")
|
||||
]
|
||||
|
||||
ignoreNesting :: Expectation
|
||||
ignoreNesting =
|
||||
">/foo/"
|
||||
`shouldLexTo` [ (1, 1, Token ">/foo/")
|
||||
]
|
||||
">/foo/"
|
||||
`shouldLexTo` [ (1, 1, Token ">/foo/")
|
||||
]
|
||||
|
||||
birdTracks :: Expectation
|
||||
birdTracks =
|
||||
">> code"
|
||||
`shouldLexTo` [ (1, 1, BirdTrack)
|
||||
, (1, 4, Token "code")
|
||||
]
|
||||
">> code"
|
||||
`shouldLexTo` [ (1, 1, BirdTrack)
|
||||
, (1, 4, Token "code")
|
||||
]
|
||||
|
||||
quotes :: Expectation
|
||||
quotes =
|
||||
"\"quoted\""
|
||||
`shouldLexTo` [ (1, 1, QuoteOpen)
|
||||
, (1, 2, Token "quoted")
|
||||
, (1, 8, QuoteClose)
|
||||
]
|
||||
"\"quoted\""
|
||||
`shouldLexTo` [ (1, 1, QuoteOpen)
|
||||
, (1, 2, Token "quoted")
|
||||
, (1, 8, QuoteClose)
|
||||
]
|
||||
|
||||
space :: Expectation
|
||||
space = do
|
||||
"\n "
|
||||
`shouldLexTo` [ (1, 1, Newline)
|
||||
, (2, 1, Space)
|
||||
]
|
||||
" \n"
|
||||
`shouldLexTo` [ (1, 1, Space)
|
||||
, (1, 2, Newline)
|
||||
]
|
||||
"\n "
|
||||
`shouldLexTo` [ (1, 1, Newline)
|
||||
, (2, 1, Space)
|
||||
]
|
||||
" \n"
|
||||
`shouldLexTo` [ (1, 1, Space)
|
||||
, (1, 2, Newline)
|
||||
]
|
||||
|
||||
monospace :: Expectation
|
||||
monospace =
|
||||
"@mono@"
|
||||
`shouldLexTo` [ (1, 1, MonospaceOpen)
|
||||
, (1, 2, Token "mono")
|
||||
, (1, 6, MonospaceClose)
|
||||
]
|
||||
"@mono@"
|
||||
`shouldLexTo` [ (1, 1, MonospaceOpen)
|
||||
, (1, 2, Token "mono")
|
||||
, (1, 6, MonospaceClose)
|
||||
]
|
||||
|
||||
emphatic :: Expectation
|
||||
emphatic =
|
||||
"/emphatic/"
|
||||
`shouldLexTo` [ (1, 1, EmphasisOpen)
|
||||
, (1, 2, Token "emphatic")
|
||||
, (1, 10, EmphasisClose)
|
||||
]
|
||||
"/emphatic/"
|
||||
`shouldLexTo` [ (1, 1, EmphasisOpen)
|
||||
, (1, 2, Token "emphatic")
|
||||
, (1, 10, EmphasisClose)
|
||||
]
|
||||
|
||||
someString :: Expectation
|
||||
someString =
|
||||
"some string"
|
||||
`shouldLexTo` [ (1, 1, Token "some")
|
||||
, (1, 5, Space)
|
||||
, (1, 6, Token "string")
|
||||
]
|
||||
"some string"
|
||||
`shouldLexTo` [ (1, 1, Token "some")
|
||||
, (1, 5, Space)
|
||||
, (1, 6, Token "string")
|
||||
]
|
||||
|
||||
--------------
|
||||
-- Helpers
|
||||
|
|
@ -179,15 +176,15 @@ someString =
|
|||
type Doc id = DocMarkup () id
|
||||
|
||||
instance IsString (Doc String) where
|
||||
fromString = DocString
|
||||
fromString = DocString
|
||||
|
||||
shouldLexTo :: String -> [(Int, Int, Token)] -> Expectation
|
||||
shouldLexTo input expected =
|
||||
case lexer input of
|
||||
Right tokens -> do
|
||||
let actual = map (\(pos, tok) -> (sourceLine pos, sourceColumn pos, tok)) tokens
|
||||
actual `shouldBe` expected
|
||||
Left err -> expectationFailure $ "Parse error: " <> show err
|
||||
case lexer input of
|
||||
Right tokens -> do
|
||||
let actual = map (\(pos, tok) -> (sourceLine pos, sourceColumn pos, tok)) tokens
|
||||
actual `shouldBe` expected
|
||||
Left err -> expectationFailure $ "Parse error: " <> show err
|
||||
|
||||
shouldParseTo :: Text -> DocMarkup mod Identifier -> Expectation
|
||||
shouldParseTo input ast = parseText input `shouldBe` ast
|
||||
|
|
|
|||
|
|
@ -27,8 +27,16 @@ ftp\://example.com
|
|||
|
||||
|
||||
|
||||
\(mathematical expression\)
|
||||
\[mathematical expression\]
|
||||
\(mathematical 1+3 expression\)
|
||||
|
||||
\[mathematical
|
||||
expression
|
||||
accross lines with + addition and such
|
||||
\]
|
||||
|
||||
{
|
||||
e
|
||||
¥
|
||||
|
||||
@
|
||||
code block content
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue