Muse writer: normalize inline list before testing if tags should be used
This commit is contained in:
parent
c2b97c4b80
commit
00b2b0feb6
2 changed files with 19 additions and 19 deletions
|
@ -420,11 +420,6 @@ endsWithSpace [SoftBreak] = True
|
|||
endsWithSpace (_:xs) = endsWithSpace xs
|
||||
endsWithSpace [] = False
|
||||
|
||||
emptyInlines :: [Inline] -> Bool
|
||||
emptyInlines [] = True
|
||||
emptyInlines (Str "":xs) = emptyInlines xs
|
||||
emptyInlines _ = False
|
||||
|
||||
urlEscapeBrackets :: String -> String
|
||||
urlEscapeBrackets (']':xs) = '%':'5':'D':urlEscapeBrackets xs
|
||||
urlEscapeBrackets (x:xs) = x:urlEscapeBrackets xs
|
||||
|
@ -518,49 +513,53 @@ inlineToMuse (Str str) = do
|
|||
return $ text escapedStr
|
||||
inlineToMuse (Emph [Strong lst]) = do
|
||||
useTags <- gets stUseTags
|
||||
let lst' = normalizeInlineList lst
|
||||
if useTags
|
||||
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 }
|
||||
return $ "<em>**" <> contents <> "**</em>"
|
||||
else if emptyInlines lst || startsWithSpace lst || endsWithSpace lst
|
||||
else if null lst' || startsWithSpace lst' || endsWithSpace lst'
|
||||
then do
|
||||
contents <- local (\env -> env { envInsideAsterisks = False }) $ inlineListToMuse lst
|
||||
contents <- local (\env -> env { envInsideAsterisks = False }) $ inlineListToMuse lst'
|
||||
modify $ \st -> st { stUseTags = True }
|
||||
return $ "*<strong>" <> contents <> "</strong>*"
|
||||
else do
|
||||
contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst
|
||||
contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst'
|
||||
modify $ \st -> st { stUseTags = True }
|
||||
return $ "***" <> contents <> "***"
|
||||
inlineToMuse (Emph lst) = do
|
||||
useTags <- gets stUseTags
|
||||
if useTags || emptyInlines lst || startsWithSpace lst || endsWithSpace lst
|
||||
then do contents <- inlineListToMuse lst
|
||||
let lst' = normalizeInlineList lst
|
||||
if useTags || null lst' || startsWithSpace lst' || endsWithSpace lst'
|
||||
then do contents <- inlineListToMuse lst'
|
||||
return $ "<em>" <> contents <> "</em>"
|
||||
else do contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst
|
||||
else do contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst'
|
||||
modify $ \st -> st { stUseTags = True }
|
||||
return $ "*" <> contents <> "*"
|
||||
inlineToMuse (Strong [Emph lst]) = do
|
||||
useTags <- gets stUseTags
|
||||
let lst' = normalizeInlineList lst
|
||||
if useTags
|
||||
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 }
|
||||
return $ "<strong>*" <> contents <> "*</strong>"
|
||||
else if emptyInlines lst || startsWithSpace lst || endsWithSpace lst
|
||||
else if null lst' || startsWithSpace lst' || endsWithSpace lst'
|
||||
then do
|
||||
contents <- local (\env -> env { envInsideAsterisks = False }) $ inlineListToMuse lst
|
||||
contents <- local (\env -> env { envInsideAsterisks = False }) $ inlineListToMuse lst'
|
||||
modify $ \st -> st { stUseTags = True }
|
||||
return $ "**<em>" <> contents <> "</em>**"
|
||||
else do
|
||||
contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst
|
||||
contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst'
|
||||
modify $ \st -> st { stUseTags = True }
|
||||
return $ "***" <> contents <> "***"
|
||||
inlineToMuse (Strong lst) = do
|
||||
useTags <- gets stUseTags
|
||||
if useTags || emptyInlines lst || startsWithSpace lst || endsWithSpace lst
|
||||
then do contents <- inlineListToMuse lst
|
||||
let lst' = normalizeInlineList lst
|
||||
if useTags || null lst' || startsWithSpace lst' || endsWithSpace lst'
|
||||
then do contents <- inlineListToMuse lst'
|
||||
modify $ \st -> st { stUseTags = False }
|
||||
return $ "<strong>" <> contents <> "</strong>"
|
||||
else do contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst
|
||||
else do contents <- local (\env -> env { envInsideAsterisks = True }) $ inlineListToMuse lst'
|
||||
modify $ \st -> st { stUseTags = True }
|
||||
return $ "**" <> contents <> "**"
|
||||
inlineToMuse (Strikeout lst) = do
|
||||
|
|
|
@ -366,6 +366,7 @@ tests = [ testGroup "block elements"
|
|||
, "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>*"
|
||||
, "emphasized space between empty strings" =: emph (str "" <> space <> str "") =?> "<em> </em>"
|
||||
, "strong" =: strong (text "foo") =?> "**foo**"
|
||||
, "strong inside word" =: text "foo" <> strong (text "bar") <> text "baz" =?> "foo<strong>bar</strong>baz"
|
||||
, "strong emphasis" =: strong (emph (text "foo")) =?> "***foo***"
|
||||
|
|
Loading…
Add table
Reference in a new issue