Muse writer: replace smallcaps with emphasis before normalization

1 files changed, 7 insertions, 2 deletions

diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs
index 28cfb0ef4..daffa2d07 100644
--- a/src/Text/Pandoc/Writers/Muse.hs
+++ b/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 <> "’"