Muse writer: support spans with anchors
This commit is contained in:
parent
9bcd090848
commit
19fd98e452
2 changed files with 12 additions and 4 deletions
|
@ -424,7 +424,11 @@ inlineToMuse (Note contents) = do
|
||||||
modify $ \st -> st { stNotes = contents:notes }
|
modify $ \st -> st { stNotes = contents:notes }
|
||||||
let ref = show $ length notes + 1
|
let ref = show $ length notes + 1
|
||||||
return $ "[" <> text ref <> "]"
|
return $ "[" <> text ref <> "]"
|
||||||
inlineToMuse (Span (_,name:_,_) inlines) = do
|
inlineToMuse (Span (anchor,names,_) inlines) = do
|
||||||
contents <- inlineListToMuse inlines
|
contents <- inlineListToMuse inlines
|
||||||
return $ "<class name=\"" <> text name <> "\">" <> contents <> "</class>"
|
let anchorDoc = if null anchor
|
||||||
inlineToMuse (Span _ lst) = inlineListToMuse lst
|
then mempty
|
||||||
|
else text ('#':anchor) <> space
|
||||||
|
return $ anchorDoc <> if null names
|
||||||
|
then contents
|
||||||
|
else "<class name=\"" <> text (head names) <> "\">" <> contents <> "</class>"
|
||||||
|
|
|
@ -380,8 +380,12 @@ tests = [ testGroup "block elements"
|
||||||
, ""
|
, ""
|
||||||
, "[1] Foo"
|
, "[1] Foo"
|
||||||
]
|
]
|
||||||
, "span" =: spanWith ("",["foobar"],[]) (str "Some text")
|
, "span with class" =: spanWith ("",["foobar"],[]) (text "Some text")
|
||||||
=?> "<class name=\"foobar\">Some text</class>"
|
=?> "<class name=\"foobar\">Some text</class>"
|
||||||
|
, "span with anchor" =: spanWith ("anchor", [], []) (text "Foo bar")
|
||||||
|
=?> "#anchor Foo bar"
|
||||||
|
, "span with class and anchor" =: spanWith ("anchor", ["foo"], []) (text "bar")
|
||||||
|
=?> "#anchor <class name=\"foo\">bar</class>"
|
||||||
, testGroup "combined"
|
, testGroup "combined"
|
||||||
[ "emph word before" =:
|
[ "emph word before" =:
|
||||||
para (text "foo" <> emph (text "bar")) =?>
|
para (text "foo" <> emph (text "bar")) =?>
|
||||||
|
|
Loading…
Add table
Reference in a new issue