From 6d7f0a1b816c405fb48bcf9736db17a0a7d49995 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Thu, 26 Jul 2012 22:32:53 -0700 Subject: Fixed whitespace errors. --- src/Text/Pandoc/Writers/ConTeXt.hs | 46 ++++++++++----------- src/Text/Pandoc/Writers/Docbook.hs | 66 ++++++++++++++--------------- src/Text/Pandoc/Writers/HTML.hs | 2 +- src/Text/Pandoc/Writers/Man.hs | 78 +++++++++++++++++------------------ src/Text/Pandoc/Writers/Markdown.hs | 40 +++++++++--------- src/Text/Pandoc/Writers/MediaWiki.hs | 46 ++++++++++----------- src/Text/Pandoc/Writers/Native.hs | 8 ++-- src/Text/Pandoc/Writers/Org.hs | 52 +++++++++++------------ src/Text/Pandoc/Writers/RST.hs | 48 +++++++++++----------- src/Text/Pandoc/Writers/RTF.hs | 80 ++++++++++++++++++------------------ src/Text/Pandoc/Writers/Texinfo.hs | 18 ++++---- src/Text/Pandoc/Writers/Textile.hs | 30 +++++++------- 12 files changed, 257 insertions(+), 257 deletions(-) (limited to 'src/Text/Pandoc/Writers') diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 964320eb2..fb832c7f5 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -20,10 +20,10 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.ConTeXt Copyright : Copyright (C) 2007-2010 John MacFarlane - License : GNU GPL, version 2 or above + License : GNU GPL, version 2 or above Maintainer : John MacFarlane - Stability : alpha + Stability : alpha Portability : portable Conversion of 'Pandoc' format into ConTeXt. @@ -39,23 +39,23 @@ import Text.Pandoc.Pretty import Text.Pandoc.Templates ( renderTemplate ) import Network.URI ( isURI, unEscapeString ) -data WriterState = +data WriterState = WriterState { stNextRef :: Int -- number of next URL reference , stOrderedListLevel :: Int -- level of ordered list , stOptions :: WriterOptions -- writer options } orderedListStyles :: [[Char]] -orderedListStyles = cycle ["[n]","[a]", "[r]", "[g]"] +orderedListStyles = cycle ["[n]","[a]", "[r]", "[g]"] -- | Convert Pandoc to ConTeXt. writeConTeXt :: WriterOptions -> Pandoc -> String -writeConTeXt options document = +writeConTeXt options document = let defaultWriterState = WriterState { stNextRef = 1 , stOrderedListLevel = 0 , stOptions = options - } - in evalState (pandocToConTeXt options document) defaultWriterState + } + in evalState (pandocToConTeXt options document) defaultWriterState pandocToConTeXt :: WriterOptions -> Pandoc -> State WriterState String pandocToConTeXt options (Pandoc (Meta title authors date) blocks) = do @@ -120,7 +120,7 @@ elementToConTeXt opts (Sec level _ id' title' elements) = do return $ vcat (header' : innerContents) -- | Convert Pandoc block element to ConTeXt. -blockToConTeXt :: Block +blockToConTeXt :: Block -> State WriterState Doc blockToConTeXt Null = return empty blockToConTeXt (Plain lst) = inlineListToConTeXt lst @@ -128,7 +128,7 @@ blockToConTeXt (Para [Image txt (src,_)]) = do capt <- inlineListToConTeXt txt return $ blankline $$ "\\placefigure[here,nonumber]" <> braces capt <> braces ("\\externalfigure" <> brackets (text src)) <> blankline -blockToConTeXt (Para lst) = do +blockToConTeXt (Para lst) = do contents <- inlineListToConTeXt lst return $ contents <> blankline blockToConTeXt (BlockQuote lst) = do @@ -147,18 +147,18 @@ blockToConTeXt (OrderedList (start, style', delim) lst) = do let level = stOrderedListLevel st put $ st {stOrderedListLevel = level + 1} contents <- mapM listItemToConTeXt lst - put $ st {stOrderedListLevel = level} + put $ st {stOrderedListLevel = level} let start' = if start == 1 then "" else "start=" ++ show start let delim' = case delim of DefaultDelim -> "" - Period -> "stopper=." - OneParen -> "stopper=)" + Period -> "stopper=." + OneParen -> "stopper=)" TwoParens -> "left=(,stopper=)" - let width = maximum $ map length $ take (length contents) + let width = maximum $ map length $ take (length contents) (orderedListMarkers (start, style', delim)) let width' = (toEnum width + 1) / 2 - let width'' = if width' > (1.5 :: Double) - then "width=" ++ show width' ++ "em" + let width'' = if width' > (1.5 :: Double) + then "width=" ++ show width' ++ "em" else "" let specs2Items = filter (not . null) [start', delim', width''] let specs2 = if null specs2Items @@ -166,8 +166,8 @@ blockToConTeXt (OrderedList (start, style', delim) lst) = do else "[" ++ intercalate "," specs2Items ++ "]" let style'' = case style' of DefaultStyle -> orderedListStyles !! level - Decimal -> "[n]" - Example -> "[n]" + Decimal -> "[n]" + Example -> "[n]" LowerRoman -> "[r]" UpperRoman -> "[R]" LowerAlpha -> "[a]" @@ -182,21 +182,21 @@ blockToConTeXt HorizontalRule = return $ "\\thinrule" <> blankline blockToConTeXt (Header level lst) = sectionHeader "" level lst blockToConTeXt (Table caption aligns widths heads rows) = do let colDescriptor colWidth alignment = (case alignment of - AlignLeft -> 'l' + AlignLeft -> 'l' AlignRight -> 'r' AlignCenter -> 'c' AlignDefault -> 'l'): if colWidth == 0 then "|" else ("p(" ++ printf "%.2f" colWidth ++ "\\textwidth)|") - let colDescriptors = "|" ++ (concat $ + let colDescriptors = "|" ++ (concat $ zipWith colDescriptor widths aligns) headers <- if all null heads then return empty - else liftM ($$ "\\HL") $ tableRowToConTeXt heads - captionText <- inlineListToConTeXt caption + else liftM ($$ "\\HL") $ tableRowToConTeXt heads + captionText <- inlineListToConTeXt caption let captionText' = if null caption then text "none" else captionText - rows' <- mapM tableRowToConTeXt rows + rows' <- mapM tableRowToConTeXt rows return $ "\\placetable[here]" <> braces captionText' $$ "\\starttable" <> brackets (text colDescriptors) $$ "\\HL" $$ headers $$ @@ -230,7 +230,7 @@ inlineListToConTeXt lst = liftM hcat $ mapM inlineToConTeXt lst -- | Convert inline element to ConTeXt inlineToConTeXt :: Inline -- ^ Inline to convert -> State WriterState Doc -inlineToConTeXt (Emph lst) = do +inlineToConTeXt (Emph lst) = do contents <- inlineListToConTeXt lst return $ braces $ "\\em " <> contents inlineToConTeXt (Strong lst) = do diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index 1bcf99dcf..74bc0a366 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.Docbook Copyright : Copyright (C) 2006-2010 John MacFarlane - License : GNU GPL, version 2 or above + License : GNU GPL, version 2 or above Maintainer : John MacFarlane Stability : alpha @@ -47,23 +47,23 @@ authorToDocbook opts name' = let name = render Nothing $ inlinesToDocbook opts name' in if ',' `elem` name then -- last name first - let (lastname, rest) = break (==',') name + let (lastname, rest) = break (==',') name firstname = removeLeadingSpace rest in - inTagsSimple "firstname" (text $ escapeStringForXML firstname) <> - inTagsSimple "surname" (text $ escapeStringForXML lastname) + inTagsSimple "firstname" (text $ escapeStringForXML firstname) <> + inTagsSimple "surname" (text $ escapeStringForXML lastname) else -- last name last let namewords = words name - lengthname = length namewords + lengthname = length namewords (firstname, lastname) = case lengthname of - 0 -> ("","") + 0 -> ("","") 1 -> ("", name) n -> (intercalate " " (take (n-1) namewords), last namewords) - in inTagsSimple "firstname" (text $ escapeStringForXML firstname) $$ - inTagsSimple "surname" (text $ escapeStringForXML lastname) + in inTagsSimple "firstname" (text $ escapeStringForXML firstname) $$ + inTagsSimple "surname" (text $ escapeStringForXML lastname) -- | Convert Pandoc document to string in Docbook format. writeDocbook :: WriterOptions -> Pandoc -> String -writeDocbook opts (Pandoc (Meta tit auths dat) blocks) = +writeDocbook opts (Pandoc (Meta tit auths dat) blocks) = let title = inlinesToDocbook opts tit authors = map (authorToDocbook opts) auths date = inlinesToDocbook opts dat @@ -92,7 +92,7 @@ writeDocbook opts (Pandoc (Meta tit auths dat) blocks) = -- | Convert an Element to Docbook. elementToDocbook :: WriterOptions -> Int -> Element -> Doc -elementToDocbook opts _ (Blk block) = blockToDocbook opts block +elementToDocbook opts _ (Blk block) = blockToDocbook opts block elementToDocbook opts lvl (Sec _ _num id' title elements) = -- Docbook doesn't allow sections with no content, so insert some if needed let elements' = if null elements @@ -115,10 +115,10 @@ plainToPara :: Block -> Block plainToPara (Plain x) = Para x plainToPara x = x --- | Convert a list of pairs of terms and definitions into a list of +-- | Convert a list of pairs of terms and definitions into a list of -- Docbook varlistentrys. deflistItemsToDocbook :: WriterOptions -> [([Inline],[[Block]])] -> Doc -deflistItemsToDocbook opts items = +deflistItemsToDocbook opts items = vcat $ map (\(term, defs) -> deflistItemToDocbook opts term defs) items -- | Convert a term and a list of blocks into a Docbook varlistentry. @@ -167,9 +167,9 @@ blockToDocbook _ (CodeBlock (_,classes,_) str) = then [s] else languagesByExtension . map toLower $ s langs = concatMap langsFrom classes -blockToDocbook opts (BulletList lst) = - inTagsIndented "itemizedlist" $ listItemsToDocbook opts lst -blockToDocbook _ (OrderedList _ []) = empty +blockToDocbook opts (BulletList lst) = + inTagsIndented "itemizedlist" $ listItemsToDocbook opts lst +blockToDocbook _ (OrderedList _ []) = empty blockToDocbook opts (OrderedList (start, numstyle, _) (first:rest)) = let attribs = case numstyle of DefaultStyle -> [] @@ -182,12 +182,12 @@ blockToDocbook opts (OrderedList (start, numstyle, _) (first:rest)) = items = if start == 1 then listItemsToDocbook opts (first:rest) else (inTags True "listitem" [("override",show start)] - (blocksToDocbook opts $ map plainToPara first)) $$ - listItemsToDocbook opts rest + (blocksToDocbook opts $ map plainToPara first)) $$ + listItemsToDocbook opts rest in inTags True "orderedlist" attribs items -blockToDocbook opts (DefinitionList lst) = - inTagsIndented "variablelist" $ deflistItemsToDocbook opts lst -blockToDocbook _ (RawBlock "docbook" str) = text str -- raw XML block +blockToDocbook opts (DefinitionList lst) = + inTagsIndented "variablelist" $ deflistItemsToDocbook opts lst +blockToDocbook _ (RawBlock "docbook" str) = text str -- raw XML block -- we allow html for compatibility with earlier versions of pandoc blockToDocbook _ (RawBlock "html" str) = text str -- raw XML block blockToDocbook _ (RawBlock _ _) = empty @@ -237,26 +237,26 @@ inlinesToDocbook opts lst = hcat $ map (inlineToDocbook opts) lst -- | Convert an inline element to Docbook. inlineToDocbook :: WriterOptions -> Inline -> Doc -inlineToDocbook _ (Str str) = text $ escapeStringForXML str -inlineToDocbook opts (Emph lst) = +inlineToDocbook _ (Str str) = text $ escapeStringForXML str +inlineToDocbook opts (Emph lst) = inTagsSimple "emphasis" $ inlinesToDocbook opts lst -inlineToDocbook opts (Strong lst) = +inlineToDocbook opts (Strong lst) = inTags False "emphasis" [("role", "strong")] $ inlinesToDocbook opts lst -inlineToDocbook opts (Strikeout lst) = +inlineToDocbook opts (Strikeout lst) = inTags False "emphasis" [("role", "strikethrough")] $ inlinesToDocbook opts lst -inlineToDocbook opts (Superscript lst) = +inlineToDocbook opts (Superscript lst) = inTagsSimple "superscript" $ inlinesToDocbook opts lst -inlineToDocbook opts (Subscript lst) = +inlineToDocbook opts (Subscript lst) = inTagsSimple "subscript" $ inlinesToDocbook opts lst -inlineToDocbook opts (SmallCaps lst) = +inlineToDocbook opts (SmallCaps lst) = inTags False "emphasis" [("role", "smallcaps")] $ inlinesToDocbook opts lst -inlineToDocbook opts (Quoted _ lst) = +inlineToDocbook opts (Quoted _ lst) = inTagsSimple "quote" $ inlinesToDocbook opts lst inlineToDocbook opts (Cite _ lst) = - inlinesToDocbook opts lst -inlineToDocbook _ (Code _ str) = + inlinesToDocbook opts lst +inlineToDocbook _ (Code _ str) = inTagsSimple "literal" $ text (escapeStringForXML str) inlineToDocbook opts (Math t str) | isMathML (writerHTMLMathMethod opts) = @@ -282,7 +282,7 @@ inlineToDocbook _ Space = space inlineToDocbook opts (Link txt (src, _)) = if isPrefixOf "mailto:" src then let src' = drop 7 src - emailLink = inTagsSimple "email" $ text $ + emailLink = inTagsSimple "email" $ text $ escapeStringForXML $ src' in case txt of [Code _ s] | s == src' -> emailLink @@ -292,14 +292,14 @@ inlineToDocbook opts (Link txt (src, _)) = then inTags False "link" [("linkend", drop 1 src)] else inTags False "ulink" [("url", src)]) $ inlinesToDocbook opts txt -inlineToDocbook _ (Image _ (src, tit)) = +inlineToDocbook _ (Image _ (src, tit)) = let titleDoc = if null tit then empty else inTagsIndented "objectinfo" $ inTagsIndented "title" (text $ escapeStringForXML tit) in inTagsIndented "inlinemediaobject" $ inTagsIndented "imageobject" $ titleDoc $$ selfClosingTag "imagedata" [("fileref", src)] -inlineToDocbook opts (Note contents) = +inlineToDocbook opts (Note contents) = inTagsIndented "footnote" $ blocksToDocbook opts contents isMathML :: HTMLMathMethod -> Bool diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index cafb6ca74..c7bab7260 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -618,7 +618,7 @@ inlineToHtml opts inline = ! A.src (toValue $ url ++ urlEncode str) ! A.alt (toValue str) ! A.title (toValue str) - let brtag = if writerHtml5 opts then H5.br else H.br + let brtag = if writerHtml5 opts then H5.br else H.br return $ case t of InlineMath -> m DisplayMath -> brtag >> m >> brtag diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index c481e6c87..f6f570042 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -17,9 +17,9 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | - Module : Text.Pandoc.Writers.Man + Module : Text.Pandoc.Writers.Man Copyright : Copyright (C) 2007-2010 John MacFarlane - License : GNU GPL, version 2 or above + License : GNU GPL, version 2 or above Maintainer : John MacFarlane Stability : alpha @@ -44,21 +44,21 @@ data WriterState = WriterState { stNotes :: Notes -- | Convert Pandoc to Man. writeMan :: WriterOptions -> Pandoc -> String -writeMan opts document = evalState (pandocToMan opts document) (WriterState [] False) +writeMan opts document = evalState (pandocToMan opts document) (WriterState [] False) -- | Return groff man representation of document. pandocToMan :: WriterOptions -> Pandoc -> State WriterState String pandocToMan opts (Pandoc (Meta title authors date) blocks) = do titleText <- inlineListToMan opts title authors' <- mapM (inlineListToMan opts) authors - date' <- inlineListToMan opts date + date' <- inlineListToMan opts date let colwidth = if writerWrapText opts then Just $ writerColumns opts else Nothing let render' = render colwidth let (cmdName, rest) = break (== ' ') $ render' titleText let (title', section) = case reverse cmdName of - (')':d:'(':xs) | d `elem` ['0'..'9'] -> + (')':d:'(':xs) | d `elem` ['0'..'9'] -> (text (reverse xs), char d) xs -> (text (reverse xs), doubleQuotes empty) let description = hsep $ @@ -86,7 +86,7 @@ notesToMan :: WriterOptions -> [[Block]] -> State WriterState Doc notesToMan opts notes = if null notes then return empty - else mapM (\(num, note) -> noteToMan opts num note) (zip [1..] notes) >>= + else mapM (\(num, note) -> noteToMan opts num note) (zip [1..] notes) >>= return . (text ".SH NOTES" $$) . vcat -- | Return man representation of a note. @@ -94,7 +94,7 @@ noteToMan :: WriterOptions -> Int -> [Block] -> State WriterState Doc noteToMan opts num note = do contents <- blockListToMan opts note let marker = cr <> text ".SS " <> brackets (text (show num)) - return $ marker $$ contents + return $ marker $$ contents -- | Association list of characters to escape. manEscapes :: [(Char, String)] @@ -113,7 +113,7 @@ escapeString = escapeStringUsing manEscapes -- | Escape a literal (code) section for Man. escapeCode :: String -> String escapeCode = concat . intersperse "\n" . map escapeLine . lines where - escapeLine codeline = + escapeLine codeline = case escapeStringUsing (manEscapes ++ backslashEscapes "\t ") codeline of a@('.':_) -> "\\&" ++ a b -> b @@ -150,14 +150,14 @@ splitSentences xs = -- | Convert Pandoc block element to man. blockToMan :: WriterOptions -- ^ Options -> Block -- ^ Block element - -> State WriterState Doc + -> State WriterState Doc blockToMan _ Null = return empty -blockToMan opts (Plain inlines) = +blockToMan opts (Plain inlines) = liftM vcat $ mapM (inlineListToMan opts) $ splitSentences inlines blockToMan opts (Para inlines) = do contents <- liftM vcat $ mapM (inlineListToMan opts) $ splitSentences inlines - return $ text ".PP" $$ contents + return $ text ".PP" $$ contents blockToMan _ (RawBlock "man" str) = return $ text str blockToMan _ (RawBlock _ _) = return empty blockToMan _ HorizontalRule = return $ text ".PP" $$ text " * * * * *" @@ -166,7 +166,7 @@ blockToMan opts (Header level inlines) = do let heading = case level of 1 -> ".SH " _ -> ".SS " - return $ text heading <> contents + return $ text heading <> contents blockToMan _ (CodeBlock _ str) = return $ text ".IP" $$ text ".nf" $$ @@ -174,10 +174,10 @@ blockToMan _ (CodeBlock _ str) = return $ text (escapeCode str) $$ text "\\f[]" $$ text ".fi" -blockToMan opts (BlockQuote blocks) = do +blockToMan opts (BlockQuote blocks) = do contents <- blockListToMan opts blocks return $ text ".RS" $$ contents $$ text ".RE" -blockToMan opts (Table caption alignments widths headers rows) = +blockToMan opts (Table caption alignments widths headers rows) = let aligncode AlignLeft = "l" aligncode AlignRight = "r" aligncode AlignCenter = "c" @@ -190,53 +190,53 @@ blockToMan opts (Table caption alignments widths headers rows) = else map (printf "w(%0.2fn)" . (70 *)) widths -- 78n default width - 8n indent = 70n let coldescriptions = text $ intercalate " " - (zipWith (\align width -> aligncode align ++ width) + (zipWith (\align width -> aligncode align ++ width) alignments iwidths) ++ "." colheadings <- mapM (blockListToMan opts) headers - let makeRow cols = text "T{" $$ - (vcat $ intersperse (text "T}@T{") cols) $$ + let makeRow cols = text "T{" $$ + (vcat $ intersperse (text "T}@T{") cols) $$ text "T}" let colheadings' = if all null headers then empty else makeRow colheadings $$ char '_' - body <- mapM (\row -> do + body <- mapM (\row -> do cols <- mapM (blockListToMan opts) row return $ makeRow cols) rows - return $ text ".PP" $$ caption' $$ - text ".TS" $$ text "tab(@);" $$ coldescriptions $$ + return $ text ".PP" $$ caption' $$ + text ".TS" $$ text "tab(@);" $$ coldescriptions $$ colheadings' $$ vcat body $$ text ".TE" blockToMan opts (BulletList items) = do contents <- mapM (bulletListItemToMan opts) items - return (vcat contents) + return (vcat contents) blockToMan opts (OrderedList attribs items) = do - let markers = take (length items) $ orderedListMarkers attribs + let markers = take (length items) $ orderedListMarkers attribs let indent = 1 + (maximum $ map length markers) contents <- mapM (\(num, item) -> orderedListItemToMan opts num indent item) $ - zip markers items + zip markers items return (vcat contents) -blockToMan opts (DefinitionList items) = do +blockToMan opts (DefinitionList items) = do contents <- mapM (definitionListItemToMan opts) items return (vcat contents) -- | Convert bullet list item (list of blocks) to man. bulletListItemToMan :: WriterOptions -> [Block] -> State WriterState Doc bulletListItemToMan _ [] = return empty -bulletListItemToMan opts ((Para first):rest) = +bulletListItemToMan opts ((Para first):rest) = bulletListItemToMan opts ((Plain first):rest) bulletListItemToMan opts ((Plain first):rest) = do - first' <- blockToMan opts (Plain first) + first' <- blockToMan opts (Plain first) rest' <- blockListToMan opts rest let first'' = text ".IP \\[bu] 2" $$ first' let rest'' = if null rest then empty else text ".RS 2" $$ rest' $$ text ".RE" - return (first'' $$ rest'') + return (first'' $$ rest'') bulletListItemToMan opts (first:rest) = do first' <- blockToMan opts first rest' <- blockListToMan opts rest return $ text "\\[bu] .RS 2" $$ first' $$ rest' $$ text ".RE" - + -- | Convert ordered list item (a list of blocks) to man. orderedListItemToMan :: WriterOptions -- ^ options -> String -- ^ order marker for list item @@ -244,7 +244,7 @@ orderedListItemToMan :: WriterOptions -- ^ options -> [Block] -- ^ list item (list of blocks) -> State WriterState Doc orderedListItemToMan _ _ _ [] = return empty -orderedListItemToMan opts num indent ((Para first):rest) = +orderedListItemToMan opts num indent ((Para first):rest) = orderedListItemToMan opts num indent ((Plain first):rest) orderedListItemToMan opts num indent (first:rest) = do first' <- blockToMan opts first @@ -254,17 +254,17 @@ orderedListItemToMan opts num indent (first:rest) = do let rest'' = if null rest then empty else text ".RS 4" $$ rest' $$ text ".RE" - return $ first'' $$ rest'' + return $ first'' $$ rest'' -- | Convert definition list item (label, list of blocks) to man. definitionListItemToMan :: WriterOptions - -> ([Inline],[[Block]]) + -> ([Inline],[[Block]]) -> State WriterState Doc definitionListItemToMan opts (label, defs) = do labelText <- inlineListToMan opts label - contents <- if null defs + contents <- if null defs then return empty - else liftM vcat $ forM defs $ \blocks -> do + else liftM vcat $ forM defs $ \blocks -> do let (first, rest) = case blocks of ((Para x):y) -> (Plain x,y) (x:y) -> (x,y) @@ -278,7 +278,7 @@ definitionListItemToMan opts (label, defs) = do -- | Convert list of Pandoc block elements to man. blockListToMan :: WriterOptions -- ^ Options -> [Block] -- ^ List of block elements - -> State WriterState Doc + -> State WriterState Doc blockListToMan opts blocks = mapM (blockToMan opts) blocks >>= (return . vcat) @@ -292,7 +292,7 @@ inlineListToMan opts lst = mapM (inlineToMan opts) lst >>= (return . hcat) -- | Convert Pandoc inline element to man. inlineToMan :: WriterOptions -> Inline -> State WriterState Doc -inlineToMan opts (Emph lst) = do +inlineToMan opts (Emph lst) = do contents <- inlineListToMan opts lst return $ text "\\f[I]" <> contents <> text "\\f[]" inlineToMan opts (Strong lst) = do @@ -333,16 +333,16 @@ inlineToMan opts (Link txt (src, _)) = do let srcSuffix = if isPrefixOf "mailto:" src then drop 7 src else src return $ case txt of [Code _ s] - | s == srcSuffix -> char '<' <> text srcSuffix <> char '>' + | s == srcSuffix -> char '<' <> text srcSuffix <> char '>' _ -> linktext <> text " (" <> text src <> char ')' inlineToMan opts (Image alternate (source, tit)) = do - let txt = if (null alternate) || (alternate == [Str ""]) || + let txt = if (null alternate) || (alternate == [Str ""]) || (alternate == [Str source]) -- to prevent autolinks then [Str "image"] else alternate - linkPart <- inlineToMan opts (Link txt (source, tit)) + linkPart <- inlineToMan opts (Link txt (source, tit)) return $ char '[' <> text "IMAGE: " <> linkPart <> char ']' -inlineToMan _ (Note contents) = do +inlineToMan _ (Note contents) = do -- add to notes in state modify $ \st -> st{ stNotes = contents : stNotes st } notes <- liftM stNotes get diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 32b28a770..80f51dfc6 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -18,9 +18,9 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | - Module : Text.Pandoc.Writers.Markdown + Module : Text.Pandoc.Writers.Markdown Copyright : Copyright (C) 2006-2010 John MacFarlane - License : GNU GPL, version 2 or above + License : GNU GPL, version 2 or above Maintainer : John MacFarlane Stability : alpha @@ -48,7 +48,7 @@ data WriterState = WriterState { stNotes :: Notes -- | Convert Pandoc to Markdown. writeMarkdown :: WriterOptions -> Pandoc -> String -writeMarkdown opts document = +writeMarkdown opts document = evalState (pandocToMarkdown opts document) WriterState{ stNotes = [] , stRefs = [] , stPlain = False } @@ -88,7 +88,7 @@ pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do date' <- inlineListToMarkdown opts date let titleblock = not $ null title && null authors && null date let headerBlocks = filter isHeaderBlock blocks - let toc = if writerTableOfContents opts + let toc = if writerTableOfContents opts then tableOfContents opts headerBlocks else empty body <- blockListToMarkdown opts blocks @@ -118,9 +118,9 @@ pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do refsToMarkdown :: WriterOptions -> Refs -> State WriterState Doc refsToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat --- | Return markdown representation of a reference key. -keyToMarkdown :: WriterOptions - -> ([Inline], (String, String)) +-- | Return markdown representation of a reference key. +keyToMarkdown :: WriterOptions + -> ([Inline], (String, String)) -> State WriterState Doc keyToMarkdown opts (label, (src, tit)) = do label' <- inlineListToMarkdown opts label @@ -132,7 +132,7 @@ keyToMarkdown opts (label, (src, tit)) = do -- | Return markdown representation of notes. notesToMarkdown :: WriterOptions -> [[Block]] -> State WriterState Doc -notesToMarkdown opts notes = +notesToMarkdown opts notes = mapM (\(num, note) -> noteToMarkdown opts num note) (zip [1..] notes) >>= return . vsep @@ -154,7 +154,7 @@ escapeString = escapeStringUsing markdownEscapes where markdownEscapes = backslashEscapes "\\`*_$<>#~^" -- | Construct table of contents from list of header blocks. -tableOfContents :: WriterOptions -> [Block] -> Doc +tableOfContents :: WriterOptions -> [Block] -> Doc tableOfContents opts headers = let opts' = opts { writerIgnoreNotes = True } contents = BulletList $ map elementToListItem $ hierarchicalize headers @@ -165,7 +165,7 @@ tableOfContents opts headers = -- | Converts an Element to a list item for a table of contents, elementToListItem :: Element -> [Block] elementToListItem (Blk _) = [] -elementToListItem (Sec _ _ _ headerText subsecs) = [Plain headerText] ++ +elementToListItem (Sec _ _ _ headerText subsecs) = [Plain headerText] ++ if null subsecs then [] else [BulletList $ map elementToListItem subsecs] @@ -189,7 +189,7 @@ attrsToMarkdown attribs = braces $ hsep [attribId, attribClasses, attribKeys] -- | Ordered list start parser for use in Para below. olMarker :: Parser [Char] ParserState Char olMarker = do (start, style', delim) <- anyOrderedListMarker - if delim == Period && + if delim == Period && (style' == UpperAlpha || (style' == UpperRoman && start `elem` [1, 5, 10, 50, 100, 500, 1000])) then spaceChar >> spaceChar @@ -205,7 +205,7 @@ beginsWithOrderedListMarker str = -- | Convert Pandoc block element to markdown. blockToMarkdown :: WriterOptions -- ^ Options -> Block -- ^ Block element - -> State WriterState Doc + -> State WriterState Doc blockToMarkdown _ Null = return empty blockToMarkdown opts (Plain inlines) = do contents <- inlineListToMarkdown opts inlines @@ -348,7 +348,7 @@ orderedListItemToMarkdown opts marker items = do -- | Convert definition list item (label, list of blocks) to markdown. definitionListItemToMarkdown :: WriterOptions - -> ([Inline],[[Block]]) + -> ([Inline],[[Block]]) -> State WriterState Doc definitionListItemToMarkdown opts (label, defs) = do labelText <- inlineListToMarkdown opts label @@ -365,7 +365,7 @@ definitionListItemToMarkdown opts (label, defs) = do -- | Convert list of Pandoc block elements to markdown. blockListToMarkdown :: WriterOptions -- ^ Options -> [Block] -- ^ List of block elements - -> State WriterState Doc + -> State WriterState Doc blockListToMarkdown opts blocks = mapM (blockToMarkdown opts) (fixBlocks blocks) >>= return . cat -- insert comment between list and indented code block, or the @@ -411,7 +411,7 @@ escapeSpaces x = x -- | Convert Pandoc inline element to markdown. inlineToMarkdown :: WriterOptions -> Inline -> State WriterState Doc -inlineToMarkdown opts (Emph lst) = do +inlineToMarkdown opts (Emph lst) = do contents <- inlineListToMarkdown opts lst return $ "*" <> contents <> "*" inlineToMarkdown opts (Strong lst) = do @@ -436,11 +436,11 @@ inlineToMarkdown opts (Quoted DoubleQuote lst) = do contents <- inlineListToMarkdown opts lst return $ "“" <> contents <> "”" inlineToMarkdown opts (Code attr str) = - let tickGroups = filter (\s -> '`' `elem` s) $ group str + let tickGroups = filter (\s -> '`' `elem` s) $ group str longest = if null tickGroups then 0 - else maximum $ map length tickGroups - marker = replicate (longest + 1) '`' + else maximum $ map length tickGroups + marker = replicate (longest + 1) '`' spacer = if (longest == 0) then "" else " " attrs = if writerStrictMarkdown opts || attr == nullAttr then empty @@ -512,7 +512,7 @@ inlineToMarkdown opts (Link txt (src, tit)) = do then "[]" else "[" <> reftext <> "]" in first <> second - else "[" <> linktext <> "](" <> + else "[" <> linktext <> "](" <> text src <> linktitle <> ")" inlineToMarkdown opts (Image alternate (source, tit)) = do let txt = if null alternate || alternate == [Str source] @@ -521,7 +521,7 @@ inlineToMarkdown opts (Image alternate (source, tit)) = do else alternate linkPart <- inlineToMarkdown opts (Link txt (source, tit)) return $ "!" <> linkPart -inlineToMarkdown _ (Note contents) = do +inlineToMarkdown _ (Note contents) = do modify (\st -> st{ stNotes = contents : stNotes st }) st <- get let ref = show $ (length $ stNotes st) diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index b32c5327d..a9e2a2c69 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -17,9 +17,9 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | - Module : Text.Pandoc.Writers.MediaWiki + Module : Text.Pandoc.Writers.MediaWiki Copyright : Copyright (C) 2008-2010 John MacFarlane - License : GNU GPL, version 2 or above + License : GNU GPL, version 2 or above Maintainer : John MacFarlane Stability : alpha @@ -31,7 +31,7 @@ MediaWiki: -} module Text.Pandoc.Writers.MediaWiki ( writeMediaWiki ) where import Text.Pandoc.Definition -import Text.Pandoc.Shared +import Text.Pandoc.Shared import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.XML ( escapeStringForXML ) import Data.List ( intersect, intercalate ) @@ -46,9 +46,9 @@ data WriterState = WriterState { -- | Convert Pandoc to MediaWiki. writeMediaWiki :: WriterOptions -> Pandoc -> String -writeMediaWiki opts document = - evalState (pandocToMediaWiki opts document) - (WriterState { stNotes = False, stListLevel = [], stUseTags = False }) +writeMediaWiki opts document = + evalState (pandocToMediaWiki opts document) + (WriterState { stNotes = False, stListLevel = [], stUseTags = False }) -- | Return MediaWiki representation of document. pandocToMediaWiki :: WriterOptions -> Pandoc -> State WriterState String @@ -57,7 +57,7 @@ pandocToMediaWiki opts (Pandoc _ blocks) = do notesExist <- get >>= return . stNotes let notes = if notesExist then "\n" - else "" + else "" let main = body ++ notes let context = writerVariables opts ++ [ ("body", main) ] ++ @@ -70,18 +70,18 @@ pandocToMediaWiki opts (Pandoc _ blocks) = do escapeString :: String -> String escapeString = escapeStringForXML --- | Convert Pandoc block element to MediaWiki. +-- | Convert Pandoc block element to MediaWiki. blockToMediaWiki :: WriterOptions -- ^ Options -> Block -- ^ Block element - -> State WriterState String + -> State WriterState String blockToMediaWiki _ Null = return "" -blockToMediaWiki opts (Plain inlines) = +blockToMediaWiki opts (Plain inlines) = inlineListToMediaWiki opts inlines blockToMediaWiki opts (Para [Image txt (src,tit)]) = do - capt <- inlineListToMediaWiki opts txt + capt <- inlineListToMediaWiki opts txt let opt = if null txt then "" else "|alt=" ++ if null tit then capt else tit ++ @@ -115,7 +115,7 @@ blockToMediaWiki _ (CodeBlock (_,classes,_) str) = do "javascript", "latex", "lisp", "lua", "matlab", "mirc", "mpasm", "mysql", "nsis", "objc", "ocaml", "ocaml-brief", "oobas", "oracle8", "pascal", "perl", "php", "php-brief", "plsql", "python", "qbasic", "rails", "reg", "robots", "ruby", "sas", "scheme", "sdlbasic", - "smalltalk", "smarty", "sql", "tcl", "", "thinbasic", "tsql", "vb", "vbnet", "vhdl", + "smalltalk", "smarty", "sql", "tcl", "", "thinbasic", "tsql", "vb", "vbnet", "vhdl", "visualfoxpro", "winbatch", "xml", "xpp", "z80"] let (beg, end) = if null at then ("" else " class=\"" ++ unwords classes ++ "\">", "") @@ -124,7 +124,7 @@ blockToMediaWiki _ (CodeBlock (_,classes,_) str) = do blockToMediaWiki opts (BlockQuote blocks) = do contents <- blockListToMediaWiki opts blocks - return $ "
" ++ contents ++ "
" + return $ "
" ++ contents ++ "
" blockToMediaWiki opts (Table capt aligns widths headers rows') = do let alignStrings = map alignmentToString aligns @@ -221,7 +221,7 @@ listItemToMediaWiki opts items = do -- | Convert definition list item (label, list of blocks) to MediaWiki. definitionListItemToMediaWiki :: WriterOptions - -> ([Inline],[[Block]]) + -> ([Inline],[[Block]]) -> State WriterState String definitionListItemToMediaWiki opts (label, items) = do labelText <- inlineListToMediaWiki opts label @@ -242,7 +242,7 @@ isSimpleList x = BulletList items -> all isSimpleListItem items OrderedList (num, sty, _) items -> all isSimpleListItem items && num == 1 && sty `elem` [DefaultStyle, Decimal] - DefinitionList items -> all isSimpleListItem $ concatMap snd items + DefinitionList items -> all isSimpleListItem $ concatMap snd items _ -> False -- | True if list item can be handled with the simple wiki syntax. False if @@ -287,8 +287,8 @@ tableRowToMediaWiki opts alignStrings rownum cols' = do 0 -> "header" x | x `rem` 2 == 1 -> "odd" _ -> "even" - cols'' <- sequence $ zipWith - (\alignment item -> tableItemToMediaWiki opts celltype alignment item) + cols'' <- sequence $ zipWith + (\alignment item -> tableItemToMediaWiki opts celltype alignment item) alignStrings cols' return $ "\n" ++ unlines cols'' ++ "" @@ -313,7 +313,7 @@ tableItemToMediaWiki opts celltype align' item = do -- | Convert list of Pandoc block elements to MediaWiki. blockListToMediaWiki :: WriterOptions -- ^ Options -> [Block] -- ^ List of block elements - -> State WriterState String + -> State WriterState String blockListToMediaWiki opts blocks = mapM (blockToMediaWiki opts) blocks >>= return . vcat @@ -325,9 +325,9 @@ inlineListToMediaWiki opts lst = -- | Convert Pandoc inline element to MediaWiki. inlineToMediaWiki :: WriterOptions -> Inline -> State WriterState String -inlineToMediaWiki opts (Emph lst) = do +inlineToMediaWiki opts (Emph lst) = do contents <- inlineListToMediaWiki opts lst - return $ "''" ++ contents ++ "''" + return $ "''" ++ contents ++ "''" inlineToMediaWiki opts (Strong lst) = do contents <- inlineListToMediaWiki opts lst @@ -365,8 +365,8 @@ inlineToMediaWiki _ (Str str) = return $ escapeString str inlineToMediaWiki _ (Math _ str) = return $ "" ++ str ++ "" -- note: str should NOT be escaped -inlineToMediaWiki _ (RawInline "mediawiki" str) = return str -inlineToMediaWiki _ (RawInline "html" str) = return str +inlineToMediaWiki _ (RawInline "mediawiki" str) = return str +inlineToMediaWiki _ (RawInline "html" str) = return str inlineToMediaWiki _ (RawInline _ _) = return "" inlineToMediaWiki _ (LineBreak) = return "
\n" @@ -392,7 +392,7 @@ inlineToMediaWiki opts (Image alt (source, tit)) = do else "|" ++ tit return $ "[[Image:" ++ source ++ txt ++ "]]" -inlineToMediaWiki opts (Note contents) = do +inlineToMediaWiki opts (Note contents) = do contents' <- blockListToMediaWiki opts contents modify (\s -> s { stNotes = True }) return $ "" ++ contents' ++ "" diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs index d2b56cd17..8b3148273 100644 --- a/src/Text/Pandoc/Writers/Native.hs +++ b/src/Text/Pandoc/Writers/Native.hs @@ -20,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.Native Copyright : Copyright (C) 2006-2010 John MacFarlane - License : GNU GPL, version 2 or above + License : GNU GPL, version 2 or above Maintainer : John MacFarlane Stability : alpha @@ -47,17 +47,17 @@ prettyList ds = prettyBlock :: Block -> Doc prettyBlock (BlockQuote blocks) = "BlockQuote" $$ prettyList (map prettyBlock blocks) -prettyBlock (OrderedList attribs blockLists) = +prettyBlock (OrderedList attribs blockLists) = "OrderedList" <> space <> text (show attribs) $$ (prettyList $ map (prettyList . map prettyBlock) blockLists) -prettyBlock (BulletList blockLists) = +prettyBlock (BulletList blockLists) = "BulletList" $$ (prettyList $ map (prettyList . map prettyBlock) blockLists) prettyBlock (DefinitionList items) = "DefinitionList" $$ (prettyList $ map deflistitem items) where deflistitem (term, defs) = "(" <> text (show term) <> "," <> cr <> nest 1 (prettyList $ map (prettyList . map prettyBlock) defs) <> ")" -prettyBlock (Table caption aligns widths header rows) = +prettyBlock (Table caption aligns widths header rows) = "Table " <> text (show caption) <> " " <> text (show aligns) <> " " <> text (show widths) $$ prettyRow header $$ diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 7eb943a22..1bb4b5449 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -20,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.Org Copyright : Copyright (C) 2010 Puneeth Chaganti - License : GNU GPL, version 2 or above + License : GNU GPL, version 2 or above Maintainer : Puneeth Chaganti Stability : alpha @@ -32,14 +32,14 @@ Org-Mode: -} module Text.Pandoc.Writers.Org ( writeOrg) where import Text.Pandoc.Definition -import Text.Pandoc.Shared +import Text.Pandoc.Shared import Text.Pandoc.Pretty import Text.Pandoc.Templates (renderTemplate) import Data.List ( intersect, intersperse, transpose ) import Control.Monad.State import Control.Applicative ( (<$>) ) -data WriterState = +data WriterState = WriterState { stNotes :: [[Block]] , stLinks :: Bool , stImages :: Bool @@ -49,7 +49,7 @@ data WriterState = -- | Convert Pandoc to Org. writeOrg :: WriterOptions -> Pandoc -> String -writeOrg opts document = +writeOrg opts document = let st = WriterState { stNotes = [], stLinks = False, stImages = False, stHasMath = False, stOptions = opts } @@ -82,8 +82,8 @@ pandocToOrg (Pandoc (Meta tit auth dat) blocks) = do -- | Return Org representation of notes. notesToOrg :: [[Block]] -> State WriterState Doc -notesToOrg notes = - mapM (\(num, note) -> noteToOrg num note) (zip [1..] notes) >>= +notesToOrg notes = + mapM (\(num, note) -> noteToOrg num note) (zip [1..] notes) >>= return . vsep -- | Return Org representation of a note. @@ -106,11 +106,11 @@ titleToOrg :: [Inline] -> State WriterState Doc titleToOrg [] = return empty titleToOrg lst = do contents <- inlineListToOrg lst - return $ "#+TITLE: " <> contents + return $ "#+TITLE: " <> contents --- | Convert Pandoc block element to Org. +-- | Convert Pandoc block element to Org. blockToOrg :: Block -- ^ Block element - -> State WriterState Doc + -> State WriterState Doc blockToOrg Null = return empty blockToOrg (Plain inlines) = inlineListToOrg inlines blockToOrg (Para [Image txt (src,tit)]) = do @@ -120,7 +120,7 @@ blockToOrg (Para [Image txt (src,tit)]) = do blockToOrg (Para inlines) = do contents <- inlineListToOrg inlines return $ contents <> blankline -blockToOrg (RawBlock "html" str) = +blockToOrg (RawBlock "html" str) = return $ blankline $$ "#+BEGIN_HTML" $$ nest 2 (text str) $$ "#+END_HTML" $$ blankline blockToOrg (RawBlock f str) | f == "org" || f == "latex" || f == "tex" = @@ -134,17 +134,17 @@ blockToOrg (Header level inlines) = do blockToOrg (CodeBlock (_,classes,_) str) = do opts <- stOptions <$> get let tabstop = writerTabStop opts - let at = classes `intersect` ["asymptote", "C", "clojure", "css", "ditaa", - "dot", "emacs-lisp", "gnuplot", "haskell", "js", "latex", - "ledger", "lisp", "matlab", "mscgen", "ocaml", "octave", - "oz", "perl", "plantuml", "python", "R", "ruby", "sass", + let at = classes `intersect` ["asymptote", "C", "clojure", "css", "ditaa", + "dot", "emacs-lisp", "gnuplot", "haskell", "js", "latex", + "ledger", "lisp", "matlab", "mscgen", "ocaml", "octave", + "oz", "perl", "plantuml", "python", "R", "ruby", "sass", "scheme", "screen", "sh", "sql", "sqlite"] let (beg, end) = case at of [] -> ("#+BEGIN_EXAMPLE", "#+END_EXAMPLE") (x:_) -> ("#+BEGIN_SRC " ++ x, "#+END_SRC") return $ text beg $$ nest tabstop (text str) $$ text end $$ blankline blockToOrg (BlockQuote blocks) = do - contents <- blockListToOrg blocks + contents <- blockListToOrg blocks return $ blankline $$ "#+BEGIN_QUOTE" $$ nest 2 contents $$ "#+END_QUOTE" $$ blankline blockToOrg (Table caption' _ _ headers rows) = do @@ -155,11 +155,11 @@ blockToOrg (Table caption' _ _ headers rows) = do headers' <- mapM blockListToOrg headers rawRows <- mapM (mapM blockListToOrg) rows let numChars = maximum . map offset - -- FIXME: width is not being used. + -- FIXME: width is not being used. let widthsInChars = map ((+2) . numChars) $ transpose (headers' : rawRows) - -- FIXME: Org doesn't allow blocks with height more than 1. - let hpipeBlocks blocks = hcat [beg, middle, end] + -- FIXME: Org doesn't allow blocks with height more than 1. + let hpipeBlocks blocks = hcat [beg, middle, end] where h = maximum (map height blocks) sep' = lblock 3 $ vcat (map text $ replicate h " | ") beg = lblock 2 $ vcat (map text $ replicate h "| ") @@ -170,7 +170,7 @@ blockToOrg (Table caption' _ _ headers rows) = do rows' <- mapM (\row -> do cols <- mapM blockListToOrg row return $ makeRow cols) rows let border ch = char '|' <> char ch <> - (hcat $ intersperse (char ch <> char '+' <> char ch) $ + (hcat $ intersperse (char ch <> char '+' <> char ch) $ map (\l -> text $ replicate l ch) widthsInChars) <> char ch <> char '|' let body = vcat rows' @@ -186,7 +186,7 @@ blockToOrg (OrderedList (start, _, delim) items) = do let delim' = case delim of TwoParens -> OneParen x -> x - let markers = take (length items) $ orderedListMarkers + let markers = take (length items) $ orderedListMarkers (start, Decimal, delim') let maxMarkerLength = maximum $ map length markers let markers' = map (\m -> let s = maxMarkerLength - length m @@ -222,7 +222,7 @@ definitionListItemToOrg (label, defs) = do -- | Convert list of Pandoc block elements to Org. blockListToOrg :: [Block] -- ^ List of block elements - -> State WriterState Doc + -> State WriterState Doc blockListToOrg blocks = mapM blockToOrg blocks >>= return . vcat -- | Convert list of Pandoc inline elements to Org. @@ -231,19 +231,19 @@ inlineListToOrg lst = mapM inlineToOrg lst >>= return . hcat -- | Convert Pandoc inline element to Org. inlineToOrg :: Inline -> State WriterState Doc -inlineToOrg (Emph lst) = do +inlineToOrg (Emph lst) = do contents <- inlineListToOrg lst return $ "/" <> contents <> "/" inlineToOrg (Strong lst) = do contents <- inlineListToOrg lst return $ "*" <> contents <> "*" -inlineToOrg (Strikeout lst) = do +inlineToOrg (Strikeout lst) = do contents <- inlineListToOrg lst return $ "+" <> contents <> "+" -inlineToOrg (Superscript lst) = do +inlineToOrg (Superscript lst) = do contents <- inlineListToOrg lst return $ "^{" <> contents <> "}" -inlineToOrg (Subscript lst) = do +inlineToOrg (Subscript lst) = do contents <- inlineListToOrg lst return $ "_{" <> contents <> "}" inlineToOrg (SmallCaps lst) = inlineListToOrg lst @@ -276,7 +276,7 @@ inlineToOrg (Link txt (src, _)) = do inlineToOrg (Image _ (source, _)) = do modify $ \s -> s{ stImages = True } return $ "[[" <> text source <> "]]" -inlineToOrg (Note contents) = do +inlineToOrg (Note contents) = do -- add to notes in state notes <- get >>= (return . stNotes) modify $ \st -> st { stNotes = contents:notes } diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index d98079940..d04fe4113 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -18,9 +18,9 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | - Module : Text.Pandoc.Writers.RST + Module : Text.Pandoc.Writers.RST Copyright : Copyright (C) 2006-2010 John MacFarlane - License : GNU GPL, version 2 or above + License : GNU GPL, version 2 or above Maintainer : John MacFarlane Stability : alpha @@ -32,7 +32,7 @@ reStructuredText: -} module Text.Pandoc.Writers.RST ( writeRST) where import Text.Pandoc.Definition -import Text.Pandoc.Shared +import Text.Pandoc.Shared import Text.Pandoc.Templates (renderTemplate) import Data.List ( isPrefixOf, intersperse, transpose ) import Text.Pandoc.Pretty @@ -42,7 +42,7 @@ import Data.Char (isSpace) type Refs = [([Inline], Target)] -data WriterState = +data WriterState = WriterState { stNotes :: [[Block]] , stLinks :: Refs , stImages :: Refs @@ -52,7 +52,7 @@ data WriterState = -- | Convert Pandoc to RST. writeRST :: WriterOptions -> Pandoc -> String -writeRST opts document = +writeRST opts document = let st = WriterState { stNotes = [], stLinks = [], stImages = [], stHasMath = False, stOptions = opts } @@ -89,8 +89,8 @@ pandocToRST (Pandoc (Meta tit auth dat) blocks) = do refsToRST :: Refs -> State WriterState Doc refsToRST refs = mapM keyToRST refs >>= return . vcat --- | Return RST representation of a reference key. -keyToRST :: ([Inline], (String, String)) +-- | Return RST representation of a reference key. +keyToRST :: ([Inline], (String, String)) -> State WriterState Doc keyToRST (label, (src, _)) = do label' <- inlineListToRST label @@ -101,7 +101,7 @@ keyToRST (label, (src, _)) = do -- | Return RST representation of notes. notesToRST :: [[Block]] -> State WriterState Doc -notesToRST notes = +notesToRST notes = mapM (\(num, note) -> noteToRST num note) (zip [1..] notes) >>= return . vsep @@ -116,8 +116,8 @@ noteToRST num note = do pictRefsToRST :: Refs -> State WriterState Doc pictRefsToRST refs = mapM pictToRST refs >>= return . vcat --- | Return RST representation of a picture substitution reference. -pictToRST :: ([Inline], (String, String)) +-- | Return RST representation of a picture substitution reference. +pictToRST :: ([Inline], (String, String)) -> State WriterState Doc pictToRST (label, (src, _)) = do label' <- inlineListToRST label @@ -135,9 +135,9 @@ titleToRST lst = do let border = text (replicate titleLength '=') return $ border $$ contents $$ border --- | Convert Pandoc block element to RST. +-- | Convert Pandoc block element to RST. blockToRST :: Block -- ^ Block element - -> State WriterState Doc + -> State WriterState Doc blockToRST Null = return empty blockToRST (Plain inlines) = inlineListToRST inlines blockToRST (Para [Image txt (src,tit)]) = do @@ -168,7 +168,7 @@ blockToRST (CodeBlock (_,classes,_) str) = do else return $ "::" $+$ nest tabstop (text str) $$ blankline blockToRST (BlockQuote blocks) = do tabstop <- get >>= (return . writerTabStop . stOptions) - contents <- blockListToRST blocks + contents <- blockListToRST blocks return $ (nest tabstop contents) <> blankline blockToRST (Table caption _ widths headers rows) = do caption' <- inlineListToRST caption @@ -184,7 +184,7 @@ blockToRST (Table caption _ widths headers rows) = do if isSimple then map ((+2) . numChars) $ transpose (headers' : rawRows) else map (floor . (fromIntegral (writerColumns opts) *)) widths - let hpipeBlocks blocks = hcat [beg, middle, end] + let hpipeBlocks blocks = hcat [beg, middle, end] where h = maximum (map height blocks) sep' = lblock 3 $ vcat (map text $ replicate h " | ") beg = lblock 2 $ vcat (map text $ replicate h "| ") @@ -195,7 +195,7 @@ blockToRST (Table caption _ widths headers rows) = do rows' <- mapM (\row -> do cols <- mapM blockListToRST row return $ makeRow cols) rows let border ch = char '+' <> char ch <> - (hcat $ intersperse (char ch <> char '+' <> char ch) $ + (hcat $ intersperse (char ch <> char '+' <> char ch) $ map (\l -> text $ replicate l ch) widthsInChars) <> char ch <> char '+' let body = vcat $ intersperse (border '-') rows' @@ -208,9 +208,9 @@ blockToRST (BulletList items) = do -- ensure that sublists have preceding blank line return $ blankline $$ vcat contents $$ blankline blockToRST (OrderedList (start, style', delim) items) = do - let markers = if start == 1 && style' == DefaultStyle && delim == DefaultDelim + let markers = if start == 1 && style' == DefaultStyle && delim == DefaultDelim then take (length items) $ repeat "#." - else take (length items) $ orderedListMarkers + else take (length items) $ orderedListMarkers (start, style', delim) let maxMarkerLength = maximum $ map length markers let markers' = map (\m -> let s = maxMarkerLength - length m @@ -249,7 +249,7 @@ definitionListItemToRST (label, defs) = do -- | Convert list of Pandoc block elements to RST. blockListToRST :: [Block] -- ^ List of block elements - -> State WriterState Doc + -> State WriterState Doc blockListToRST blocks = mapM blockToRST blocks >>= return . vcat -- | Convert list of Pandoc inline elements to RST. @@ -303,19 +303,19 @@ inlineListToRST lst = mapM inlineToRST (insertBS lst) >>= return . hcat -- | Convert Pandoc inline element to RST. inlineToRST :: Inline -> State WriterState Doc -inlineToRST (Emph lst) = do +inlineToRST (Emph lst) = do contents <- inlineListToRST lst return $ "*" <> contents <> "*" inlineToRST (Strong lst) = do contents <- inlineListToRST lst return $ "**" <> contents <> "**" -inlineToRST (Strikeout lst) = do +inlineToRST (Strikeout lst) = do contents <- inlineListToRST lst return $ "[STRIKEOUT:" <> contents <> "]" -inlineToRST (Superscript lst) = do +inlineToRST (Superscript lst) = do contents <- inlineListToRST lst return $ ":sup:`" <> contents <> "`" -inlineToRST (Subscript lst) = do +inlineToRST (Subscript lst) = do contents <- inlineListToRST lst return $ ":sub:`" <> contents <> "`" inlineToRST (SmallCaps lst) = inlineListToRST lst @@ -358,7 +358,7 @@ inlineToRST (Link txt (src, tit)) = do else return $ "`" <> linktext <> " <" <> text src <> ">`_" inlineToRST (Image alternate (source, tit)) = do pics <- get >>= return . stImages - let labelsUsed = map fst pics + let labelsUsed = map fst pics let txt = if null alternate || alternate == [Str ""] || alternate `elem` labelsUsed then [Str $ "image" ++ show (length pics)] @@ -369,7 +369,7 @@ inlineToRST (Image alternate (source, tit)) = do modify $ \st -> st { stImages = pics' } label <- inlineListToRST txt return $ "|" <> label <> "|" -inlineToRST (Note contents) = do +inlineToRST (Note contents) = do -- add to notes in state notes <- get >>= return . stNotes modify $ \st -> st { stNotes = contents:notes } diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index a571f2a0f..5ab71c8d6 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -19,10 +19,10 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.RTF Copyright : Copyright (C) 2006-2010 John MacFarlane - License : GNU GPL, version 2 or above + License : GNU GPL, version 2 or above Maintainer : John MacFarlane - Stability : alpha + Stability : alpha Portability : portable Conversion of 'Pandoc' documents to RTF (rich text format). @@ -65,7 +65,7 @@ rtfEmbedImage x = return x -- | Convert Pandoc to a string in rich text format. writeRTF :: WriterOptions -> Pandoc -> String -writeRTF options (Pandoc (Meta title authors date) blocks) = +writeRTF options (Pandoc (Meta title authors date) blocks) = let titletext = inlineListToRTF title authorstext = map inlineListToRTF authors datetext = inlineListToRTF date @@ -84,11 +84,11 @@ writeRTF options (Pandoc (Meta title authors date) blocks) = else body -- | Construct table of contents from list of header blocks. -tableOfContents :: [Block] -> String +tableOfContents :: [Block] -> String tableOfContents headers = let contentsTree = hierarchicalize headers - in concatMap (blockToRTF 0 AlignDefault) $ - [Header 1 [Str "Contents"], + in concatMap (blockToRTF 0 AlignDefault) $ + [Header 1 [Str "Contents"], BulletList (map elementToListItem contentsTree)] elementToListItem :: Element -> [Block] @@ -102,7 +102,7 @@ elementToListItem (Sec _ _ _ sectext subsecs) = [Plain sectext] ++ handleUnicode :: String -> String handleUnicode [] = [] handleUnicode (c:cs) = - if ord c > 127 + if ord c > 127 then '\\':'u':(show (ord c)) ++ "?" ++ handleUnicode cs else c:(handleUnicode cs) @@ -132,32 +132,32 @@ rtfParSpaced :: Int -- ^ space after (in twips) -> Int -- ^ first line indent (relative to block) (in twips) -> Alignment -- ^ alignment -> String -- ^ string with content - -> String -rtfParSpaced spaceAfter indent firstLineIndent alignment content = + -> String +rtfParSpaced spaceAfter indent firstLineIndent alignment content = let alignString = case alignment of AlignLeft -> "\\ql " AlignRight -> "\\qr " AlignCenter -> "\\qc " AlignDefault -> "\\ql " in "{\\pard " ++ alignString ++ - "\\f0 \\sa" ++ (show spaceAfter) ++ " \\li" ++ (show indent) ++ + "\\f0 \\sa" ++ (show spaceAfter) ++ " \\li" ++ (show indent) ++ " \\fi" ++ (show firstLineIndent) ++ " " ++ content ++ "\\par}\n" --- | Default paragraph. +-- | Default paragraph. rtfPar :: Int -- ^ block indent (in twips) -> Int -- ^ first line indent (relative to block) (in twips) -> Alignment -- ^ alignment -> String -- ^ string with content - -> String -rtfPar = rtfParSpaced 180 + -> String +rtfPar = rtfParSpaced 180 -- | Compact paragraph (e.g. for compact list items). rtfCompact :: Int -- ^ block indent (in twips) -> Int -- ^ first line indent (relative to block) (in twips) -> Alignment -- ^ alignment -> String -- ^ string with content - -> String -rtfCompact = rtfParSpaced 0 + -> String +rtfCompact = rtfParSpaced 0 -- number of twips to indent indentIncrement :: Int @@ -174,7 +174,7 @@ bulletMarker indent = case indent `mod` 720 of -- | Returns appropriate (list of) ordered list markers for indent level. orderedMarkers :: Int -> ListAttributes -> [String] -orderedMarkers indent (start, style, delim) = +orderedMarkers indent (start, style, delim) = if style == DefaultStyle && delim == DefaultDelim then case indent `mod` 720 of 0 -> orderedListMarkers (start, Decimal, Period) @@ -187,30 +187,30 @@ blockToRTF :: Int -- ^ indent level -> Block -- ^ block to convert -> String blockToRTF _ _ Null = "" -blockToRTF indent alignment (Plain lst) = +blockToRTF indent alignment (Plain lst) = rtfCompact indent 0 alignment $ inlineListToRTF lst -blockToRTF indent alignment (Para lst) = +blockToRTF indent alignment (Para lst) = rtfPar indent 0 alignment $ inlineListToRTF lst -blockToRTF indent alignment (BlockQuote lst) = - concatMap (blockToRTF (indent + indentIncrement) alignment) lst +blockToRTF indent alignment (BlockQuote lst) = + concatMap (blockToRTF (indent + indentIncrement) alignment) lst blockToRTF indent _ (CodeBlock _ str) = rtfPar indent 0 AlignLeft ("\\f1 " ++ (codeStringToRTF str)) blockToRTF _ _ (RawBlock "rtf" str) = str blockToRTF _ _ (RawBlock _ _) = "" -blockToRTF indent alignment (BulletList lst) = spaceAtEnd $ +blockToRTF indent alignment (BulletList lst) = spaceAtEnd $ concatMap (listItemToRTF alignment indent (bulletMarker indent)) lst -blockToRTF indent alignment (OrderedList attribs lst) = spaceAtEnd $ concat $ +blockToRTF indent alignment (OrderedList attribs lst) = spaceAtEnd $ concat $ zipWith (listItemToRTF alignment indent) (orderedMarkers indent attribs) lst -blockToRTF indent alignment (DefinitionList lst) = spaceAtEnd $ +blockToRTF indent alignment (DefinitionList lst) = spaceAtEnd $ concatMap (definitionListItemToRTF alignment indent) lst -blockToRTF indent _ HorizontalRule = +blockToRTF indent _ HorizontalRule = rtfPar indent 0 AlignCenter "\\emdash\\emdash\\emdash\\emdash\\emdash" blockToRTF indent alignment (Header level lst) = rtfPar indent 0 alignment $ "\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++ inlineListToRTF lst -blockToRTF indent alignment (Table caption aligns sizes headers rows) = +blockToRTF indent alignment (Table caption aligns sizes headers rows) = (if all null headers then "" - else tableRowToRTF True indent aligns sizes headers) ++ + else tableRowToRTF True indent aligns sizes headers) ++ concatMap (tableRowToRTF False indent aligns sizes) rows ++ rtfPar indent 0 alignment (inlineListToRTF caption) @@ -232,7 +232,7 @@ tableRowToRTF header indent aligns sizes' cols = end = "}\n\\intbl\\row}\n" in start ++ columns ++ end -tableItemToRTF :: Int -> Alignment -> [Block] -> String +tableItemToRTF :: Int -> Alignment -> [Block] -> String tableItemToRTF indent alignment item = let contents = concatMap (blockToRTF indent alignment) item in "{\\intbl " ++ contents ++ "\\cell}\n" @@ -240,7 +240,7 @@ tableItemToRTF indent alignment item = -- | Ensure that there's the same amount of space after compact -- lists as after regular lists. spaceAtEnd :: String -> String -spaceAtEnd str = +spaceAtEnd str = if isSuffixOf "\\par}\n" str then (take ((length str) - 6) str) ++ "\\sa180\\par}\n" else str @@ -251,10 +251,10 @@ listItemToRTF :: Alignment -- ^ alignment -> String -- ^ list start marker -> [Block] -- ^ list item (list of blocks) -> [Char] -listItemToRTF alignment indent marker [] = - rtfCompact (indent + listIncrement) (0 - listIncrement) alignment - (marker ++ "\\tx" ++ (show listIncrement) ++ "\\tab ") -listItemToRTF alignment indent marker list = +listItemToRTF alignment indent marker [] = + rtfCompact (indent + listIncrement) (0 - listIncrement) alignment + (marker ++ "\\tx" ++ (show listIncrement) ++ "\\tab ") +listItemToRTF alignment indent marker list = let (first:rest) = map (blockToRTF (indent + listIncrement) alignment) list listMarker = "\\fi" ++ show (0 - listIncrement) ++ " " ++ marker ++ "\\tx" ++ show listIncrement ++ "\\tab" @@ -277,7 +277,7 @@ definitionListItemToRTF alignment indent (label, defs) = let labelText = blockToRTF indent alignment (Plain label) itemsText = concatMap (blockToRTF (indent + listIncrement) alignment) $ concat defs - in labelText ++ itemsText + in labelText ++ itemsText -- | Convert list of inline items to RTF. inlineListToRTF :: [Inline] -- ^ list of inlines to convert @@ -293,9 +293,9 @@ inlineToRTF (Strikeout lst) = "{\\strike " ++ (inlineListToRTF lst) ++ "}" inlineToRTF (Superscript lst) = "{\\super " ++ (inlineListToRTF lst) ++ "}" inlineToRTF (Subscript lst) = "{\\sub " ++ (inlineListToRTF lst) ++ "}" inlineToRTF (SmallCaps lst) = "{\\scaps " ++ (inlineListToRTF lst) ++ "}" -inlineToRTF (Quoted SingleQuote lst) = +inlineToRTF (Quoted SingleQuote lst) = "\\u8216'" ++ (inlineListToRTF lst) ++ "\\u8217'" -inlineToRTF (Quoted DoubleQuote lst) = +inlineToRTF (Quoted DoubleQuote lst) = "\\u8220\"" ++ (inlineListToRTF lst) ++ "\\u8221\"" inlineToRTF (Code _ str) = "{\\f1 " ++ (codeStringToRTF str) ++ "}" inlineToRTF (Str str) = stringToRTF str @@ -305,11 +305,11 @@ inlineToRTF (RawInline "rtf" str) = str inlineToRTF (RawInline _ _) = "" inlineToRTF (LineBreak) = "\\line " inlineToRTF Space = " " -inlineToRTF (Link text (src, _)) = - "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++ +inlineToRTF (Link text (src, _)) = + "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++ "\"}}{\\fldrslt{\\ul\n" ++ (inlineListToRTF text) ++ "\n}}}\n" -inlineToRTF (Image _ (source, _)) = - "{\\cf1 [image: " ++ source ++ "]\\cf0}" +inlineToRTF (Image _ (source, _)) = + "{\\cf1 [image: " ++ source ++ "]\\cf0}" inlineToRTF (Note contents) = - "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++ + "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++ (concatMap (blockToRTF 0 AlignDefault) contents) ++ "}" diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 6bb782899..e85013162 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -19,10 +19,10 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.Texinfo Copyright : Copyright (C) 2008-2010 John MacFarlane and Peter Wang - License : GNU GPL, version 2 or above + License : GNU GPL, version 2 or above Maintainer : John MacFarlane - Stability : alpha + Stability : alpha Portability : portable Conversion of 'Pandoc' format into Texinfo. @@ -40,7 +40,7 @@ import Text.Pandoc.Pretty import Network.URI ( isAbsoluteURI, unEscapeString ) import System.FilePath -data WriterState = +data WriterState = WriterState { stStrikeout :: Bool -- document contains strikeout , stSuperscript :: Bool -- document contains superscript , stSubscript :: Bool -- document contains subscript @@ -53,8 +53,8 @@ data WriterState = -- | Convert Pandoc to Texinfo. writeTexinfo :: WriterOptions -> Pandoc -> String -writeTexinfo options document = - evalState (pandocToTexinfo options $ wrapTop document) $ +writeTexinfo options document = + evalState (pandocToTexinfo options $ wrapTop document) $ WriterState { stStrikeout = False, stSuperscript = False, stSubscript = False } -- | Add a "Top" node around the document, needed by Texinfo. @@ -217,7 +217,7 @@ blockToTexinfo (Table caption aligns widths heads rows) = do else return $ "@columnfractions " ++ concatMap (printf "%.2f ") widths let tableBody = text ("@multitable " ++ colDescriptors) $$ headers $$ - vcat rowsText $$ + vcat rowsText $$ text "@end multitable" return $ if isEmpty captionText then tableBody <> blankline @@ -241,7 +241,7 @@ tableAnyRowToTexinfo :: String -> [[Block]] -> State WriterState Doc tableAnyRowToTexinfo itemtype aligns cols = - zipWithM alignedBlock aligns cols >>= + zipWithM alignedBlock aligns cols >>= return . (text itemtype $$) . foldl (\row item -> row $$ (if isEmpty row then empty else text " @tab ") <> item) empty @@ -358,8 +358,8 @@ inlineToTexinfo :: Inline -- ^ Inline to convert inlineToTexinfo (Emph lst) = inlineListToTexinfo lst >>= return . inCmd "emph" -inlineToTexinfo (Strong lst) = - inlineListToTexinfo lst >>= return . inCmd "strong" +inlineToTexinfo (Strong lst) = + inlineListToTexinfo lst >>= return . inCmd "strong" inlineToTexinfo (Strikeout lst) = do modify $ \st -> st{ stStrikeout = True } diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index 26d5ec6d7..e3711911b 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.Textile Copyright : Copyright (C) 2010 John MacFarlane - License : GNU GPL, version 2 or above + License : GNU GPL, version 2 or above Maintainer : John MacFarlane Stability : alpha @@ -31,7 +31,7 @@ Textile: -} module Text.Pandoc.Writers.Textile ( writeTextile ) where import Text.Pandoc.Definition -import Text.Pandoc.Shared +import Text.Pandoc.Shared import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.XML ( escapeStringForXML ) import Data.List ( intercalate ) @@ -46,9 +46,9 @@ data WriterState = WriterState { -- | Convert Pandoc to Textile. writeTextile :: WriterOptions -> Pandoc -> String -writeTextile opts document = - evalState (pandocToTextile opts document) - (WriterState { stNotes = [], stListLevel = [], stUseTags = False }) +writeTextile opts document = + evalState (pandocToTextile opts document) + (WriterState { stNotes = [], stListLevel = [], stUseTags = False }) -- | Return Textile representation of document. pandocToTextile :: WriterOptions -> Pandoc -> State WriterState String @@ -90,14 +90,14 @@ escapeCharForTextile x = case x of escapeStringForTextile :: String -> String escapeStringForTextile = concatMap escapeCharForTextile --- | Convert Pandoc block element to Textile. +-- | Convert Pandoc block element to Textile. blockToTextile :: WriterOptions -- ^ Options -> Block -- ^ Block element - -> State WriterState String + -> State WriterState String blockToTextile _ Null = return "" -blockToTextile opts (Plain inlines) = +blockToTextile opts (Plain inlines) = inlineListToTextile opts inlines blockToTextile opts (Para [Image txt (src,tit)]) = do @@ -236,7 +236,7 @@ listItemToTextile opts items = do -- | Convert definition list item (label, list of blocks) to Textile. definitionListItemToTextile :: WriterOptions - -> ([Inline],[[Block]]) + -> ([Inline],[[Block]]) -> State WriterState String definitionListItemToTextile opts (label, items) = do labelText <- inlineListToTextile opts label @@ -294,8 +294,8 @@ tableRowToTextile opts alignStrings rownum cols' = do 0 -> "header" x | x `rem` 2 == 1 -> "odd" _ -> "even" - cols'' <- sequence $ zipWith - (\alignment item -> tableItemToTextile opts celltype alignment item) + cols'' <- sequence $ zipWith + (\alignment item -> tableItemToTextile opts celltype alignment item) alignStrings cols' return $ "\n" ++ unlines cols'' ++ "" @@ -320,7 +320,7 @@ tableItemToTextile opts celltype align' item = do -- | Convert list of Pandoc block elements to Textile. blockListToTextile :: WriterOptions -- ^ Options -> [Block] -- ^ List of block elements - -> State WriterState String + -> State WriterState String blockListToTextile opts blocks = mapM (blockToTextile opts) blocks >>= return . vcat @@ -332,11 +332,11 @@ inlineListToTextile opts lst = -- | Convert Pandoc inline element to Textile. inlineToTextile :: WriterOptions -> Inline -> State WriterState String -inlineToTextile opts (Emph lst) = do +inlineToTextile opts (Emph lst) = do contents <- inlineListToTextile opts lst return $ if '_' `elem` contents then "" ++ contents ++ "" - else "_" ++ contents ++ "_" + else "_" ++ contents ++ "_" inlineToTextile opts (Strong lst) = do contents <- inlineListToTextile opts lst @@ -377,7 +377,7 @@ inlineToTextile opts (Cite _ lst) = inlineListToTextile opts lst inlineToTextile _ (Code _ str) = return $ if '@' `elem` str then "" ++ escapeStringForXML str ++ "" - else "@" ++ str ++ "@" + else "@" ++ str ++ "@" inlineToTextile _ (Str str) = return $ escapeStringForTextile str -- cgit v1.2.3