From 0f01421f81f6075d7f76e66b3d2515cddf5ccdb9 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sun, 20 Jul 2014 12:24:53 -0700 Subject: AsciiDoc writer: Double markers in intraword emphasis. Closes #1441. --- src/Text/Pandoc/Writers/AsciiDoc.hs | 57 ++++++++++++++++++++++++++++++------- tests/Tests/Writers/AsciiDoc.hs | 25 ++++++++++++++-- tests/writer.asciidoc | 8 +++--- 3 files changed, 72 insertions(+), 18 deletions(-) diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index 8d36efeee..ffcce7990 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -49,10 +49,12 @@ import Control.Monad.State import qualified Data.Map as M import Data.Aeson (Value(String), fromJSON, toJSON, Result(..)) import qualified Data.Text as T +import Control.Applicative ((<*), (*>)) data WriterState = WriterState { defListMarker :: String , orderedListLevel :: Int , bulletListLevel :: Int + , intraword :: Bool } -- | Convert Pandoc to AsciiDoc. @@ -62,6 +64,7 @@ writeAsciiDoc opts document = defListMarker = "::" , orderedListLevel = 1 , bulletListLevel = 1 + , intraword = False } -- | Return asciidoc representation of document. @@ -123,7 +126,7 @@ blockToAsciiDoc _ Null = return empty blockToAsciiDoc opts (Plain inlines) = do contents <- inlineListToAsciiDoc opts inlines return $ contents <> cr -blockToAsciiDoc opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = +blockToAsciiDoc opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = do blockToAsciiDoc opts (Para [Image alt (src,tit)]) blockToAsciiDoc opts (Para inlines) = do contents <- inlineListToAsciiDoc opts inlines @@ -317,17 +320,51 @@ blockListToAsciiDoc opts blocks = cat `fmap` mapM (blockToAsciiDoc opts) blocks -- | Convert list of Pandoc inline elements to asciidoc. inlineListToAsciiDoc :: WriterOptions -> [Inline] -> State WriterState Doc -inlineListToAsciiDoc opts lst = - mapM (inlineToAsciiDoc opts) lst >>= return . cat +inlineListToAsciiDoc opts lst = do + oldIntraword <- gets intraword + setIntraword False + result <- go lst + setIntraword oldIntraword + return result + where go [] = return empty + go (y:x:xs) + | not (isSpacy y) = do + y' <- if isSpacy x + then inlineToAsciiDoc opts y + else withIntraword $ inlineToAsciiDoc opts y + x' <- withIntraword $ inlineToAsciiDoc opts x + xs' <- go xs + return (y' <> x' <> xs') + | x /= Space && x /= LineBreak = do + y' <- withIntraword $ inlineToAsciiDoc opts y + xs' <- go (x:xs) + return (y' <> xs') + go (x:xs) = do + x' <- inlineToAsciiDoc opts x + xs' <- go xs + return (x' <> xs') + isSpacy Space = True + isSpacy LineBreak = True + isSpacy _ = False + +setIntraword :: Bool -> State WriterState () +setIntraword b = modify $ \st -> st{ intraword = b } + +withIntraword :: State WriterState a -> State WriterState a +withIntraword p = setIntraword True *> p <* setIntraword False -- | Convert Pandoc inline element to asciidoc. inlineToAsciiDoc :: WriterOptions -> Inline -> State WriterState Doc inlineToAsciiDoc opts (Emph lst) = do contents <- inlineListToAsciiDoc opts lst - return $ "_" <> contents <> "_" + isIntraword <- gets intraword + let marker = if isIntraword then "__" else "_" + return $ marker <> contents <> marker inlineToAsciiDoc opts (Strong lst) = do contents <- inlineListToAsciiDoc opts lst - return $ "*" <> contents <> "*" + isIntraword <- gets intraword + let marker = if isIntraword then "**" else "*" + return $ marker <> contents <> marker inlineToAsciiDoc opts (Strikeout lst) = do contents <- inlineListToAsciiDoc opts lst return $ "[line-through]*" <> contents <> "*" @@ -338,12 +375,10 @@ inlineToAsciiDoc opts (Subscript lst) = do contents <- inlineListToAsciiDoc opts lst return $ "~" <> contents <> "~" inlineToAsciiDoc opts (SmallCaps lst) = inlineListToAsciiDoc opts lst -inlineToAsciiDoc opts (Quoted SingleQuote lst) = do - contents <- inlineListToAsciiDoc opts lst - return $ "`" <> contents <> "'" -inlineToAsciiDoc opts (Quoted DoubleQuote lst) = do - contents <- inlineListToAsciiDoc opts lst - return $ "``" <> contents <> "''" +inlineToAsciiDoc opts (Quoted SingleQuote lst) = + inlineListToAsciiDoc opts (Str "`" : lst ++ [Str "'"]) +inlineToAsciiDoc opts (Quoted DoubleQuote lst) = + inlineListToAsciiDoc opts (Str "``" : lst ++ [Str "''"]) inlineToAsciiDoc _ (Code _ str) = return $ text "`" <> text (escapeStringUsing (backslashEscapes "`") str) <> "`" inlineToAsciiDoc _ (Str str) = return $ text $ escapeString str diff --git a/tests/Tests/Writers/AsciiDoc.hs b/tests/Tests/Writers/AsciiDoc.hs index 118e648d3..f9e6bd154 100644 --- a/tests/Tests/Writers/AsciiDoc.hs +++ b/tests/Tests/Writers/AsciiDoc.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} module Tests.Writers.AsciiDoc (tests) where import Test.Framework @@ -12,7 +11,27 @@ asciidoc :: (ToString a, ToPandoc a) => a -> String asciidoc = writeAsciiDoc def{ writerWrapText = False } . toPandoc tests :: [Test] -tests = [ testGroup "tables" +tests = [ testGroup "emphasis" + [ test asciidoc "emph word before" $ + para (text "foo" <> emph (text "bar")) =?> + "foo__bar__" + , test asciidoc "emph word after" $ + para (emph (text "foo") <> text "bar") =?> + "__foo__bar" + , test asciidoc "emph quoted" $ + para (doubleQuoted (emph (text "foo"))) =?> + "``__foo__''" + , test asciidoc "strong word before" $ + para (text "foo" <> strong (text "bar")) =?> + "foo**bar**" + , test asciidoc "strong word after" $ + para (strong (text "foo") <> text "bar") =?> + "**foo**bar" + , test asciidoc "strong quoted" $ + para (singleQuoted (strong (text "foo"))) =?> + "`**foo**'" + ] + , testGroup "tables" [ test asciidoc "empty cells" $ simpleTable [] [[mempty],[mempty]] =?> unlines [ "[cols=\"\",]" @@ -22,7 +41,7 @@ tests = [ testGroup "tables" , "|====" ] , test asciidoc "multiblock cells" $ - simpleTable [] [[para "Para 1" <> para "Para 2"]] + simpleTable [] [[para (text "Para 1") <> para (text "Para 2")]] =?> unlines [ "[cols=\"\",]" , "|=====" diff --git a/tests/writer.asciidoc b/tests/writer.asciidoc index fbe0036d8..799f174fd 100644 --- a/tests/writer.asciidoc +++ b/tests/writer.asciidoc @@ -429,11 +429,11 @@ Hr’s: Inline Markup ------------- -This is _emphasized_, and so _is this_. +This is __emphasized__, and so __is this__. -This is *strong*, and so *is this*. +This is **strong**, and so **is this**. -An _link:/url[emphasized link]_. +An __link:/url[emphasized link]__. *_This is strong and em._* @@ -445,7 +445,7 @@ So is *_this_* word. This is code: `>`, `$`, `\`, `\$`, ``. -[line-through]*This is _strikeout_.* +[line-through]*This is __strikeout__.* Superscripts: a^bc^d a^_hello_^ a^hello there^. -- cgit v1.2.3