@@ -49,10 +49,12 @@ import Control.Monad.State
4949import qualified Data.Map as M
5050import Data.Aeson (Value(String), fromJSON, toJSON, Result(..))
5151import qualified Data.Text as T
52+import Control.Applicative ((<*), (*>))
5253
5354data WriterState = WriterState { defListMarker :: String
5455 , orderedListLevel :: Int
5556 , bulletListLevel :: Int
57+ , intraword :: Bool
5658 }
5759
5860-- | Convert Pandoc to AsciiDoc.
@@ -62,6 +64,7 @@ writeAsciiDoc opts document =
6264 defListMarker = "::"
6365 , orderedListLevel = 1
6466 , bulletListLevel = 1
67+ , intraword = False
6568 }
6669
6770-- | Return asciidoc representation of document.
@@ -123,7 +126,7 @@ blockToAsciiDoc _ Null = return empty
123126blockToAsciiDoc opts (Plain inlines) = do
124127 contents <- inlineListToAsciiDoc opts inlines
125128 return $ contents <> cr
126−blockToAsciiDoc opts (Para [Image alt (src,'f':'i':'g':':':tit)]) =
129+blockToAsciiDoc opts (Para [Image alt (src,'f':'i':'g':':':tit)]) = do
127130 blockToAsciiDoc opts (Para [Image alt (src,tit)])
128131blockToAsciiDoc opts (Para inlines) = do
129132 contents <- inlineListToAsciiDoc opts inlines
@@ -317,17 +320,51 @@ blockListToAsciiDoc opts blocks = cat `fmap` mapM (blockToAsciiDoc opts) blocks
317320
318321-- | Convert list of Pandoc inline elements to asciidoc.
319322inlineListToAsciiDoc :: WriterOptions -> [Inline] -> State WriterState Doc
320−inlineListToAsciiDoc opts lst =
321− mapM (inlineToAsciiDoc opts) lst >>= return . cat
323+inlineListToAsciiDoc opts lst = do
324+ oldIntraword <- gets intraword
325+ setIntraword False
326+ result <- go lst
327+ setIntraword oldIntraword
328+ return result
329+ where go [] = return empty
330+ go (y:x:xs)
331+ | not (isSpacy y) = do
332+ y' <- if isSpacy x
333+ then inlineToAsciiDoc opts y
334+ else withIntraword $ inlineToAsciiDoc opts y
335+ x' <- withIntraword $ inlineToAsciiDoc opts x
336+ xs' <- go xs
337+ return (y' <> x' <> xs')
338+ | x /= Space && x /= LineBreak = do
339+ y' <- withIntraword $ inlineToAsciiDoc opts y
340+ xs' <- go (x:xs)
341+ return (y' <> xs')
342+ go (x:xs) = do
343+ x' <- inlineToAsciiDoc opts x
344+ xs' <- go xs
345+ return (x' <> xs')
346+ isSpacy Space = True
347+ isSpacy LineBreak = True
348+ isSpacy _ = False
349+
350+setIntraword :: Bool -> State WriterState ()
351+setIntraword b = modify $ \st -> st{ intraword = b }
352+
353+withIntraword :: State WriterState a -> State WriterState a
354+withIntraword p = setIntraword True *> p <* setIntraword False
322355
323356-- | Convert Pandoc inline element to asciidoc.
324357inlineToAsciiDoc :: WriterOptions -> Inline -> State WriterState Doc
325358inlineToAsciiDoc opts (Emph lst) = do
326359 contents <- inlineListToAsciiDoc opts lst
327− return $ "_" <> contents <> "_"
360+ isIntraword <- gets intraword
361+ let marker = if isIntraword then "__" else "_"
362+ return $ marker <> contents <> marker
328363inlineToAsciiDoc opts (Strong lst) = do
329364 contents <- inlineListToAsciiDoc opts lst
330− return $ "*" <> contents <> "*"
365+ isIntraword <- gets intraword
366+ let marker = if isIntraword then "**" else "*"
367+ return $ marker <> contents <> marker
331368inlineToAsciiDoc opts (Strikeout lst) = do
332369 contents <- inlineListToAsciiDoc opts lst
333370 return $ "[line-through]*" <> contents <> "*"
@@ -338,12 +375,10 @@ inlineToAsciiDoc opts (Subscript lst) = do
338375 contents <- inlineListToAsciiDoc opts lst
339376 return $ "~" <> contents <> "~"
340377inlineToAsciiDoc opts (SmallCaps lst) = inlineListToAsciiDoc opts lst
341−inlineToAsciiDoc opts (Quoted SingleQuote lst) = do
342− contents <- inlineListToAsciiDoc opts lst
343− return $ "`" <> contents <> "'"
344−inlineToAsciiDoc opts (Quoted DoubleQuote lst) = do
345− contents <- inlineListToAsciiDoc opts lst
346− return $ "``" <> contents <> "''"
378+inlineToAsciiDoc opts (Quoted SingleQuote lst) =
379+ inlineListToAsciiDoc opts (Str "`" : lst ++ [Str "'"])
380+inlineToAsciiDoc opts (Quoted DoubleQuote lst) =
381+ inlineListToAsciiDoc opts (Str "``" : lst ++ [Str "''"])
347382inlineToAsciiDoc _ (Code _ str) = return $
348383 text "`" <> text (escapeStringUsing (backslashEscapes "`") str) <> "`"
349384inlineToAsciiDoc _ (Str str) = return $ text $ escapeString str