diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/Textile.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/Textile.hs | 151 |
1 files changed, 85 insertions, 66 deletions
diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index f73876fd2..f46eb43bc 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2010-2015 John MacFarlane <jgm@berkeley.edu> +Copyright (C) 2010-2018 John MacFarlane <jgm@berkeley.edu> This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.Textile - Copyright : Copyright (C) 2010-2015 John MacFarlane + Copyright : Copyright (C) 2010-2018 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane <jgm@berkeley.edu> @@ -30,17 +30,20 @@ Conversion of 'Pandoc' documents to Textile markup. Textile: <http://thresholdstate.com/articles/4312/the-textile-reference-manual> -} module Text.Pandoc.Writers.Textile ( writeTextile ) where +import Control.Monad.State.Strict +import Data.Char (isSpace) +import Data.List (intercalate) +import Data.Text (Text, pack) +import Text.Pandoc.Class (PandocMonad, report) import Text.Pandoc.Definition +import Text.Pandoc.ImageSize +import Text.Pandoc.Logging import Text.Pandoc.Options -import Text.Pandoc.Shared import Text.Pandoc.Pretty (render) -import Text.Pandoc.ImageSize -import Text.Pandoc.Writers.Shared +import Text.Pandoc.Shared import Text.Pandoc.Templates (renderTemplate') -import Text.Pandoc.XML ( escapeStringForXML ) -import Data.List ( intercalate ) -import Control.Monad.State -import Data.Char ( isSpace ) +import Text.Pandoc.Writers.Shared +import Text.Pandoc.XML (escapeStringForXML) data WriterState = WriterState { stNotes :: [String] -- Footnotes @@ -49,29 +52,34 @@ data WriterState = WriterState { , stUseTags :: Bool -- True if we should use HTML tags because we're in a complex list } +type TW = StateT WriterState + -- | Convert Pandoc to Textile. -writeTextile :: WriterOptions -> Pandoc -> String +writeTextile :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeTextile opts document = - evalState (pandocToTextile opts document) - WriterState { stNotes = [], stListLevel = [], stStartNum = Nothing, + evalStateT (pandocToTextile opts document) + WriterState { stNotes = [], + stListLevel = [], + stStartNum = Nothing, stUseTags = False } -- | Return Textile representation of document. -pandocToTextile :: WriterOptions -> Pandoc -> State WriterState String +pandocToTextile :: PandocMonad m + => WriterOptions -> Pandoc -> TW m Text pandocToTextile opts (Pandoc meta blocks) = do metadata <- metaToJSON opts (blockListToTextile opts) (inlineListToTextile opts) meta body <- blockListToTextile opts blocks - notes <- liftM (unlines . reverse . stNotes) get - let main = body ++ if null notes then "" else ("\n\n" ++ notes) + notes <- gets $ unlines . reverse . stNotes + let main = pack $ body ++ if null notes then "" else ("\n\n" ++ notes) let context = defField "body" main metadata case writerTemplate opts of - Nothing -> return main - Just tpl -> return $ renderTemplate' tpl context + Nothing -> return main + Just tpl -> renderTemplate' tpl context -withUseTags :: State WriterState a -> State WriterState a +withUseTags :: PandocMonad m => TW m a -> TW m a withUseTags action = do - oldUseTags <- liftM stUseTags get + oldUseTags <- gets stUseTags modify $ \s -> s { stUseTags = True } result <- action modify $ \s -> s { stUseTags = oldUseTags } @@ -101,9 +109,10 @@ escapeStringForTextile :: String -> String escapeStringForTextile = concatMap escapeCharForTextile -- | Convert Pandoc block element to Textile. -blockToTextile :: WriterOptions -- ^ Options - -> Block -- ^ Block element - -> State WriterState String +blockToTextile :: PandocMonad m + => WriterOptions -- ^ Options + -> Block -- ^ Block element + -> TW m String blockToTextile _ Null = return "" @@ -123,8 +132,8 @@ blockToTextile opts (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do return $ im ++ "\n" ++ capt blockToTextile opts (Para inlines) = do - useTags <- liftM stUseTags get - listLevel <- liftM stListLevel get + useTags <- gets stUseTags + listLevel <- gets stListLevel contents <- inlineListToTextile opts inlines return $ if useTags then "<p>" ++ contents ++ "</p>" @@ -133,9 +142,11 @@ blockToTextile opts (Para inlines) = do blockToTextile opts (LineBlock lns) = blockToTextile opts $ linesToPara lns -blockToTextile _ (RawBlock f str) +blockToTextile _ b@(RawBlock f str) | f == Format "html" || f == Format "textile" = return str - | otherwise = return "" + | otherwise = do + report $ BlockNotRendered b + return "" blockToTextile _ HorizontalRule = return "<hr />\n" @@ -211,7 +222,7 @@ blockToTextile opts (Table capt aligns widths headers rows') = do "<tbody>\n" ++ unlines body' ++ "</tbody>\n</table>\n" blockToTextile opts x@(BulletList items) = do - oldUseTags <- liftM stUseTags get + oldUseTags <- gets stUseTags let useTags = oldUseTags || not (isSimpleList x) if useTags then do @@ -219,13 +230,13 @@ blockToTextile opts x@(BulletList items) = do return $ "<ul>\n" ++ vcat contents ++ "\n</ul>\n" else do modify $ \s -> s { stListLevel = stListLevel s ++ "*" } - level <- get >>= return . length . stListLevel + level <- gets $ length . stListLevel contents <- mapM (listItemToTextile opts) items modify $ \s -> s { stListLevel = init (stListLevel s) } return $ vcat contents ++ (if level > 1 then "" else "\n") blockToTextile opts x@(OrderedList attribs@(start, _, _) items) = do - oldUseTags <- liftM stUseTags get + oldUseTags <- gets stUseTags let useTags = oldUseTags || not (isSimpleList x) if useTags then do @@ -237,7 +248,7 @@ blockToTextile opts x@(OrderedList attribs@(start, _, _) items) = do , stStartNum = if start > 1 then Just start else Nothing } - level <- get >>= return . length . stListLevel + level <- gets $ length . stListLevel contents <- mapM (listItemToTextile opts) items modify $ \s -> s { stListLevel = init (stListLevel s), stStartNum = Nothing } @@ -261,10 +272,11 @@ listAttribsToString (startnum, numstyle, _) = else "") -- | Convert bullet or ordered list item (list of blocks) to Textile. -listItemToTextile :: WriterOptions -> [Block] -> State WriterState String +listItemToTextile :: PandocMonad m + => WriterOptions -> [Block] -> TW m String listItemToTextile opts items = do contents <- blockListToTextile opts items - useTags <- get >>= return . stUseTags + useTags <- gets stUseTags if useTags then return $ "<li>" ++ contents ++ "</li>" else do @@ -277,14 +289,15 @@ listItemToTextile opts items = do Nothing -> return $ marker ++ " " ++ contents -- | Convert definition list item (label, list of blocks) to Textile. -definitionListItemToTextile :: WriterOptions +definitionListItemToTextile :: PandocMonad m + => WriterOptions -> ([Inline],[[Block]]) - -> State WriterState String + -> TW m String definitionListItemToTextile opts (label, items) = do labelText <- inlineListToTextile opts label contents <- mapM (blockListToTextile opts) items return $ "<dt>" ++ labelText ++ "</dt>\n" ++ - (intercalate "\n" $ map (\d -> "<dd>" ++ d ++ "</dd>") contents) + intercalate "\n" (map (\d -> "<dd>" ++ d ++ "</dd>") contents) -- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed. isSimpleList :: Block -> Bool @@ -301,16 +314,16 @@ isSimpleListItem :: [Block] -> Bool isSimpleListItem [] = True isSimpleListItem [x] = case x of - Plain _ -> True - Para _ -> True - BulletList _ -> isSimpleList x - OrderedList _ _ -> isSimpleList x - _ -> False + Plain _ -> True + Para _ -> True + BulletList _ -> isSimpleList x + OrderedList _ _ -> isSimpleList x + _ -> False isSimpleListItem [x, y] | isPlainOrPara x = case y of - BulletList _ -> isSimpleList y - OrderedList _ _ -> isSimpleList y - _ -> False + BulletList _ -> isSimpleList y + OrderedList _ _ -> isSimpleList y + _ -> False isSimpleListItem _ = False isPlainOrPara :: Block -> Bool @@ -325,18 +338,19 @@ vcat = intercalate "\n" -- Auxiliary functions for tables. (TODO: these are common to HTML, MediaWiki, -- and Textile writers, and should be abstracted out.) -tableRowToTextile :: WriterOptions - -> [String] - -> Int - -> [[Block]] - -> State WriterState String +tableRowToTextile :: PandocMonad m + => WriterOptions + -> [String] + -> Int + -> [[Block]] + -> TW m String tableRowToTextile opts alignStrings rownum cols' = do let celltype = if rownum == 0 then "th" else "td" let rowclass = case rownum of - 0 -> "header" + 0 -> "header" x | x `rem` 2 == 1 -> "odd" - _ -> "even" - cols'' <- sequence $ zipWith + _ -> "even" + cols'' <- zipWithM (\alignment item -> tableItemToTextile opts celltype alignment item) alignStrings cols' return $ "<tr class=\"" ++ rowclass ++ "\">\n" ++ unlines cols'' ++ "</tr>" @@ -348,11 +362,12 @@ alignmentToString alignment = case alignment of AlignCenter -> "center" AlignDefault -> "left" -tableItemToTextile :: WriterOptions - -> String - -> String - -> [Block] - -> State WriterState String +tableItemToTextile :: PandocMonad m + => WriterOptions + -> String + -> String + -> [Block] + -> TW m String tableItemToTextile opts celltype align' item = do let mkcell x = "<" ++ celltype ++ " align=\"" ++ align' ++ "\">" ++ x ++ "</" ++ celltype ++ ">" @@ -360,19 +375,21 @@ tableItemToTextile opts celltype align' item = do return $ mkcell contents -- | Convert list of Pandoc block elements to Textile. -blockListToTextile :: WriterOptions -- ^ Options - -> [Block] -- ^ List of block elements - -> State WriterState String +blockListToTextile :: PandocMonad m + => WriterOptions -- ^ Options + -> [Block] -- ^ List of block elements + -> TW m String blockListToTextile opts blocks = mapM (blockToTextile opts) blocks >>= return . vcat -- | Convert list of Pandoc inline elements to Textile. -inlineListToTextile :: WriterOptions -> [Inline] -> State WriterState String +inlineListToTextile :: PandocMonad m + => WriterOptions -> [Inline] -> TW m String inlineListToTextile opts lst = mapM (inlineToTextile opts) lst >>= return . concat -- | Convert Pandoc inline element to Textile. -inlineToTextile :: WriterOptions -> Inline -> State WriterState String +inlineToTextile :: PandocMonad m => WriterOptions -> Inline -> TW m String inlineToTextile opts (Span _ lst) = inlineListToTextile opts lst @@ -429,13 +446,15 @@ inlineToTextile _ (Str str) = return $ escapeStringForTextile str inlineToTextile _ (Math _ str) = return $ "<span class=\"math\">" ++ escapeStringForXML str ++ "</math>" -inlineToTextile opts (RawInline f str) +inlineToTextile opts il@(RawInline f str) | f == Format "html" || f == Format "textile" = return str | (f == Format "latex" || f == Format "tex") && isEnabled Ext_raw_tex opts = return str - | otherwise = return "" + | otherwise = do + report $ InlineNotRendered il + return "" -inlineToTextile _ (LineBreak) = return "\n" +inlineToTextile _ LineBreak = return "\n" inlineToTextile _ SoftBreak = return " " @@ -464,7 +483,7 @@ inlineToTextile opts (Image attr@(_, cls, _) alt (source, tit)) = do then "" else "(" ++ unwords cls ++ ")" showDim dir = let toCss str = Just $ show dir ++ ":" ++ str ++ ";" - in case (dimension dir attr) of + in case dimension dir attr of Just (Percent a) -> toCss $ show (Percent a) Just dim -> toCss $ showInPixel opts dim ++ "px" Nothing -> Nothing @@ -476,7 +495,7 @@ inlineToTextile opts (Image attr@(_, cls, _) alt (source, tit)) = do return $ "!" ++ classes ++ styles ++ source ++ txt ++ "!" inlineToTextile opts (Note contents) = do - curNotes <- liftM stNotes get + curNotes <- gets stNotes let newnum = length curNotes + 1 contents' <- blockListToTextile opts contents let thisnote = "fn" ++ show newnum ++ ". " ++ contents' ++ "\n" |