{-# LANGUAGE NoImplicitPrelude #-} {- Copyright (C) 2010-2018 John MacFarlane 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 the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | Module : Text.Pandoc.Writers.Textile Copyright : Copyright (C) 2010-2018 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane Stability : alpha Portability : portable Conversion of 'Pandoc' documents to Textile markup. Textile: -} module Text.Pandoc.Writers.Textile ( writeTextile ) where import Prelude 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.Pretty (render) import Text.Pandoc.Shared import Text.Pandoc.Templates (renderTemplate') import Text.Pandoc.Writers.Shared import Text.Pandoc.XML (escapeStringForXML) data WriterState = WriterState { stNotes :: [String] -- Footnotes , stListLevel :: [Char] -- String at beginning of list items, e.g. "**" , stStartNum :: Maybe Int -- Start number if first list item , 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 :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeTextile opts document = evalStateT (pandocToTextile opts document) WriterState { stNotes = [], stListLevel = [], stStartNum = Nothing, stUseTags = False } -- | Return Textile representation of document. 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 <- 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 -> renderTemplate' tpl context withUseTags :: PandocMonad m => TW m a -> TW m a withUseTags action = do oldUseTags <- gets stUseTags modify $ \s -> s { stUseTags = True } result <- action modify $ \s -> s { stUseTags = oldUseTags } return result -- | Escape one character as needed for Textile. escapeCharForTextile :: Char -> String escapeCharForTextile x = case x of '&' -> "&" '<' -> "<" '>' -> ">" '"' -> """ '*' -> "*" '_' -> "_" '@' -> "@" '+' -> "+" '-' -> "-" '|' -> "|" '\x2014' -> " -- " '\x2013' -> " - " '\x2019' -> "'" '\x2026' -> "..." c -> [c] -- | Escape string as needed for Textile. escapeStringForTextile :: String -> String escapeStringForTextile = concatMap escapeCharForTextile -- | Convert Pandoc block element to Textile. blockToTextile :: PandocMonad m => WriterOptions -- ^ Options -> Block -- ^ Block element -> TW m String blockToTextile _ Null = return "" blockToTextile opts (Div attr bs) = do let startTag = render Nothing $ tagWithAttrs "div" attr let endTag = "" contents <- blockListToTextile opts bs return $ startTag ++ "\n\n" ++ contents ++ "\n\n" ++ endTag ++ "\n" blockToTextile opts (Plain inlines) = inlineListToTextile opts inlines -- title beginning with fig: indicates that the image is a figure blockToTextile opts (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do capt <- blockToTextile opts (Para txt) im <- inlineToTextile opts (Image attr txt (src,tit)) return $ im ++ "\n" ++ capt blockToTextile opts (Para inlines) = do useTags <- gets stUseTags listLevel <- gets stListLevel contents <- inlineListToTextile opts inlines return $ if useTags then "

" ++ contents ++ "

" else contents ++ if null listLevel then "\n" else "" blockToTextile opts (LineBlock lns) = blockToTextile opts $ linesToPara lns blockToTextile _ b@(RawBlock f str) | f == Format "html" || f == Format "textile" = return str | otherwise = do report $ BlockNotRendered b return "" blockToTextile _ HorizontalRule = return "
\n" blockToTextile opts (Header level (ident,classes,keyvals) inlines) = do contents <- inlineListToTextile opts inlines let identAttr = if null ident then "" else ('#':ident) let attribs = if null identAttr && null classes then "" else "(" ++ unwords classes ++ identAttr ++ ")" let lang = maybe "" (\x -> "[" ++ x ++ "]") $ lookup "lang" keyvals let styles = maybe "" (\x -> "{" ++ x ++ "}") $ lookup "style" keyvals let prefix = 'h' : show level ++ attribs ++ styles ++ lang ++ ". " return $ prefix ++ contents ++ "\n" blockToTextile _ (CodeBlock (_,classes,_) str) | any (all isSpace) (lines str) = return $ "\n" ++ escapeStringForXML str ++ "\n\n" where classes' = if null classes then "" else " class=\"" ++ unwords classes ++ "\"" blockToTextile _ (CodeBlock (_,classes,_) str) = return $ "bc" ++ classes' ++ ". " ++ str ++ "\n\n" where classes' = if null classes then "" else "(" ++ unwords classes ++ ")" blockToTextile opts (BlockQuote bs@[Para _]) = do contents <- blockListToTextile opts bs return $ "bq. " ++ contents ++ "\n\n" blockToTextile opts (BlockQuote blocks) = do contents <- blockListToTextile opts blocks return $ "
\n\n" ++ contents ++ "\n
\n" blockToTextile opts (Table [] aligns widths headers rows') | all (==0) widths = do hs <- mapM (liftM (("_. " ++) . stripTrailingNewlines) . blockListToTextile opts) headers let cellsToRow cells = "|" ++ intercalate "|" cells ++ "|" let header = if all null headers then "" else cellsToRow hs ++ "\n" let blocksToCell (align, bs) = do contents <- stripTrailingNewlines <$> blockListToTextile opts bs let alignMarker = case align of AlignLeft -> "<. " AlignRight -> ">. " AlignCenter -> "=. " AlignDefault -> "" return $ alignMarker ++ contents let rowToCells = mapM blocksToCell . zip aligns bs <- mapM rowToCells rows' let body = unlines $ map cellsToRow bs return $ header ++ body blockToTextile opts (Table capt aligns widths headers rows') = do let alignStrings = map alignmentToString aligns captionDoc <- if null capt then return "" else do c <- inlineListToTextile opts capt return $ "" ++ c ++ "\n" let percent w = show (truncate (100*w) :: Integer) ++ "%" let coltags = if all (== 0.0) widths then "" else unlines $ map (\w -> "") widths head' <- if all null headers then return "" else do hs <- tableRowToTextile opts alignStrings 0 headers return $ "\n" ++ hs ++ "\n\n" body' <- zipWithM (tableRowToTextile opts alignStrings) [1..] rows' return $ "\n" ++ captionDoc ++ coltags ++ head' ++ "\n" ++ unlines body' ++ "\n
\n" blockToTextile opts x@(BulletList items) = do oldUseTags <- gets stUseTags let useTags = oldUseTags || not (isSimpleList x) if useTags then do contents <- withUseTags $ mapM (listItemToTextile opts) items return $ "
    \n" ++ vcat contents ++ "\n
\n" else do modify $ \s -> s { stListLevel = stListLevel s ++ "*" } 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 <- gets stUseTags let useTags = oldUseTags || not (isSimpleList x) if useTags then do contents <- withUseTags $ mapM (listItemToTextile opts) items return $ "\n" ++ vcat contents ++ "\n\n" else do modify $ \s -> s { stListLevel = stListLevel s ++ "#" , stStartNum = if start > 1 then Just start else Nothing } level <- gets $ length . stListLevel contents <- mapM (listItemToTextile opts) items modify $ \s -> s { stListLevel = init (stListLevel s), stStartNum = Nothing } return $ vcat contents ++ (if level > 1 then "" else "\n") blockToTextile opts (DefinitionList items) = do contents <- withUseTags $ mapM (definitionListItemToTextile opts) items return $ "
\n" ++ vcat contents ++ "\n
\n" -- Auxiliary functions for lists: -- | Convert ordered list attributes to HTML attribute string listAttribsToString :: ListAttributes -> String listAttribsToString (startnum, numstyle, _) = let numstyle' = camelCaseToHyphenated $ show numstyle in (if startnum /= 1 then " start=\"" ++ show startnum ++ "\"" else "") ++ (if numstyle /= DefaultStyle then " style=\"list-style-type: " ++ numstyle' ++ ";\"" else "") -- | Convert bullet or ordered list item (list of blocks) to Textile. listItemToTextile :: PandocMonad m => WriterOptions -> [Block] -> TW m String listItemToTextile opts items = do contents <- blockListToTextile opts items useTags <- gets stUseTags if useTags then return $ "
  • " ++ contents ++ "
    • " else do marker <- gets stListLevel mbstart <- gets stStartNum case mbstart of Just n -> do modify $ \s -> s{ stStartNum = Nothing } return $ marker ++ show n ++ " " ++ contents Nothing -> return $ marker ++ " " ++ contents -- | Convert definition list item (label, list of blocks) to Textile. definitionListItemToTextile :: PandocMonad m => WriterOptions -> ([Inline],[[Block]]) -> TW m String definitionListItemToTextile opts (label, items) = do labelText <- inlineListToTextile opts label contents <- mapM (blockListToTextile opts) items return $ "
    " ++ labelText ++ "
    \n" ++ intercalate "\n" (map (\d -> "
    " ++ d ++ "
    ") contents) -- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed. isSimpleList :: Block -> Bool isSimpleList x = case x of BulletList items -> all isSimpleListItem items OrderedList (_, sty, _) items -> all isSimpleListItem items && sty `elem` [DefaultStyle, Decimal] _ -> False -- | True if list item can be handled with the simple wiki syntax. False if -- HTML tags will be needed. isSimpleListItem :: [Block] -> Bool isSimpleListItem [] = True isSimpleListItem [x] = case x of 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 isSimpleListItem _ = False isPlainOrPara :: Block -> Bool isPlainOrPara (Plain _) = True isPlainOrPara (Para _) = True isPlainOrPara _ = False -- | Concatenates strings with line breaks between them. vcat :: [String] -> String vcat = intercalate "\n" -- Auxiliary functions for tables. (TODO: these are common to HTML, MediaWiki, -- and Textile writers, and should be abstracted out.) 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" x | x `rem` 2 == 1 -> "odd" _ -> "even" cols'' <- zipWithM (\alignment item -> tableItemToTextile opts celltype alignment item) alignStrings cols' return $ "\n" ++ unlines cols'' ++ "" alignmentToString :: Alignment -> [Char] alignmentToString alignment = case alignment of AlignLeft -> "left" AlignRight -> "right" AlignCenter -> "center" AlignDefault -> "left" tableItemToTextile :: PandocMonad m => WriterOptions -> String -> String -> [Block] -> TW m String tableItemToTextile opts celltype align' item = do let mkcell x = "<" ++ celltype ++ " align=\"" ++ align' ++ "\">" ++ x ++ "" contents <- blockListToTextile opts item return $ mkcell contents -- | Convert list of Pandoc block elements to Textile. 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 :: PandocMonad m => WriterOptions -> [Inline] -> TW m String inlineListToTextile opts lst = mapM (inlineToTextile opts) lst >>= return . concat -- | Convert Pandoc inline element to Textile. inlineToTextile :: PandocMonad m => WriterOptions -> Inline -> TW m String inlineToTextile opts (Span _ lst) = inlineListToTextile opts lst inlineToTextile opts (Emph lst) = do contents <- inlineListToTextile opts lst return $ if '_' `elem` contents then "" ++ contents ++ "" else "_" ++ contents ++ "_" inlineToTextile opts (Strong lst) = do contents <- inlineListToTextile opts lst return $ if '*' `elem` contents then "" ++ contents ++ "" else "*" ++ contents ++ "*" inlineToTextile opts (Strikeout lst) = do contents <- inlineListToTextile opts lst return $ if '-' `elem` contents then "" ++ contents ++ "" else "-" ++ contents ++ "-" inlineToTextile opts (Superscript lst) = do contents <- inlineListToTextile opts lst return $ if '^' `elem` contents then "" ++ contents ++ "" else "[^" ++ contents ++ "^]" inlineToTextile opts (Subscript lst) = do contents <- inlineListToTextile opts lst return $ if '~' `elem` contents then "" ++ contents ++ "" else "[~" ++ contents ++ "~]" inlineToTextile opts (SmallCaps lst) = inlineListToTextile opts lst inlineToTextile opts (Quoted SingleQuote lst) = do contents <- inlineListToTextile opts lst return $ "'" ++ contents ++ "'" inlineToTextile opts (Quoted DoubleQuote lst) = do contents <- inlineListToTextile opts lst return $ "\"" ++ contents ++ "\"" inlineToTextile opts (Cite _ lst) = inlineListToTextile opts lst inlineToTextile _ (Code _ str) = return $ if '@' `elem` str then "" ++ escapeStringForXML str ++ "" else "@" ++ str ++ "@" inlineToTextile _ (Str str) = return $ escapeStringForTextile str inlineToTextile _ (Math _ str) = return $ "" ++ escapeStringForXML 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 = do report $ InlineNotRendered il return "" inlineToTextile _ LineBreak = return "\n" inlineToTextile _ SoftBreak = return " " inlineToTextile _ Space = return " " inlineToTextile opts (Link (_, cls, _) txt (src, _)) = do let classes = if null cls then "" else "(" ++ unwords cls ++ ")" label <- case txt of [Code _ s] | s == src -> return "$" [Str s] | s == src -> return "$" _ -> inlineListToTextile opts txt return $ "\"" ++ classes ++ label ++ "\":" ++ src inlineToTextile opts (Image attr@(_, cls, _) alt (source, tit)) = do alt' <- inlineListToTextile opts alt let txt = if null tit then if null alt' then "" else "(" ++ alt' ++ ")" else "(" ++ tit ++ ")" classes = if null cls then "" else "(" ++ unwords cls ++ ")" showDim dir = let toCss str = Just $ show dir ++ ":" ++ str ++ ";" in case dimension dir attr of Just (Percent a) -> toCss $ show (Percent a) Just dim -> toCss $ showInPixel opts dim ++ "px" Nothing -> Nothing styles = case (showDim Width, showDim Height) of (Just w, Just h) -> "{" ++ w ++ h ++ "}" (Just w, Nothing) -> "{" ++ w ++ "height:auto;}" (Nothing, Just h) -> "{" ++ "width:auto;" ++ h ++ "}" (Nothing, Nothing) -> "" return $ "!" ++ classes ++ styles ++ source ++ txt ++ "!" inlineToTextile opts (Note contents) = do curNotes <- gets stNotes let newnum = length curNotes + 1 contents' <- blockListToTextile opts contents let thisnote = "fn" ++ show newnum ++ ". " ++ contents' ++ "\n" modify $ \s -> s { stNotes = thisnote : curNotes } return $ "[" ++ show newnum ++ "]" -- note - may not work for notes with multiple blocks