Muse writer: support spans with anchors

2 files changed, 12 insertions, 4 deletions

diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs
index daffa2d07..8a8217d94 100644
--- a/src/Text/Pandoc/Writers/Muse.hs
+++ b/src/Text/Pandoc/Writers/Muse.hs
@@ -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>"
diff --git a/test/Tests/Writers/Muse.hs b/test/Tests/Writers/Muse.hs
index 509c20401..b86dee5e1 100644
--- a/test/Tests/Writers/Muse.hs
+++ b/test/Tests/Writers/Muse.hs
@@ -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")) =?>