Skip to content

Instantly share code, notes, and snippets.

@waltarix
Created October 13, 2016 12:44
Show Gist options
  • Save waltarix/541d35867e616831c282f94ce7d3e196 to your computer and use it in GitHub Desktop.
Save waltarix/541d35867e616831c282f94ce7d3e196 to your computer and use it in GitHub Desktop.
pandoc: Fix textile writer for Redmine.
diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs
index 98f9157..8e086e1 100644
--- a/src/Text/Pandoc/Writers/Textile.hs
+++ b/src/Text/Pandoc/Writers/Textile.hs
@@ -40,13 +40,13 @@ import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.XML ( escapeStringForXML )
import Data.List ( intercalate )
import Control.Monad.State
-import Data.Char ( isSpace )
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 :: [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
+ , stIsInBlockQuote :: Bool -- True if in a blockquote
}
-- | Convert Pandoc to Textile.
@@ -54,7 +54,7 @@ writeTextile :: WriterOptions -> Pandoc -> String
writeTextile opts document =
evalState (pandocToTextile opts document)
WriterState { stNotes = [], stListLevel = [], stStartNum = Nothing,
- stUseTags = False }
+ stUseTags = False, stIsInBlockQuote = False }
-- | Return Textile representation of document.
pandocToTextile :: WriterOptions -> Pandoc -> State WriterState String
@@ -77,6 +77,14 @@ withUseTags action = do
modify $ \s -> s { stUseTags = oldUseTags }
return result
+withInBlockQuote :: State WriterState a -> State WriterState a
+withInBlockQuote action = do
+ oldIsInBlockQuote <- liftM stIsInBlockQuote get
+ modify $ \s -> s { stIsInBlockQuote = True }
+ result <- action
+ modify $ \s -> s { stIsInBlockQuote = oldIsInBlockQuote }
+ return result
+
-- | Escape one character as needed for Textile.
escapeCharForTextile :: Char -> String
escapeCharForTextile x = case x of
@@ -125,16 +133,18 @@ blockToTextile opts (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do
blockToTextile opts (Para inlines) = do
useTags <- liftM stUseTags get
listLevel <- liftM stListLevel get
+ isInBlockQuote <- liftM stIsInBlockQuote get
contents <- inlineListToTextile opts inlines
+ let newline = if isInBlockQuote then "\n" else ""
return $ if useTags
then "<p>" ++ contents ++ "</p>"
- else contents ++ if null listLevel then "\n" else ""
+ else contents ++ if null listLevel then "\n" else newline
blockToTextile _ (RawBlock f str)
| f == Format "html" || f == Format "textile" = return str
| otherwise = return ""
-blockToTextile _ HorizontalRule = return "<hr />\n"
+blockToTextile _ HorizontalRule = return "---\n"
blockToTextile opts (Header level (ident,classes,keyvals) inlines) = do
contents <- inlineListToTextile opts inlines
@@ -147,31 +157,29 @@ blockToTextile opts (Header level (ident,classes,keyvals) inlines) = do
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 ++
- "\n</pre>\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 _ (CodeBlock (_,classes,_) str) = do
+ marker <- gets stListLevel
+ let classes' = if null classes
+ then ""
+ else " class=\"" ++ unwords classes ++ "\""
+ return $ "<pre><code" ++ classes' ++ ">\n" ++ str ++
+ "\n</code></pre>" ++ (if null marker then "\n" else "")
blockToTextile opts (BlockQuote blocks) = do
- contents <- blockListToTextile opts blocks
- return $ "<blockquote>\n\n" ++ contents ++ "\n</blockquote>\n"
+ contents <- withInBlockQuote $ blockListToTextile opts blocks
+ marker <- gets stListLevel
+ let keepEmptyLine s = if null s then "&nbsp;" else s
+ let contents' = unlines $ map keepEmptyLine $ lines contents
+ return $ if marker /= ""
+ then "\n bq. " ++ init contents'
+ else "bq. " ++ contents'
blockToTextile opts (Table [] aligns widths headers rows') |
all (==0) widths = do
hs <- mapM (liftM (("_. " ++) . stripTrailingNewlines) . blockListToTextile opts) headers
- let cellsToRow cells = "|" ++ intercalate "|" cells ++ "|"
+ marker <- gets stListLevel
+ let isInList = marker /= ""
+ let cellsToRow cells = (if isInList then " " else "") ++ "|" ++ intercalate "|" cells ++ "|"
let header = if all null headers then "" else cellsToRow hs ++ "\n"
let blocksToCell (align, bs) = do
contents <- stripTrailingNewlines <$> blockListToTextile opts bs
@@ -184,7 +192,9 @@ blockToTextile opts (Table [] aligns widths headers rows') |
let rowToCells = mapM blocksToCell . zip aligns
bs <- mapM rowToCells rows'
let body = unlines $ map cellsToRow bs
- return $ header ++ body
+ return $ if isInList
+ then init $ "\n" ++ header ++ body
+ else header ++ body
blockToTextile opts (Table capt aligns widths headers rows') = do
let alignStrings = map alignmentToString aligns
@@ -207,38 +217,23 @@ blockToTextile opts (Table capt aligns widths headers rows') = do
return $ "<table>\n" ++ captionDoc ++ coltags ++ head' ++
"<tbody>\n" ++ unlines body' ++ "</tbody>\n</table>\n"
-blockToTextile opts x@(BulletList items) = do
- oldUseTags <- liftM stUseTags get
- let useTags = oldUseTags || not (isSimpleList x)
- if useTags
- then do
- contents <- withUseTags $ mapM (listItemToTextile opts) items
- return $ "<ul>\n" ++ vcat contents ++ "\n</ul>\n"
- else do
- modify $ \s -> s { stListLevel = stListLevel s ++ "*" }
- level <- get >>= return . 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
- let useTags = oldUseTags || not (isSimpleList x)
- if useTags
- then do
- contents <- withUseTags $ mapM (listItemToTextile opts) items
- return $ "<ol" ++ listAttribsToString attribs ++ ">\n" ++ vcat contents ++
- "\n</ol>\n"
- else do
- modify $ \s -> s { stListLevel = stListLevel s ++ "#"
- , stStartNum = if start > 1
- then Just start
- else Nothing }
- level <- get >>= return . 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 (BulletList items) = do
+ modify $ \s -> s { stListLevel = stListLevel s ++ "*" }
+ level <- get >>= return . 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 (OrderedList (start, _, _) items) = do
+ modify $ \s -> s { stListLevel = stListLevel s ++ "#"
+ , stStartNum = if start > 1
+ then Just start
+ else Nothing }
+ level <- get >>= return . 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
@@ -246,32 +241,17 @@ blockToTextile opts (DefinitionList items) = do
-- 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 :: WriterOptions -> [Block] -> State WriterState String
listItemToTextile opts items = do
contents <- blockListToTextile opts items
- useTags <- get >>= return . stUseTags
- if useTags
- 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
+ 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 :: WriterOptions
@@ -283,38 +263,6 @@ definitionListItemToTextile opts (label, items) = do
return $ "<dt>" ++ labelText ++ "</dt>\n" ++
(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
-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"
@@ -418,7 +366,7 @@ inlineToTextile opts (Cite _ lst) = inlineListToTextile opts lst
inlineToTextile _ (Code _ str) =
return $ if '@' `elem` str
- then "<tt>" ++ escapeStringForXML str ++ "</tt>"
+ then "%{font-family: monospace}" ++ escapeStringForXML str ++ "%"
else "@" ++ str ++ "@"
inlineToTextile _ (Str str) = return $ escapeStringForTextile str
@@ -444,9 +392,9 @@ inlineToTextile opts (Link (_, cls, _) txt (src, _)) = do
else "(" ++ unwords cls ++ ")"
label <- case txt of
[Code _ s]
- | s == src -> return "$"
+ | s == src -> return src
[Str s]
- | s == src -> return "$"
+ | s == src -> return src
_ -> inlineListToTextile opts txt
return $ "\"" ++ classes ++ label ++ "\":" ++ src
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment