diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/Textile.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/Textile.hs | 246 |
1 files changed, 124 insertions, 122 deletions
diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index 1a7c386e0..c0c5727d7 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -1,4 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} {- | Module : Text.Pandoc.Writers.Textile Copyright : Copyright (C) 2010-2019 John MacFarlane @@ -16,8 +18,8 @@ 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 Data.Text (Text) +import qualified Data.Text as T import Text.Pandoc.Class (PandocMonad, report) import Text.Pandoc.Definition import Text.Pandoc.ImageSize @@ -30,10 +32,10 @@ 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 + stNotes :: [Text] -- 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 @@ -52,11 +54,11 @@ pandocToTextile :: PandocMonad m => WriterOptions -> Pandoc -> TW m Text pandocToTextile opts (Pandoc meta blocks) = do metadata <- metaToContext opts - (fmap (literal . pack) . blockListToTextile opts) - (fmap (literal . pack) . inlineListToTextile opts) meta + (fmap literal . blockListToTextile opts) + (fmap literal . inlineListToTextile opts) meta body <- blockListToTextile opts blocks - notes <- gets $ unlines . reverse . stNotes - let main = pack $ body ++ if null notes then "" else "\n\n" ++ notes + notes <- gets $ T.unlines . reverse . stNotes + let main = body <> if T.null notes then "" else "\n\n" <> notes let context = defField "body" main metadata return $ case writerTemplate opts of @@ -72,7 +74,7 @@ withUseTags action = do return result -- | Escape one character as needed for Textile. -escapeCharForTextile :: Char -> String +escapeCharForTextile :: Char -> Text escapeCharForTextile x = case x of '&' -> "&" '<' -> "<" @@ -88,17 +90,17 @@ escapeCharForTextile x = case x of '\x2013' -> " - " '\x2019' -> "'" '\x2026' -> "..." - c -> [c] + c -> T.singleton c -- | Escape string as needed for Textile. -escapeStringForTextile :: String -> String -escapeStringForTextile = concatMap escapeCharForTextile +escapeTextForTextile :: Text -> Text +escapeTextForTextile = T.concatMap escapeCharForTextile -- | Convert Pandoc block element to Textile. blockToTextile :: PandocMonad m => WriterOptions -- ^ Options -> Block -- ^ Block element - -> TW m String + -> TW m Text blockToTextile _ Null = return "" @@ -106,24 +108,24 @@ blockToTextile opts (Div attr bs) = do let startTag = render Nothing $ tagWithAttrs "div" attr let endTag = "</div>" contents <- blockListToTextile opts bs - return $ startTag ++ "\n\n" ++ contents ++ "\n\n" ++ endTag ++ "\n" + 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 +blockToTextile opts (Para [Image attr txt (src,T.stripPrefix "fig:" -> Just tit)]) = do capt <- blockToTextile opts (Para txt) im <- inlineToTextile opts (Image attr txt (src,tit)) - return $ im ++ "\n" ++ capt + return $ im <> "\n" <> capt blockToTextile opts (Para inlines) = do useTags <- gets stUseTags listLevel <- gets stListLevel contents <- inlineListToTextile opts inlines return $ if useTags - then "<p>" ++ contents ++ "</p>" - else contents ++ if null listLevel then "\n" else "" + then "<p>" <> contents <> "</p>" + else contents <> if null listLevel then "\n" else "" blockToTextile opts (LineBlock lns) = blockToTextile opts $ linesToPara lns @@ -138,41 +140,41 @@ blockToTextile _ HorizontalRule = return "<hr />\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 + let identAttr = if T.null ident then "" else "#" <> ident + let attribs = if T.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 $ "<pre" ++ classes' ++ ">\n" ++ escapeStringForXML str ++ + else "(" <> T.unwords classes <> identAttr <> ")" + let lang = maybe "" (\x -> "[" <> x <> "]") $ lookup "lang" keyvals + let styles = maybe "" (\x -> "{" <> x <> "}") $ lookup "style" keyvals + let prefix = "h" <> tshow level <> attribs <> styles <> lang <> ". " + return $ prefix <> contents <> "\n" + +blockToTextile _ (CodeBlock (_,classes,_) str) | any (T.all isSpace) (T.lines str) = + return $ "<pre" <> classes' <> ">\n" <> escapeStringForXML str <> "\n</pre>\n" where classes' = if null classes then "" - else " class=\"" ++ unwords classes ++ "\"" + else " class=\"" <> T.unwords classes <> "\"" blockToTextile _ (CodeBlock (_,classes,_) str) = - return $ "bc" ++ classes' ++ ". " ++ str ++ "\n\n" + return $ "bc" <> classes' <> ". " <> str <> "\n\n" where classes' = if null classes then "" - else "(" ++ unwords classes ++ ")" + else "(" <> T.unwords classes <> ")" blockToTextile opts (BlockQuote bs@[Para _]) = do contents <- blockListToTextile opts bs - return $ "bq. " ++ contents ++ "\n\n" + return $ "bq. " <> contents <> "\n\n" blockToTextile opts (BlockQuote blocks) = do contents <- blockListToTextile opts blocks - return $ "<blockquote>\n\n" ++ contents ++ "\n</blockquote>\n" + return $ "<blockquote>\n\n" <> contents <> "\n</blockquote>\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" + hs <- mapM (liftM (("_. " <>) . stripTrailingNewlines) . blockListToTextile opts) headers + let cellsToRow cells = "|" <> T.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 @@ -180,32 +182,32 @@ blockToTextile opts (Table [] aligns widths headers rows') | AlignRight -> ">. " AlignCenter -> "=. " AlignDefault -> "" - return $ alignMarker ++ contents + return $ alignMarker <> contents let rowToCells = mapM blocksToCell . zip aligns bs <- mapM rowToCells rows' - let body = unlines $ map cellsToRow bs - return $ header ++ body + let body = T.unlines $ map cellsToRow bs + return $ header <> body blockToTextile opts (Table capt aligns widths headers rows') = do - let alignStrings = map alignmentToString aligns + let alignStrings = map alignmentToText aligns captionDoc <- if null capt then return "" else do c <- inlineListToTextile opts capt - return $ "<caption>" ++ c ++ "</caption>\n" - let percent w = show (truncate (100*w) :: Integer) ++ "%" + return $ "<caption>" <> c <> "</caption>\n" + let percent w = tshow (truncate (100*w) :: Integer) <> "%" let coltags = if all (== 0.0) widths then "" - else unlines $ map - (\w -> "<col width=\"" ++ percent w ++ "\" />") widths + else T.unlines $ map + (\w -> "<col width=\"" <> percent w <> "\" />") widths head' <- if all null headers then return "" else do hs <- tableRowToTextile opts alignStrings 0 headers - return $ "<thead>\n" ++ hs ++ "\n</thead>\n" + return $ "<thead>\n" <> hs <> "\n</thead>\n" body' <- zipWithM (tableRowToTextile opts alignStrings) [1..] rows' - return $ "<table>\n" ++ captionDoc ++ coltags ++ head' ++ - "<tbody>\n" ++ unlines body' ++ "</tbody>\n</table>\n" + return $ "<table>\n" <> captionDoc <> coltags <> head' <> + "<tbody>\n" <> T.unlines body' <> "</tbody>\n</table>\n" blockToTextile opts x@(BulletList items) = do oldUseTags <- gets stUseTags @@ -213,13 +215,13 @@ blockToTextile opts x@(BulletList items) = do if useTags then do contents <- withUseTags $ mapM (listItemToTextile opts) items - return $ "<ul>\n" ++ vcat contents ++ "\n</ul>\n" + return $ "<ul>\n" <> vcat contents <> "\n</ul>\n" else do - modify $ \s -> s { stListLevel = stListLevel s ++ "*" } + 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") + return $ vcat contents <> (if level > 1 then "" else "\n") blockToTextile opts x@(OrderedList attribs@(start, _, _) items) = do oldUseTags <- gets stUseTags @@ -227,10 +229,10 @@ blockToTextile opts x@(OrderedList attribs@(start, _, _) items) = do if useTags then do contents <- withUseTags $ mapM (listItemToTextile opts) items - return $ "<ol" ++ listAttribsToString attribs ++ ">\n" ++ vcat contents ++ + return $ "<ol" <> listAttribsToString attribs <> ">\n" <> vcat contents <> "\n</ol>\n" else do - modify $ \s -> s { stListLevel = stListLevel s ++ "#" + modify $ \s -> s { stListLevel = stListLevel s <> "#" , stStartNum = if start > 1 then Just start else Nothing } @@ -238,52 +240,52 @@ blockToTextile opts x@(OrderedList attribs@(start, _, _) items) = do contents <- mapM (listItemToTextile opts) items modify $ \s -> s { stListLevel = init (stListLevel s), stStartNum = Nothing } - return $ vcat contents ++ (if level > 1 then "" else "\n") + return $ vcat contents <> (if level > 1 then "" else "\n") blockToTextile opts (DefinitionList items) = do contents <- withUseTags $ mapM (definitionListItemToTextile opts) items - return $ "<dl>\n" ++ vcat contents ++ "\n</dl>\n" + return $ "<dl>\n" <> vcat contents <> "\n</dl>\n" -- Auxiliary functions for lists: -- | Convert ordered list attributes to HTML attribute string -listAttribsToString :: ListAttributes -> String +listAttribsToString :: ListAttributes -> Text listAttribsToString (startnum, numstyle, _) = - let numstyle' = camelCaseToHyphenated $ show numstyle + let numstyle' = camelCaseToHyphenated $ tshow numstyle in (if startnum /= 1 - then " start=\"" ++ show startnum ++ "\"" - else "") ++ + then " start=\"" <> tshow startnum <> "\"" + else "") <> (if numstyle /= DefaultStyle - then " style=\"list-style-type: " ++ numstyle' ++ ";\"" + 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 + => WriterOptions -> [Block] -> TW m Text listItemToTextile opts items = do contents <- blockListToTextile opts items useTags <- gets stUseTags if useTags - then return $ "<li>" ++ contents ++ "</li>" + then return $ "<li>" <> contents <> "</li>" 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 + return $ T.pack marker <> tshow n <> " " <> contents + Nothing -> return $ T.pack marker <> " " <> contents -- | Convert definition list item (label, list of blocks) to Textile. definitionListItemToTextile :: PandocMonad m => WriterOptions -> ([Inline],[[Block]]) - -> TW m String + -> TW m Text 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) + return $ "<dt>" <> labelText <> "</dt>\n" <> + T.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 @@ -318,18 +320,18 @@ isPlainOrPara (Para _) = True isPlainOrPara _ = False -- | Concatenates strings with line breaks between them. -vcat :: [String] -> String -vcat = intercalate "\n" +vcat :: [Text] -> Text +vcat = T.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] + -> [Text] -> Int -> [[Block]] - -> TW m String + -> TW m Text tableRowToTextile opts alignStrings rownum cols' = do let celltype = if rownum == 0 then "th" else "td" let rowclass = case rownum of @@ -339,10 +341,10 @@ tableRowToTextile opts alignStrings rownum cols' = do cols'' <- zipWithM (\alignment item -> tableItemToTextile opts celltype alignment item) alignStrings cols' - return $ "<tr class=\"" ++ rowclass ++ "\">\n" ++ unlines cols'' ++ "</tr>" + return $ "<tr class=\"" <> rowclass <> "\">\n" <> T.unlines cols'' <> "</tr>" -alignmentToString :: Alignment -> [Char] -alignmentToString alignment = case alignment of +alignmentToText :: Alignment -> Text +alignmentToText alignment = case alignment of AlignLeft -> "left" AlignRight -> "right" AlignCenter -> "center" @@ -350,13 +352,13 @@ alignmentToString alignment = case alignment of tableItemToTextile :: PandocMonad m => WriterOptions - -> String - -> String + -> Text + -> Text -> [Block] - -> TW m String + -> TW m Text tableItemToTextile opts celltype align' item = do - let mkcell x = "<" ++ celltype ++ " align=\"" ++ align' ++ "\">" ++ - x ++ "</" ++ celltype ++ ">" + let mkcell x = "<" <> celltype <> " align=\"" <> align' <> "\">" <> + x <> "</" <> celltype <> ">" contents <- blockListToTextile opts item return $ mkcell contents @@ -364,73 +366,73 @@ tableItemToTextile opts celltype align' item = do blockListToTextile :: PandocMonad m => WriterOptions -- ^ Options -> [Block] -- ^ List of block elements - -> TW m String + -> TW m Text blockListToTextile opts blocks = vcat <$> mapM (blockToTextile opts) blocks -- | Convert list of Pandoc inline elements to Textile. inlineListToTextile :: PandocMonad m - => WriterOptions -> [Inline] -> TW m String + => WriterOptions -> [Inline] -> TW m Text inlineListToTextile opts lst = - concat <$> mapM (inlineToTextile opts) lst + T.concat <$> mapM (inlineToTextile opts) lst -- | Convert Pandoc inline element to Textile. -inlineToTextile :: PandocMonad m => WriterOptions -> Inline -> TW m String +inlineToTextile :: PandocMonad m => WriterOptions -> Inline -> TW m Text inlineToTextile opts (Span _ lst) = inlineListToTextile opts lst inlineToTextile opts (Emph lst) = do contents <- inlineListToTextile opts lst - return $ if '_' `elem` contents - then "<em>" ++ contents ++ "</em>" - else "_" ++ contents ++ "_" + return $ if '_' `elemText` contents + then "<em>" <> contents <> "</em>" + else "_" <> contents <> "_" inlineToTextile opts (Strong lst) = do contents <- inlineListToTextile opts lst - return $ if '*' `elem` contents - then "<strong>" ++ contents ++ "</strong>" - else "*" ++ contents ++ "*" + return $ if '*' `elemText` contents + then "<strong>" <> contents <> "</strong>" + else "*" <> contents <> "*" inlineToTextile opts (Strikeout lst) = do contents <- inlineListToTextile opts lst - return $ if '-' `elem` contents - then "<del>" ++ contents ++ "</del>" - else "-" ++ contents ++ "-" + return $ if '-' `elemText` contents + then "<del>" <> contents <> "</del>" + else "-" <> contents <> "-" inlineToTextile opts (Superscript lst) = do contents <- inlineListToTextile opts lst - return $ if '^' `elem` contents - then "<sup>" ++ contents ++ "</sup>" - else "[^" ++ contents ++ "^]" + return $ if '^' `elemText` contents + then "<sup>" <> contents <> "</sup>" + else "[^" <> contents <> "^]" inlineToTextile opts (Subscript lst) = do contents <- inlineListToTextile opts lst - return $ if '~' `elem` contents - then "<sub>" ++ contents ++ "</sub>" - else "[~" ++ contents ++ "~]" + return $ if '~' `elemText` contents + then "<sub>" <> contents <> "</sub>" + else "[~" <> contents <> "~]" inlineToTextile opts (SmallCaps lst) = inlineListToTextile opts lst inlineToTextile opts (Quoted SingleQuote lst) = do contents <- inlineListToTextile opts lst - return $ "'" ++ contents ++ "'" + return $ "'" <> contents <> "'" inlineToTextile opts (Quoted DoubleQuote lst) = do contents <- inlineListToTextile opts lst - return $ "\"" ++ contents ++ "\"" + return $ "\"" <> contents <> "\"" inlineToTextile opts (Cite _ lst) = inlineListToTextile opts lst inlineToTextile _ (Code _ str) = - return $ if '@' `elem` str - then "<tt>" ++ escapeStringForXML str ++ "</tt>" - else "@" ++ str ++ "@" + return $ if '@' `elemText` str + then "<tt>" <> escapeStringForXML str <> "</tt>" + else "@" <> str <> "@" -inlineToTextile _ (Str str) = return $ escapeStringForTextile str +inlineToTextile _ (Str str) = return $ escapeTextForTextile str inlineToTextile _ (Math _ str) = - return $ "<span class=\"math\">" ++ escapeStringForXML str ++ "</span>" + return $ "<span class=\"math\">" <> escapeStringForXML str <> "</span>" inlineToTextile opts il@(RawInline f str) | f == Format "html" || f == Format "textile" = return str @@ -455,36 +457,36 @@ inlineToTextile opts (Link (_, cls, _) txt (src, _)) = do _ -> inlineListToTextile opts txt let classes = if null cls || cls == ["uri"] && label == "$" then "" - else "(" ++ unwords cls ++ ")" - return $ "\"" ++ classes ++ label ++ "\":" ++ src + else "(" <> T.unwords cls <> ")" + 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' + let txt = if T.null tit + then if T.null alt' then "" - else "(" ++ alt' ++ ")" - else "(" ++ tit ++ ")" + else "(" <> alt' <> ")" + else "(" <> tit <> ")" classes = if null cls then "" - else "(" ++ unwords cls ++ ")" - showDim dir = let toCss str = Just $ show dir ++ ":" ++ str ++ ";" + else "(" <> T.unwords cls <> ")" + showDim dir = let toCss str = Just $ tshow dir <> ":" <> str <> ";" in case dimension dir attr of - Just (Percent a) -> toCss $ show (Percent a) - Just dim -> toCss $ showInPixel opts dim ++ "px" + Just (Percent a) -> toCss $ tshow (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 ++ "}" + (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 ++ "!" + 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" + let thisnote = "fn" <> tshow newnum <> ". " <> contents' <> "\n" modify $ \s -> s { stNotes = thisnote : curNotes } - return $ "[" ++ show newnum ++ "]" + return $ "[" <> tshow newnum <> "]" -- note - may not work for notes with multiple blocks |