From 42aca57dee8d88afa5fac512aeb1198102908865 Mon Sep 17 00:00:00 2001 From: fiddlosopher Date: Sat, 24 Jan 2009 20:00:26 +0000 Subject: Moved all haskell source to src subdirectory. git-svn-id: https://pandoc.googlecode.com/svn/trunk@1528 788f1e2b-df1e-0410-8736-df70ead52e1b --- src/Text/Pandoc/Writers/MediaWiki.hs | 396 +++++++++++++++++++++++++++++++++++ 1 file changed, 396 insertions(+) create mode 100644 src/Text/Pandoc/Writers/MediaWiki.hs (limited to 'src/Text/Pandoc/Writers/MediaWiki.hs') diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs new file mode 100644 index 000000000..c5f6b3bf1 --- /dev/null +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -0,0 +1,396 @@ +{- +Copyright (C) 2008 John MacFarlane + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +{- | + Module : Text.Pandoc.Writers.MediaWiki + Copyright : Copyright (C) 2006-7 John MacFarlane + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane + Stability : alpha + Portability : portable + +Conversion of 'Pandoc' documents to MediaWiki markup. + +MediaWiki: +-} +module Text.Pandoc.Writers.MediaWiki ( writeMediaWiki ) where +import Text.Pandoc.Definition +import Text.Pandoc.Shared +import Text.Pandoc.XML ( escapeStringForXML ) +import Data.List ( intersect ) +import Network.URI ( isURI ) +import Control.Monad.State + +data WriterState = WriterState { + stNotes :: Bool -- True if there are notes + , stListLevel :: [Char] -- String at beginning of list items, e.g. "**" + , stUseTags :: Bool -- True if we should use HTML tags because we're in a complex list + } + +-- | Convert Pandoc to MediaWiki. +writeMediaWiki :: WriterOptions -> Pandoc -> String +writeMediaWiki opts document = + evalState (pandocToMediaWiki opts document) + (WriterState { stNotes = False, stListLevel = [], stUseTags = False }) + +-- | Return MediaWiki representation of document. +pandocToMediaWiki :: WriterOptions -> Pandoc -> State WriterState String +pandocToMediaWiki opts (Pandoc _ blocks) = do + let before = writerIncludeBefore opts + let after = writerIncludeAfter opts + let head' = if writerStandalone opts + then writerHeader opts + else "" + let toc = if writerTableOfContents opts + then "__TOC__\n" + else "" + body <- blockListToMediaWiki opts blocks + notesExist <- get >>= return . stNotes + let notes = if notesExist + then "\n== Notes ==\n" + else "" + return $ head' ++ before ++ toc ++ body ++ after ++ notes + +-- | Escape special characters for MediaWiki. +escapeString :: String -> String +escapeString = escapeStringForXML + +-- | Convert Pandoc block element to MediaWiki. +blockToMediaWiki :: WriterOptions -- ^ Options + -> Block -- ^ Block element + -> State WriterState String + +blockToMediaWiki _ Null = return "" + +blockToMediaWiki opts (Plain inlines) = + inlineListToMediaWiki opts inlines + +blockToMediaWiki opts (Para inlines) = do + useTags <- get >>= return . stUseTags + listLevel <- get >>= return . stListLevel + contents <- inlineListToMediaWiki opts inlines + return $ if useTags + then "

" ++ contents ++ "

" + else contents ++ if null listLevel then "\n" else "" + +blockToMediaWiki _ (RawHtml str) = return str + +blockToMediaWiki _ HorizontalRule = return "\n-----\n" + +blockToMediaWiki opts (Header level inlines) = do + contents <- inlineListToMediaWiki opts inlines + let eqs = replicate (level + 1) '=' + return $ eqs ++ " " ++ contents ++ " " ++ eqs ++ "\n" + +blockToMediaWiki _ (CodeBlock (_,classes,_) str) = do + let at = classes `intersect` ["actionscript", "ada", "apache", "applescript", "asm", "asp", + "autoit", "bash", "blitzbasic", "bnf", "c", "c_mac", "caddcl", "cadlisp", "cfdg", "cfm", + "cpp", "cpp-qt", "csharp", "css", "d", "delphi", "diff", "div", "dos", "eiffel", "fortran", + "freebasic", "gml", "groovy", "html4strict", "idl", "ini", "inno", "io", "java", "java5", + "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", + "visualfoxpro", "winbatch", "xml", "xpp", "z80"] + let (beg, end) = if null at + then ("" else " class=\"" ++ unwords classes ++ "\">", "") + else ("", "") + return $ beg ++ escapeString str ++ end + +blockToMediaWiki opts (BlockQuote blocks) = do + contents <- blockListToMediaWiki opts blocks + return $ "
" ++ contents ++ "
" + +blockToMediaWiki opts (Table caption aligns widths headers rows) = do + let alignStrings = map alignmentToString aligns + captionDoc <- if null caption + then return "" + else do + c <- inlineListToMediaWiki opts caption + return $ "" ++ c ++ "" + colHeads <- colHeadsToMediaWiki opts alignStrings widths headers + rows' <- mapM (tableRowToMediaWiki opts alignStrings) rows + return $ "\n" ++ captionDoc ++ colHeads ++ vcat rows' ++ "\n
" + +blockToMediaWiki opts x@(BulletList items) = do + oldUseTags <- get >>= return . stUseTags + let useTags = oldUseTags || not (isSimpleList x) + if useTags + then do + modify $ \s -> s { stUseTags = True } + contents <- mapM (listItemToMediaWiki opts) items + modify $ \s -> s { stUseTags = oldUseTags } + return $ "
    \n" ++ vcat contents ++ "
