diff options
| -rw-r--r-- | src/Text/Pandoc/Logging.hs | 4 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/RST.hs | 70 |
2 files changed, 41 insertions, 33 deletions
diff --git a/src/Text/Pandoc/Logging.hs b/src/Text/Pandoc/Logging.hs index 052f5d364..59b010034 100644 --- a/src/Text/Pandoc/Logging.hs +++ b/src/Text/Pandoc/Logging.hs @@ -236,8 +236,8 @@ showLogMessage msg = NoLangSpecified -> "No value for 'lang' was specified in the metadata.\n" ++ "It is recommended that lang be specified for this format." - CouldNotHighlight msg -> - "Could not highlight code block:\n" ++ msg + CouldNotHighlight m -> + "Could not highlight code block:\n" ++ m messageVerbosity:: LogMessage -> Verbosity messageVerbosity msg = diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 496350024..d4a537d72 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -37,7 +37,8 @@ import Data.List (intersperse, isPrefixOf, stripPrefix, transpose) import Data.Maybe (fromMaybe) import Network.URI (isURI) import qualified Text.Pandoc.Builder as B -import Text.Pandoc.Class (PandocMonad) +import Text.Pandoc.Class (PandocMonad, report) +import Text.Pandoc.Logging import Text.Pandoc.Definition import Text.Pandoc.ImageSize import Text.Pandoc.Options @@ -58,17 +59,19 @@ data WriterState = , stTopLevel :: Bool } +type RST = StateT WriterState + -- | Convert Pandoc to RST. writeRST :: PandocMonad m => WriterOptions -> Pandoc -> m String -writeRST opts document = return $ +writeRST opts document = do let st = WriterState { stNotes = [], stLinks = [], stImages = [], stHasMath = False, stHasRawTeX = False, stOptions = opts, stTopLevel = True} - in evalState (pandocToRST document) st + evalStateT (pandocToRST document) st -- | Return RST representation of document. -pandocToRST :: Pandoc -> State WriterState String +pandocToRST :: PandocMonad m => Pandoc -> RST m String pandocToRST (Pandoc meta blocks) = do opts <- gets stOptions let colwidth = if writerWrapText opts == WrapAuto @@ -113,12 +116,11 @@ pandocToRST (Pandoc meta blocks) = do normalizeHeadings _ [] = [] -- | Return RST representation of reference key table. -refsToRST :: Refs -> State WriterState Doc +refsToRST :: PandocMonad m => Refs -> RST m Doc refsToRST refs = mapM keyToRST refs >>= return . vcat -- | Return RST representation of a reference key. -keyToRST :: ([Inline], (String, String)) - -> State WriterState Doc +keyToRST :: PandocMonad m => ([Inline], (String, String)) -> RST m Doc keyToRST (label, (src, _)) = do label' <- inlineListToRST label let label'' = if ':' `elem` ((render Nothing label') :: String) @@ -127,26 +129,28 @@ keyToRST (label, (src, _)) = do return $ nowrap $ ".. _" <> label'' <> ": " <> text src -- | Return RST representation of notes. -notesToRST :: [[Block]] -> State WriterState Doc +notesToRST :: PandocMonad m => [[Block]] -> RST m Doc notesToRST notes = mapM (\(num, note) -> noteToRST num note) (zip [1..] notes) >>= return . vsep -- | Return RST representation of a note. -noteToRST :: Int -> [Block] -> State WriterState Doc +noteToRST :: PandocMonad m => Int -> [Block] -> RST m Doc noteToRST num note = do contents <- blockListToRST note let marker = ".. [" <> text (show num) <> "]" return $ nowrap $ marker $$ nest 3 contents -- | Return RST representation of picture reference table. -pictRefsToRST :: [([Inline], (Attr, String, String, Maybe String))] - -> State WriterState Doc +pictRefsToRST :: PandocMonad m + => [([Inline], (Attr, String, String, Maybe String))] + -> RST m Doc pictRefsToRST refs = mapM pictToRST refs >>= return . vcat -- | Return RST representation of a picture substitution reference. -pictToRST :: ([Inline], (Attr, String, String, Maybe String)) - -> State WriterState Doc +pictToRST :: PandocMonad m + => ([Inline], (Attr, String, String, Maybe String)) + -> RST m Doc pictToRST (label, (attr, src, _, mbtarget)) = do label' <- inlineListToRST label dims <- imageDimsToRST attr @@ -178,7 +182,7 @@ escapeString opts (c:cs) = _ -> '.':escapeString opts cs _ -> c : escapeString opts cs -titleToRST :: [Inline] -> [Inline] -> State WriterState Doc +titleToRST :: PandocMonad m => [Inline] -> [Inline] -> RST m Doc titleToRST [] _ = return empty titleToRST tit subtit = do title <- inlineListToRST tit @@ -194,8 +198,9 @@ bordered contents c = border = text (replicate len c) -- | Convert Pandoc block element to RST. -blockToRST :: Block -- ^ Block element - -> State WriterState Doc +blockToRST :: PandocMonad m + => Block -- ^ Block element + -> RST m Doc blockToRST Null = return empty blockToRST (Div attr bs) = do contents <- blockListToRST bs @@ -323,22 +328,23 @@ blockToRST (DefinitionList items) = do return $ blankline $$ chomp (vcat contents) $$ blankline -- | Convert bullet list item (list of blocks) to RST. -bulletListItemToRST :: [Block] -> State WriterState Doc +bulletListItemToRST :: PandocMonad m => [Block] -> RST m Doc bulletListItemToRST items = do contents <- blockListToRST items return $ hang 3 "- " $ contents <> cr -- | Convert ordered list item (a list of blocks) to RST. -orderedListItemToRST :: String -- ^ marker for list item +orderedListItemToRST :: PandocMonad m + => String -- ^ marker for list item -> [Block] -- ^ list item (list of blocks) - -> State WriterState Doc + -> RST m Doc orderedListItemToRST marker items = do contents <- blockListToRST items let marker' = marker ++ " " return $ hang (length marker') (text marker') $ contents <> cr -- | Convert defintion list item (label, list of blocks) to RST. -definitionListItemToRST :: ([Inline], [[Block]]) -> State WriterState Doc +definitionListItemToRST :: PandocMonad m => ([Inline], [[Block]]) -> RST m Doc definitionListItemToRST (label, defs) = do label' <- inlineListToRST label contents <- liftM vcat $ mapM blockListToRST defs @@ -346,15 +352,16 @@ definitionListItemToRST (label, defs) = do return $ label' $$ nest tabstop (nestle contents <> cr) -- | Format a list of lines as line block. -linesToLineBlock :: [[Inline]] -> State WriterState Doc +linesToLineBlock :: PandocMonad m => [[Inline]] -> RST m Doc linesToLineBlock inlineLines = do lns <- mapM inlineListToRST inlineLines return $ (vcat $ map (hang 2 (text "| ")) lns) <> blankline -- | Convert list of Pandoc block elements to RST. -blockListToRST' :: Bool +blockListToRST' :: PandocMonad m + => Bool -> [Block] -- ^ List of block elements - -> State WriterState Doc + -> RST m Doc blockListToRST' topLevel blocks = do tl <- gets stTopLevel modify (\s->s{stTopLevel=topLevel}) @@ -362,12 +369,13 @@ blockListToRST' topLevel blocks = do modify (\s->s{stTopLevel=tl}) return res -blockListToRST :: [Block] -- ^ List of block elements - -> State WriterState Doc +blockListToRST :: PandocMonad m + => [Block] -- ^ List of block elements + -> RST m Doc blockListToRST = blockListToRST' False -- | Convert list of Pandoc inline elements to RST. -inlineListToRST :: [Inline] -> State WriterState Doc +inlineListToRST :: PandocMonad m => [Inline] -> RST m Doc inlineListToRST lst = mapM inlineToRST (removeSpaceAfterDisplayMath $ insertBS lst) >>= return . hcat @@ -427,7 +435,7 @@ inlineListToRST lst = isComplex _ = False -- | Convert Pandoc inline element to RST. -inlineToRST :: Inline -> State WriterState Doc +inlineToRST :: PandocMonad m => Inline -> RST m Doc inlineToRST (Span _ ils) = inlineListToRST ils inlineToRST (Emph lst) = do contents <- inlineListToRST lst @@ -477,12 +485,12 @@ inlineToRST (Math t str) = do then blankline $$ ".. math::" $$ blankline $$ nest 3 (text str) $$ blankline else blankline $$ (".. math:: " <> text str) $$ blankline -inlineToRST (RawInline f x) +inlineToRST il@(RawInline f x) | f == "rst" = return $ text x | f == "latex" || f == "tex" = do modify $ \st -> st{ stHasRawTeX = True } return $ ":raw-latex:`" <> text x <> "`" - | otherwise = return empty + | otherwise = empty <$ report (InlineNotRendered il) inlineToRST (LineBreak) = return cr -- there's no line break in RST (see Para) inlineToRST Space = return space inlineToRST SoftBreak = do @@ -527,7 +535,7 @@ inlineToRST (Note contents) = do let ref = show $ (length notes) + 1 return $ " [" <> text ref <> "]_" -registerImage :: Attr -> [Inline] -> Target -> Maybe String -> State WriterState Doc +registerImage :: PandocMonad m => Attr -> [Inline] -> Target -> Maybe String -> RST m Doc registerImage attr alt (src,tit) mbtarget = do pics <- gets stImages txt <- case lookup alt pics of @@ -542,7 +550,7 @@ registerImage attr alt (src,tit) mbtarget = do return alt' inlineListToRST txt -imageDimsToRST :: Attr -> State WriterState Doc +imageDimsToRST :: PandocMonad m => Attr -> RST m Doc imageDimsToRST attr = do let (ident, _, _) = attr name = if null ident |