Muse writer: support spans with anchors

This commit is contained in:
Alexander Krotov 2018-03-12 01:40:23 +03:00
parent 9bcd090848
commit 19fd98e452
2 changed files with 12 additions and 4 deletions

View file

@ -424,7 +424,11 @@ inlineToMuse (Note contents) = do
modify $ \st -> st { stNotes = contents:notes }
let ref = show $ length notes + 1
return $ "[" <> text ref <> "]"
inlineToMuse (Span (_,name:_,_) inlines) = do
inlineToMuse (Span (anchor,names,_) inlines) = do
contents <- inlineListToMuse inlines
return $ "<class name=\"" <> text name <> "\">" <> contents <> "</class>"
inlineToMuse (Span _ lst) = inlineListToMuse lst
let anchorDoc = if null anchor
then mempty
else text ('#':anchor) <> space
return $ anchorDoc <> if null names
then contents
else "<class name=\"" <> text (head names) <> "\">" <> contents <> "</class>"

View file

@ -380,8 +380,12 @@ tests = [ testGroup "block elements"
, ""
, "[1] Foo"
]
, "span" =: spanWith ("",["foobar"],[]) (str "Some text")
, "span with class" =: spanWith ("",["foobar"],[]) (text "Some text")
=?> "<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"
[ "emph word before" =:
para (text "foo" <> emph (text "bar")) =?>