Muse writer: replace smallcaps with emphasis before normalization

src/Text/Pandoc/Writers/Muse.hs

@@ -305,6 +305,10 @@ preprocessInlineList (Cite _  lst:xs) = (lst ++) <$> preprocessInlineList xs
 preprocessInlineList (x:xs) = (x:) <$> preprocessInlineList xs
 preprocessInlineList [] = return []
 
+replaceSmallCaps :: Inline -> Inline
+replaceSmallCaps (SmallCaps lst) = Emph lst
+replaceSmallCaps x = x
+
 normalizeInlineList :: [Inline] -> [Inline]
 normalizeInlineList (Str "" : xs)
   = normalizeInlineList xs
@@ -344,7 +348,7 @@ inlineListToMuse :: PandocMonad m
                  => [Inline]
                  -> StateT WriterState m Doc
 inlineListToMuse lst = do
-  lst' <- normalizeInlineList <$> preprocessInlineList lst
+  lst' <- normalizeInlineList <$> preprocessInlineList (map replaceSmallCaps lst)
   if null lst'
     then pure "<verbatim></verbatim>"
     else hcat <$> mapM inlineToMuse (fixNotes lst')
@@ -369,7 +373,8 @@ inlineToMuse (Superscript lst) = do
 inlineToMuse (Subscript lst) = do
   contents <- inlineListToMuse lst
   return $ "<sub>" <> contents <> "</sub>"
-inlineToMuse (SmallCaps lst) = inlineToMuse (Emph lst)
+inlineToMuse (SmallCaps {}) =
+  fail "SmallCaps should be expanded before normalization"
 inlineToMuse (Quoted SingleQuote lst) = do
   contents <- inlineListToMuse lst
   return $ "‘" <> contents <> "’"

test/Tests/Writers/Muse.hs

@@ -328,6 +328,7 @@ tests = [ testGroup "block elements"
           , "superscript" =: superscript (text "foo") =?> "<sup>foo</sup>"
           , "subscript" =: subscript (text "foo") =?> "<sub>foo</sub>"
           , "smallcaps" =: smallcaps (text "foo") =?> "<em>foo</em>"
+          , "smallcaps near emphasis" =: emph (str "foo") <> smallcaps (str "bar") =?> "<em>foobar</em>"
           , "single quoted" =: singleQuoted (text "foo") =?> "‘foo’"
           , "double quoted" =: doubleQuoted (text "foo") =?> "“foo”"
           -- Cite is trivial