Muse writer: use tags instead of lightweight markup for empty strings

This commit is contained in:
Alexander Krotov 2018-09-11 00:38:55 +03:00
parent 7b52d43877
commit c2b97c4b80
2 changed files with 13 additions and 4 deletions

View file

@ -420,6 +420,11 @@ endsWithSpace [SoftBreak] = True
endsWithSpace (_:xs) = endsWithSpace xs endsWithSpace (_:xs) = endsWithSpace xs
endsWithSpace [] = False endsWithSpace [] = False
emptyInlines :: [Inline] -> Bool
emptyInlines [] = True
emptyInlines (Str "":xs) = emptyInlines xs
emptyInlines _ = False
urlEscapeBrackets :: String -> String urlEscapeBrackets :: String -> String
urlEscapeBrackets (']':xs) = '%':'5':'D':urlEscapeBrackets xs urlEscapeBrackets (']':xs) = '%':'5':'D':urlEscapeBrackets xs
urlEscapeBrackets (x:xs) = x:urlEscapeBrackets xs urlEscapeBrackets (x:xs) = x:urlEscapeBrackets xs
@ -517,7 +522,7 @@ inlineToMuse (Emph [Strong lst]) = do
then do contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst then do contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst
modify $ \st -> st { stUseTags = False } modify $ \st -> st { stUseTags = False }
return $ "<em>**" <> contents <> "**</em>" return $ "<em>**" <> contents <> "**</em>"
else if null lst || startsWithSpace lst || endsWithSpace lst else if emptyInlines lst || startsWithSpace lst || endsWithSpace lst
then do then do
contents <- local (\env -> env { envInsideAsterisks = False }) $ inlineListToMuse lst contents <- local (\env -> env { envInsideAsterisks = False }) $ inlineListToMuse lst
modify $ \st -> st { stUseTags = True } modify $ \st -> st { stUseTags = True }
@ -528,7 +533,7 @@ inlineToMuse (Emph [Strong lst]) = do
return $ "***" <> contents <> "***" return $ "***" <> contents <> "***"
inlineToMuse (Emph lst) = do inlineToMuse (Emph lst) = do
useTags <- gets stUseTags useTags <- gets stUseTags
if useTags || null lst || startsWithSpace lst || endsWithSpace lst if useTags || emptyInlines lst || startsWithSpace lst || endsWithSpace lst
then do contents <- inlineListToMuse lst then do contents <- inlineListToMuse lst
return $ "<em>" <> contents <> "</em>" return $ "<em>" <> contents <> "</em>"
else do contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst else do contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst
@ -540,7 +545,7 @@ inlineToMuse (Strong [Emph lst]) = do
then do contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst then do contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst
modify $ \st -> st { stUseTags = False } modify $ \st -> st { stUseTags = False }
return $ "<strong>*" <> contents <> "*</strong>" return $ "<strong>*" <> contents <> "*</strong>"
else if null lst || startsWithSpace lst || endsWithSpace lst else if emptyInlines lst || startsWithSpace lst || endsWithSpace lst
then do then do
contents <- local (\env -> env { envInsideAsterisks = False }) $ inlineListToMuse lst contents <- local (\env -> env { envInsideAsterisks = False }) $ inlineListToMuse lst
modify $ \st -> st { stUseTags = True } modify $ \st -> st { stUseTags = True }
@ -551,7 +556,7 @@ inlineToMuse (Strong [Emph lst]) = do
return $ "***" <> contents <> "***" return $ "***" <> contents <> "***"
inlineToMuse (Strong lst) = do inlineToMuse (Strong lst) = do
useTags <- gets stUseTags useTags <- gets stUseTags
if useTags || null lst || startsWithSpace lst || endsWithSpace lst if useTags || emptyInlines lst || startsWithSpace lst || endsWithSpace lst
then do contents <- inlineListToMuse lst then do contents <- inlineListToMuse lst
modify $ \st -> st { stUseTags = False } modify $ \st -> st { stUseTags = False }
return $ "<strong>" <> contents <> "</strong>" return $ "<strong>" <> contents <> "</strong>"

View file

@ -362,6 +362,10 @@ tests = [ testGroup "block elements"
, "empty strong" =: strong mempty =?> "<strong></strong>" , "empty strong" =: strong mempty =?> "<strong></strong>"
, "empty strong emphasis" =: strong (emph mempty) =?> "**<em></em>**" , "empty strong emphasis" =: strong (emph mempty) =?> "**<em></em>**"
, "empty emphasized strong" =: emph (strong mempty) =?> "*<strong></strong>*" , "empty emphasized strong" =: emph (strong mempty) =?> "*<strong></strong>*"
, "emphasized empty string" =: emph (str "") =?> "<em></em>"
, "strong empty string" =: strong (str "") =?> "<strong></strong>"
, "strong emphasized empty string" =: strong (emph (str "")) =?> "**<em></em>**"
, "emphasized strong empty string" =: emph (strong (str "")) =?> "*<strong></strong>*"
, "strong" =: strong (text "foo") =?> "**foo**" , "strong" =: strong (text "foo") =?> "**foo**"
, "strong inside word" =: text "foo" <> strong (text "bar") <> text "baz" =?> "foo<strong>bar</strong>baz" , "strong inside word" =: text "foo" <> strong (text "bar") <> text "baz" =?> "foo<strong>bar</strong>baz"
, "strong emphasis" =: strong (emph (text "foo")) =?> "***foo***" , "strong emphasis" =: strong (emph (text "foo")) =?> "***foo***"