\n" + else do + modify $ \s -> s { stListLevel = stListLevel s ++ "*" } + contents <- mapM (listItemToMediaWiki opts) items + modify $ \s -> s { stListLevel = init (stListLevel s) } + return $ vcat contents + +blockToMediaWiki opts x@(OrderedList attribs items) = do + oldUseTags <- get >>= return . stUseTags + let useTags = oldUseTags || not (isSimpleList x) + if useTags + then do + modify $ \s -> s { stUseTags = True } + contents <- mapM (listItemToMediaWiki opts) items + modify $ \s -> s { stUseTags = oldUseTags } + return $ "\n" ++ vcat contents ++ "\n" + else do + modify $ \s -> s { stListLevel = stListLevel s ++ "#" } + contents <- mapM (listItemToMediaWiki opts) items + modify $ \s -> s { stListLevel = init (stListLevel s) } + return $ vcat contents + +blockToMediaWiki opts x@(DefinitionList items) = do + oldUseTags <- get >>= return . stUseTags + let useTags = oldUseTags || not (isSimpleList x) + if useTags + then do + modify $ \s -> s { stUseTags = True } + contents <- mapM (definitionListItemToMediaWiki opts) items + modify $ \s -> s { stUseTags = oldUseTags } + return $ "
\n" ++ vcat contents ++ "
\n" + else do + modify $ \s -> s { stListLevel = stListLevel s ++ ";" } + contents <- mapM (definitionListItemToMediaWiki opts) items + modify $ \s -> s { stListLevel = init (stListLevel s) } + return $ vcat contents + +-- 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 MediaWiki. +listItemToMediaWiki :: WriterOptions -> [Block] -> State WriterState String +listItemToMediaWiki opts items = do + contents <- blockListToMediaWiki opts items + useTags <- get >>= return . stUseTags + if useTags + then return $ "
  • " ++ contents ++ "
    • " + else do + marker <- get >>= return . stListLevel + return $ marker ++ " " ++ contents + +-- | Convert definition list item (label, list of blocks) to MediaWiki. +definitionListItemToMediaWiki :: WriterOptions + -> ([Inline],[Block]) + -> State WriterState String +definitionListItemToMediaWiki opts (label, items) = do + labelText <- inlineListToMediaWiki opts label + contents <- blockListToMediaWiki opts items + useTags <- get >>= return . stUseTags + if useTags + then return $ "
    " ++ labelText ++ "
    \n
    " ++ contents ++ "
    " + else do + marker <- get >>= return . stListLevel + return $ marker ++ " " ++ labelText ++ "\n" ++ (init marker ++ ": ") ++ 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 (num, sty, _) items -> all isSimpleListItem items && + num == 1 && sty `elem` [DefaultStyle, Decimal] + DefinitionList items -> all isSimpleListItem $ map snd items + _ -> 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 + DefinitionList _ -> isSimpleList x + _ -> False +isSimpleListItem [x, y] | isPlainOrPara x = + case y of + BulletList _ -> isSimpleList y + OrderedList _ _ -> isSimpleList y + DefinitionList _ -> isSimpleList y + _ -> False +isSimpleListItem _ = False + +isPlainOrPara :: Block -> Bool +isPlainOrPara (Plain _) = True +isPlainOrPara (Para _) = True +isPlainOrPara _ = False + +tr :: String -> String +tr x = "\n" ++ x ++ "\n" + +-- | Concatenates strings with line breaks between them. +vcat :: [String] -> String +vcat [] = "" +vcat [x] = x +vcat (x:xs) = x ++ "\n" ++ vcat xs + +-- Auxiliary functions for tables: + +colHeadsToMediaWiki :: WriterOptions + -> [[Char]] + -> [Double] + -> [[Block]] + -> State WriterState String +colHeadsToMediaWiki opts alignStrings widths headers = do + heads <- sequence $ zipWith3 + (\alignment columnwidth item -> tableItemToMediaWiki opts "th" alignment columnwidth item) + alignStrings widths headers + return $ tr $ vcat heads + +alignmentToString :: Alignment -> [Char] +alignmentToString alignment = case alignment of + AlignLeft -> "left" + AlignRight -> "right" + AlignCenter -> "center" + AlignDefault -> "left" + +tableRowToMediaWiki :: WriterOptions + -> [[Char]] + -> [[Block]] + -> State WriterState String +tableRowToMediaWiki opts aligns columns = + (sequence $ zipWith3 (tableItemToMediaWiki opts "td") aligns (repeat 0) columns) >>= + return . tr . vcat + +tableItemToMediaWiki :: WriterOptions + -> [Char] + -> [Char] + -> Double + -> [Block] + -> State WriterState String +tableItemToMediaWiki opts tag' align' width' item = do + contents <- blockListToMediaWiki opts item + let attrib = " align=\"" ++ align' ++ "\"" ++ + if width' /= 0 + then " style=\"width: " ++ (show (truncate (100 * width') :: Integer)) ++ "%;\"" + else "" + return $ "<" ++ tag' ++ attrib ++ ">" ++ contents ++ "" + +-- | Convert list of Pandoc block elements to MediaWiki. +blockListToMediaWiki :: WriterOptions -- ^ Options + -> [Block] -- ^ List of block elements + -> State WriterState String +blockListToMediaWiki opts blocks = + mapM (blockToMediaWiki opts) blocks >>= return . vcat + +-- | Convert list of Pandoc inline elements to MediaWiki. +inlineListToMediaWiki :: WriterOptions -> [Inline] -> State WriterState String +inlineListToMediaWiki opts lst = + mapM (inlineToMediaWiki opts) lst >>= return . concat + +-- | Convert Pandoc inline element to MediaWiki. +inlineToMediaWiki :: WriterOptions -> Inline -> State WriterState String + +inlineToMediaWiki opts (Emph lst) = do + contents <- inlineListToMediaWiki opts lst + return $ "''" ++ contents ++ "''" + +inlineToMediaWiki opts (Strong lst) = do + contents <- inlineListToMediaWiki opts lst + return $ "'''" ++ contents ++ "'''" + +inlineToMediaWiki opts (Strikeout lst) = do + contents <- inlineListToMediaWiki opts lst + return $ "" ++ contents ++ "" + +inlineToMediaWiki opts (Superscript lst) = do + contents <- inlineListToMediaWiki opts lst + return $ "" ++ contents ++ "" + +inlineToMediaWiki opts (Subscript lst) = do + contents <- inlineListToMediaWiki opts lst + return $ "" ++ contents ++ "" + +inlineToMediaWiki opts (SmallCaps lst) = inlineListToMediaWiki opts lst + +inlineToMediaWiki opts (Quoted SingleQuote lst) = do + contents <- inlineListToMediaWiki opts lst + return $ "‘" ++ contents ++ "’" + +inlineToMediaWiki opts (Quoted DoubleQuote lst) = do + contents <- inlineListToMediaWiki opts lst + return $ "“" ++ contents ++ "”" + +inlineToMediaWiki opts (Cite _ lst) = inlineListToMediaWiki opts lst + +inlineToMediaWiki _ EmDash = return "—" + +inlineToMediaWiki _ EnDash = return "–" + +inlineToMediaWiki _ Apostrophe = return "’" + +inlineToMediaWiki _ Ellipses = return "…" + +inlineToMediaWiki _ (Code str) = + return $ "" ++ (escapeString str) ++ "" + +inlineToMediaWiki _ (Str str) = return $ escapeString str + +inlineToMediaWiki _ (Math _ str) = return $ "" ++ str ++ "" + -- note: str should NOT be escaped + +inlineToMediaWiki _ (TeX _) = return "" + +inlineToMediaWiki _ (HtmlInline str) = return str + +inlineToMediaWiki _ (LineBreak) = return "
    \n" + +inlineToMediaWiki _ Space = return " " + +inlineToMediaWiki opts (Link txt (src, _)) = do + link <- inlineListToMediaWiki opts txt + let useAuto = txt == [Code src] + let src' = if isURI src + then src + else if take 1 src == "/" + then "http://{{SERVERNAME}}" ++ src + else "http://{{SERVERNAME}}/" ++ src + return $ if useAuto + then src' + else "[" ++ src' ++ " " ++ link ++ "]" + +inlineToMediaWiki opts (Image alt (source, tit)) = do + alt' <- inlineListToMediaWiki opts alt + let txt = if (null tit) + then if null alt + then "" + else "|" ++ alt' + else "|" ++ tit + return $ "[[Image:" ++ source ++ txt ++ "]]" + +inlineToMediaWiki opts (Note contents) = do + contents' <- blockListToMediaWiki opts contents + modify (\s -> s { stNotes = True }) + return $ "" ++ contents' ++ "" + -- note - may not work for notes with multiple blocks -- cgit v1.2.3