0713cb6 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Muse: add RTL support

0713cb6Alexander Krotov7 years ago

src/Text/Pandoc/Readers/Muse.hs+12

compare with master

unifiedsplit

@@ -746,6 +746,8 @@ inline' = whitespace

746 <|> strikeoutTag

747 <|> verbatimTag

748 <|> classTag

749+ <|> inlineRtl

750+ <|> inlineLtr

749 <|> nbsp

751 <|> nbsp

750 <|> linkOrImage

752 <|> linkOrImage

751 <|> code

753 <|> code

@@ -863,6 +865,16 @@ classTag = do

863 classes <- maybe [] words . lookup "name" <$> openTag "class"

865 classes <- maybe [] words . lookup "name" <$> openTag "class"

864 fmap (B.spanWith ("", classes, [])) . mconcat <$> manyTill inline (closeTag "class")

866 fmap (B.spanWith ("", classes, [])) . mconcat <$> manyTill inline (closeTag "class")

865

867

868+-- | Parse @\<\<\<RTL>>>@ text.

869+inlineRtl :: PandocMonad m => MuseParser m (F Inlines)

870+inlineRtl = try $

871+ fmap (B.spanWith ("", [], [("dir", "rtl")])) . mconcat <$ string "<<<" <*> manyTill inline (string ">>>")

872+

873+-- | Parse @\<\<\<LTR>>>@ text.

874+inlineLtr :: PandocMonad m => MuseParser m (F Inlines)

875+inlineLtr = try $

876+ fmap (B.spanWith ("", [], [("dir", "ltr")])) . mconcat <$ string ">>>" <*> manyTill inline (string "<<<")

877+

866-- | Parse "~~" as nonbreaking space.

878-- | Parse "~~" as nonbreaking space.

867nbsp :: PandocMonad m => MuseParser m (F Inlines)

879nbsp :: PandocMonad m => MuseParser m (F Inlines)

868nbsp = try $ pure (B.str "\160") <$ string "~~"

880nbsp = try $ pure (B.str "\160") <$ string "~~"

src/Text/Pandoc/Writers/Muse.hs+9−5

@@ -377,6 +377,7 @@ shouldEscapeString s = do

377 "::" `isInfixOf` s ||

378 "~~" `isInfixOf` s ||

379 "[[" `isInfixOf` s ||

380+ ">>>" `isInfixOf` s ||

380 ("]" `isInfixOf` s && insideLink) ||

381 ("]" `isInfixOf` s && insideLink) ||

381 containsNotes '[' ']' s ||

382 containsNotes '[' ']' s ||

382 containsNotes '{' '}' s

383 containsNotes '{' '}' s

@@ -412,7 +413,7 @@ removeKeyValues :: Inline -> Inline

412removeKeyValues (Code (i, cls, _) xs) = Code (i, cls, []) xs

413removeKeyValues (Code (i, cls, _) xs) = Code (i, cls, []) xs

413-- Do not remove attributes from Link

414-- Do not remove attributes from Link

414-- Do not remove attributes, such as "width", from Image

415-- Do not remove attributes, such as "width", from Image

415−removeKeyValues (Span (i, cls, _) xs) = Span (i, cls, []) xs

416+-- Do not remove attributes, such as "dir", from Span

416removeKeyValues x = x

417removeKeyValues x = x

417

418

418normalizeInlineList :: [Inline] -> [Inline]

419normalizeInlineList :: [Inline] -> [Inline]

@@ -682,14 +683,17 @@ inlineToMuse (Note contents) = do

682 n <- gets stNoteNum

683 n <- gets stNoteNum

683 let ref = show $ n + length notes

684 let ref = show $ n + length notes

684 return $ "[" <> text ref <> "]"

685 return $ "[" <> text ref <> "]"

685−inlineToMuse (Span (anchor,names,_) inlines) = do

686+inlineToMuse (Span (anchor,names,kvs) inlines) = do

686 contents <- inlineListToMuse inlines

687 contents <- inlineListToMuse inlines

688+ let (contents', hasDir) = case lookup "dir" kvs of

689+ Just "rtl" -> ("<<<" <> contents <> ">>>", True)

690+ Just "ltr" -> (">>>" <> contents <> "<<<", True)

691+ _ -> (contents, False)

687 let anchorDoc = if null anchor

692 let anchorDoc = if null anchor

688 then mempty

693 then mempty

689 else text ('#':anchor) <> space

694 else text ('#':anchor) <> space

690 modify $ \st -> st { stUseTags = False }

695 modify $ \st -> st { stUseTags = False }

691 return $ anchorDoc <> (if null inlines && not (null anchor)

696 return $ anchorDoc <> (if null inlines && not (null anchor)

692 then mempty

697 then mempty

693− else (if null names

698+ else (if null names then (if hasDir then contents' else "<class>" <> contents' <> "</class>")

694− then "<class>"

695− else "<class name=\"" <> text (head names) <> "\">") <> contents <> "</class>")

699+ else "<class name=\"" <> text (head names) <> "\">" <> contents' <> "</class>"))

test/Tests/Readers/Muse.hs+3

@@ -236,6 +236,9 @@ tests =

236 , "Class tag" =: "<class name=\"foo\">bar</class>" =?> para (spanWith ("", ["foo"], []) "bar")

237 , "Class tag without name" =: "<class>foobar</class>" =?> para (spanWith ("", [], []) "foobar")

238

239+ , "RTL" =: "<<<foo bar>>>" =?> para (spanWith ("", [], [("dir", "rtl")]) "foo bar")

240+ , "LTR" =: ">>>foo bar<<<" =?> para (spanWith ("", [], [("dir", "ltr")]) "foo bar")

241+

239 -- tag should match with the last tag, not verbatim one

242 -- tag should match with the last tag, not verbatim one

240 , "Nested \"\" inside em tag" =: "foo<verbatim></verbatim>bar" =?> para (emph "foobar")

243 , "Nested \"\" inside em tag" =: "foo<verbatim></verbatim>bar" =?> para (emph "foobar")

241

244

test/Tests/Writers/Muse.hs+7

@@ -620,6 +620,13 @@ tests = [ testGroup "block elements"

620 , "adjacent spans" =: spanWith ("", ["syllable"], []) (str "wa") <>

621 spanWith ("", ["syllable"], []) (str "ter")

622 =?> "<class name=\"syllable\">wa</class><class name=\"syllable\">ter</class>"

623+ , testGroup "RTL"

624+ [ "RTL span" =: spanWith ("",[],[("dir", "rtl")]) (text "foo bar") =?> "<<<foo bar>>>"

625+ , "LTR span" =: spanWith ("",[],[("dir", "ltr")]) (text "foo bar") =?> ">>>foo bar<<<"

626+ , "RTL span with a class" =: spanWith ("",["foobar"],[("dir", "rtl")]) (text "foo bar") =?> "<class name=\"foobar\"><<<foo bar>>></class>"

627+ , "LTR span with a class" =: spanWith ("",["foobar"],[("dir", "ltr")]) (text "foo bar") =?> "<class name=\"foobar\">>>>foo bar<<<</class>"

628+ , "Escape <<< and >>>" =: plain (text "<<< foo bar >>>") =?> "<verbatim><<<</verbatim> foo bar <verbatim>>>></verbatim>"

629+ ]

623 , testGroup "combined"

630 , testGroup "combined"

624 [ "emph word before" =:

631 [ "emph word before" =:

625 para ("foo" <> emph "bar") =?>

632 para ("foo" <> emph "bar") =?>