From 673734b5893297a8c22ed8d2dc220cd7632e6cb2 Mon Sep 17 00:00:00 2001 From: Alexander Krotov Date: Mon, 22 Oct 2018 12:35:29 +0300 Subject: Reduce code duplication in Muse writer --- src/Text/Pandoc/Writers/Muse.hs | 52 ++++++++++++++--------------------------- 1 file changed, 18 insertions(+), 34 deletions(-) diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs index ea31169d7..34cc90104 100644 --- a/src/Text/Pandoc/Writers/Muse.hs +++ b/src/Text/Pandoc/Writers/Muse.hs @@ -516,6 +516,14 @@ inlineListToMuse' lst = do , envAfterSpace = afterSpace || not topLevel }) $ inlineListToMuse lst +emphasis :: PandocMonad m => String -> String -> [Inline] -> Muse m Doc +emphasis b e lst = do + contents <- local (\env -> env { envInsideAsterisks = inAsterisks }) $ inlineListToMuse lst + modify $ \st -> st { stUseTags = useTags } + return $ text b <> contents <> text e + where inAsterisks = last b == '*' || head e == '*' + useTags = last e /= '>' + -- | Convert Pandoc inline element to Muse. inlineToMuse :: PandocMonad m => Inline @@ -529,54 +537,30 @@ inlineToMuse (Emph [Strong lst]) = do useTags <- gets stUseTags let lst' = normalizeInlineList lst if useTags - then do contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst' - modify $ \st -> st { stUseTags = False } - return $ "**" <> contents <> "**" + then emphasis "**" "**" lst' else if null lst' || startsWithSpace lst' || endsWithSpace lst' - then do - contents <- local (\env -> env { envInsideAsterisks = False }) $ inlineListToMuse lst' - modify $ \st -> st { stUseTags = True } - return $ "*" <> contents <> "*" - else do - contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst' - modify $ \st -> st { stUseTags = True } - return $ "***" <> contents <> "***" + then emphasis "*" "*" lst' + else emphasis "***" "***" lst' inlineToMuse (Emph lst) = do useTags <- gets stUseTags let lst' = normalizeInlineList lst if useTags || null lst' || startsWithSpace lst' || endsWithSpace lst' - then do contents <- inlineListToMuse lst' - modify $ \st -> st { stUseTags = False } - return $ "" <> contents <> "" - else do contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst' - modify $ \st -> st { stUseTags = True } - return $ "*" <> contents <> "*" + then emphasis "" "" lst' + else emphasis "*" "*" lst' inlineToMuse (Strong [Emph lst]) = do useTags <- gets stUseTags let lst' = normalizeInlineList lst if useTags - then do contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst' - modify $ \st -> st { stUseTags = False } - return $ "*" <> contents <> "*" + then emphasis "*" "*" lst' else if null lst' || startsWithSpace lst' || endsWithSpace lst' - then do - contents <- local (\env -> env { envInsideAsterisks = False }) $ inlineListToMuse lst' - modify $ \st -> st { stUseTags = True } - return $ "**" <> contents <> "**" - else do - contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst' - modify $ \st -> st { stUseTags = True } - return $ "***" <> contents <> "***" + then emphasis "**" "**" lst' + else emphasis "***" "***" lst' inlineToMuse (Strong lst) = do useTags <- gets stUseTags let lst' = normalizeInlineList lst if useTags || null lst' || startsWithSpace lst' || endsWithSpace lst' - then do contents <- inlineListToMuse lst' - modify $ \st -> st { stUseTags = False } - return $ "" <> contents <> "" - else do contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst' - modify $ \st -> st { stUseTags = True } - return $ "**" <> contents <> "**" + then emphasis "" "" lst' + else emphasis "**" "**" lst' inlineToMuse (Strikeout lst) = do contents <- inlineListToMuse lst modify $ \st -> st { stUseTags = False } -- cgit v1.2.3