diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Muse.hs | 12 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Muse.hs | 14 | ||||
| -rw-r--r-- | test/Tests/Readers/Muse.hs | 3 | ||||
| -rw-r--r-- | test/Tests/Writers/Muse.hs | 7 |
4 files changed, 31 insertions, 5 deletions
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs index 568287929..ca7c94245 100644 --- a/src/Text/Pandoc/Readers/Muse.hs +++ b/src/Text/Pandoc/Readers/Muse.hs @@ -746,6 +746,8 @@ inline' = whitespace <|> strikeoutTag <|> verbatimTag <|> classTag + <|> inlineRtl + <|> inlineLtr <|> nbsp <|> linkOrImage <|> code @@ -863,6 +865,16 @@ classTag = do classes <- maybe [] words . lookup "name" <$> openTag "class" fmap (B.spanWith ("", classes, [])) . mconcat <$> manyTill inline (closeTag "class") +-- | Parse @\<\<\<RTL>>>@ text. +inlineRtl :: PandocMonad m => MuseParser m (F Inlines) +inlineRtl = try $ + fmap (B.spanWith ("", [], [("dir", "rtl")])) . mconcat <$ string "<<<" <*> manyTill inline (string ">>>") + +-- | Parse @\<\<\<LTR>>>@ text. +inlineLtr :: PandocMonad m => MuseParser m (F Inlines) +inlineLtr = try $ + fmap (B.spanWith ("", [], [("dir", "ltr")])) . mconcat <$ string ">>>" <*> manyTill inline (string "<<<") + -- | Parse "~~" as nonbreaking space. nbsp :: PandocMonad m => MuseParser m (F Inlines) nbsp = try $ pure (B.str "\160") <$ string "~~" diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs index c03fd0c1a..ec03d6292 100644 --- a/src/Text/Pandoc/Writers/Muse.hs +++ b/src/Text/Pandoc/Writers/Muse.hs @@ -377,6 +377,7 @@ shouldEscapeString s = do "::" `isInfixOf` s || "~~" `isInfixOf` s || "[[" `isInfixOf` s || + ">>>" `isInfixOf` s || ("]" `isInfixOf` s && insideLink) || containsNotes '[' ']' s || containsNotes '{' '}' s @@ -412,7 +413,7 @@ removeKeyValues :: Inline -> Inline removeKeyValues (Code (i, cls, _) xs) = Code (i, cls, []) xs -- Do not remove attributes from Link -- Do not remove attributes, such as "width", from Image -removeKeyValues (Span (i, cls, _) xs) = Span (i, cls, []) xs +-- Do not remove attributes, such as "dir", from Span removeKeyValues x = x normalizeInlineList :: [Inline] -> [Inline] @@ -682,14 +683,17 @@ inlineToMuse (Note contents) = do n <- gets stNoteNum let ref = show $ n + length notes return $ "[" <> text ref <> "]" -inlineToMuse (Span (anchor,names,_) inlines) = do +inlineToMuse (Span (anchor,names,kvs) inlines) = do contents <- inlineListToMuse inlines + let (contents', hasDir) = case lookup "dir" kvs of + Just "rtl" -> ("<<<" <> contents <> ">>>", True) + Just "ltr" -> (">>>" <> contents <> "<<<", True) + _ -> (contents, False) let anchorDoc = if null anchor then mempty else text ('#':anchor) <> space modify $ \st -> st { stUseTags = False } return $ anchorDoc <> (if null inlines && not (null anchor) then mempty - else (if null names - then "<class>" - else "<class name=\"" <> text (head names) <> "\">") <> contents <> "</class>") + else (if null names then (if hasDir then contents' else "<class>" <> contents' <> "</class>") + else "<class name=\"" <> text (head names) <> "\">" <> contents' <> "</class>")) diff --git a/test/Tests/Readers/Muse.hs b/test/Tests/Readers/Muse.hs index 426ba935d..87495eba1 100644 --- a/test/Tests/Readers/Muse.hs +++ b/test/Tests/Readers/Muse.hs @@ -236,6 +236,9 @@ tests = , "Class tag" =: "<class name=\"foo\">bar</class>" =?> para (spanWith ("", ["foo"], []) "bar") , "Class tag without name" =: "<class>foobar</class>" =?> para (spanWith ("", [], []) "foobar") + , "RTL" =: "<<<foo bar>>>" =?> para (spanWith ("", [], [("dir", "rtl")]) "foo bar") + , "LTR" =: ">>>foo bar<<<" =?> para (spanWith ("", [], [("dir", "ltr")]) "foo bar") + -- <em> tag should match with the last </em> tag, not verbatim one , "Nested \"</em>\" inside em tag" =: "<em>foo<verbatim></em></verbatim>bar</em>" =?> para (emph "foo</em>bar") diff --git a/test/Tests/Writers/Muse.hs b/test/Tests/Writers/Muse.hs index 7a07f39b7..ee61d18e0 100644 --- a/test/Tests/Writers/Muse.hs +++ b/test/Tests/Writers/Muse.hs @@ -620,6 +620,13 @@ tests = [ testGroup "block elements" , "adjacent spans" =: spanWith ("", ["syllable"], []) (str "wa") <> spanWith ("", ["syllable"], []) (str "ter") =?> "<class name=\"syllable\">wa</class><class name=\"syllable\">ter</class>" + , testGroup "RTL" + [ "RTL span" =: spanWith ("",[],[("dir", "rtl")]) (text "foo bar") =?> "<<<foo bar>>>" + , "LTR span" =: spanWith ("",[],[("dir", "ltr")]) (text "foo bar") =?> ">>>foo bar<<<" + , "RTL span with a class" =: spanWith ("",["foobar"],[("dir", "rtl")]) (text "foo bar") =?> "<class name=\"foobar\"><<<foo bar>>></class>" + , "LTR span with a class" =: spanWith ("",["foobar"],[("dir", "ltr")]) (text "foo bar") =?> "<class name=\"foobar\">>>>foo bar<<<</class>" + , "Escape <<< and >>>" =: plain (text "<<< foo bar >>>") =?> "<verbatim><<<</verbatim> foo bar <verbatim>>>></verbatim>" + ] , testGroup "combined" [ "emph word before" =: para ("foo" <> emph "bar") =?> |