From 7eded47bcdd10d1e32125121c7b84f952b1a326e Mon Sep 17 00:00:00 2001 From: Clare Macrae Date: Sun, 14 Jul 2013 13:40:27 +0100 Subject: Initial work to create dokuwiki writer (#386) In this first version, all dokuwiki files are straight copies of the media wiki counterparts. --- src/Text/Pandoc.hs | 3 + src/Text/Pandoc/Writers/DokuWiki.hs | 407 ++++++++++++++++++++++++++++++++++++ 2 files changed, 410 insertions(+) create mode 100644 src/Text/Pandoc/Writers/DokuWiki.hs (limited to 'src/Text') diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs index 86e78ce53..4cebd2f75 100644 --- a/src/Text/Pandoc.hs +++ b/src/Text/Pandoc.hs @@ -88,6 +88,7 @@ module Text.Pandoc , writeOpenDocument , writeMan , writeMediaWiki + , writeDokuWiki , writeTextile , writeRTF , writeODT @@ -137,6 +138,7 @@ import Text.Pandoc.Writers.OpenDocument import Text.Pandoc.Writers.Man import Text.Pandoc.Writers.RTF import Text.Pandoc.Writers.MediaWiki +import Text.Pandoc.Writers.DokuWiki import Text.Pandoc.Writers.Textile import Text.Pandoc.Writers.Org import Text.Pandoc.Writers.AsciiDoc @@ -257,6 +259,7 @@ writers = [ ,("plain" , PureStringWriter writePlain) ,("rst" , PureStringWriter writeRST) ,("mediawiki" , PureStringWriter writeMediaWiki) + ,("dokuwiki" , PureStringWriter writeDokuWiki) ,("textile" , PureStringWriter writeTextile) ,("rtf" , IOStringWriter writeRTFWithEmbeddedImages) ,("org" , PureStringWriter writeOrg) diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs new file mode 100644 index 000000000..b3483adf2 --- /dev/null +++ b/src/Text/Pandoc/Writers/DokuWiki.hs @@ -0,0 +1,407 @@ +{- +Copyright (C) 2008-2010 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.DokuWiki + Copyright : Copyright (C) 2008-2010 John MacFarlane + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane + Stability : alpha + Portability : portable + +Conversion of 'Pandoc' documents to DokuWiki markup. + +DokuWiki: +-} +module Text.Pandoc.Writers.DokuWiki ( writeDokuWiki ) where +import Text.Pandoc.Definition +import Text.Pandoc.Options +import Text.Pandoc.Shared +import Text.Pandoc.Writers.Shared +import Text.Pandoc.Templates (renderTemplate') +import Text.Pandoc.XML ( escapeStringForXML ) +import Data.List ( intersect, intercalate ) +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 DokuWiki. +writeDokuWiki :: WriterOptions -> Pandoc -> String +writeDokuWiki opts document = + evalState (pandocToDokuWiki opts document) + (WriterState { stNotes = False, stListLevel = [], stUseTags = False }) + +-- | Return DokuWiki representation of document. +pandocToDokuWiki :: WriterOptions -> Pandoc -> State WriterState String +pandocToDokuWiki opts (Pandoc meta blocks) = do + metadata <- metaToJSON opts + (fmap trimr . blockListToDokuWiki opts) + (inlineListToDokuWiki opts) + meta + body <- blockListToDokuWiki opts blocks + notesExist <- get >>= return . stNotes + let notes = if notesExist + then "\n" + else "" + let main = body ++ notes + let context = defField "body" main + $ defField "toc" (writerTableOfContents opts) + $ metadata + if writerStandalone opts + then return $ renderTemplate' (writerTemplate opts) context + else return main + +-- | Escape special characters for DokuWiki. +escapeString :: String -> String +escapeString = escapeStringForXML + +-- | Convert Pandoc block element to DokuWiki. +blockToDokuWiki :: WriterOptions -- ^ Options + -> Block -- ^ Block element + -> State WriterState String + +blockToDokuWiki _ Null = return "" + +blockToDokuWiki opts (Plain inlines) = + inlineListToDokuWiki opts inlines + +-- title beginning with fig: indicates that the image is a figure +blockToDokuWiki opts (Para [Image txt (src,'f':'i':'g':':':tit)]) = do + capt <- if null txt + then return "" + else ("|caption " ++) `fmap` inlineListToDokuWiki opts txt + let opt = if null txt + then "" + else "|alt=" ++ if null tit then capt else tit ++ capt + return $ "[[Image:" ++ src ++ "|frame|none" ++ opt ++ "]]\n" + +blockToDokuWiki opts (Para inlines) = do + useTags <- get >>= return . stUseTags + listLevel <- get >>= return . stListLevel + contents <- inlineListToDokuWiki opts inlines + return $ if useTags + then "

" ++ contents ++ "

" + else contents ++ if null listLevel then "\n" else "" + +blockToDokuWiki _ (RawBlock "mediawiki" str) = return str +blockToDokuWiki _ (RawBlock "html" str) = return str +blockToDokuWiki _ (RawBlock _ _) = return "" + +blockToDokuWiki _ HorizontalRule = return "\n-----\n" + +blockToDokuWiki opts (Header level _ inlines) = do + contents <- inlineListToDokuWiki opts inlines + let eqs = replicate level '=' + return $ eqs ++ " " ++ contents ++ " " ++ eqs ++ "\n" + +blockToDokuWiki _ (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 + +blockToDokuWiki opts (BlockQuote blocks) = do + contents <- blockListToDokuWiki opts blocks + return $ "
" ++ contents ++ "
" + +blockToDokuWiki opts (Table capt aligns widths headers rows') = do + let alignStrings = map alignmentToString aligns + captionDoc <- if null capt + then return "" + else do + c <- inlineListToDokuWiki opts capt + return $ "" ++ c ++ "\n" + let percent w = show (truncate (100*w) :: Integer) ++ "%" + let coltags = if all (== 0.0) widths + then "" + else unlines $ map + (\w -> "") widths + head' <- if all null headers + then return "" + else do + hs <- tableRowToDokuWiki opts alignStrings 0 headers + return $ "\n" ++ hs ++ "\n\n" + body' <- zipWithM (tableRowToDokuWiki opts alignStrings) [1..] rows' + return $ "\n" ++ captionDoc ++ coltags ++ head' ++ + "\n" ++ unlines body' ++ "\n
\n" + +blockToDokuWiki opts x@(BulletList items) = do + oldUseTags <- get >>= return . stUseTags + listLevel <- get >>= return . stListLevel + let useTags = oldUseTags || not (isSimpleList x) + if useTags + then do + modify $ \s -> s { stUseTags = True } + contents <- mapM (listItemToDokuWiki opts) items + modify $ \s -> s { stUseTags = oldUseTags } + return $ "
    \n" ++ vcat contents ++ "
\n" + else do + modify $ \s -> s { stListLevel = stListLevel s ++ "*" } + contents <- mapM (listItemToDokuWiki opts) items + modify $ \s -> s { stListLevel = init (stListLevel s) } + return $ vcat contents ++ if null listLevel then "\n" else "" + +blockToDokuWiki opts x@(OrderedList attribs items) = do + oldUseTags <- get >>= return . stUseTags + listLevel <- get >>= return . stListLevel + let useTags = oldUseTags || not (isSimpleList x) + if useTags + then do + modify $ \s -> s { stUseTags = True } + contents <- mapM (listItemToDokuWiki opts) items + modify $ \s -> s { stUseTags = oldUseTags } + return $ "\n" ++ vcat contents ++ "\n" + else do + modify $ \s -> s { stListLevel = stListLevel s ++ "#" } + contents <- mapM (listItemToDokuWiki opts) items + modify $ \s -> s { stListLevel = init (stListLevel s) } + return $ vcat contents ++ if null listLevel then "\n" else "" + +blockToDokuWiki opts x@(DefinitionList items) = do + oldUseTags <- get >>= return . stUseTags + listLevel <- get >>= return . stListLevel + let useTags = oldUseTags || not (isSimpleList x) + if useTags + then do + modify $ \s -> s { stUseTags = True } + contents <- mapM (definitionListItemToDokuWiki opts) items + modify $ \s -> s { stUseTags = oldUseTags } + return $ "
\n" ++ vcat contents ++ "
\n" + else do + modify $ \s -> s { stListLevel = stListLevel s ++ ";" } + contents <- mapM (definitionListItemToDokuWiki opts) items + modify $ \s -> s { stListLevel = init (stListLevel s) } + return $ vcat contents ++ if null listLevel then "\n" else "" + +-- 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 DokuWiki. +listItemToDokuWiki :: WriterOptions -> [Block] -> State WriterState String +listItemToDokuWiki opts items = do + contents <- blockListToDokuWiki 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 DokuWiki. +definitionListItemToDokuWiki :: WriterOptions + -> ([Inline],[[Block]]) + -> State WriterState String +definitionListItemToDokuWiki opts (label, items) = do + labelText <- inlineListToDokuWiki opts label + contents <- mapM (blockListToDokuWiki opts) items + useTags <- get >>= return . stUseTags + if useTags + then return $ "
    " ++ labelText ++ "
    \n" ++ + (intercalate "\n" $ map (\d -> "
    " ++ d ++ "
    ") contents) + else do + marker <- get >>= return . stListLevel + return $ marker ++ " " ++ labelText ++ "\n" ++ + (intercalate "\n" $ map (\d -> init marker ++ ": " ++ d) contents) + +-- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed. +isSimpleList :: Block -> Bool +isSimpleList x = + case x of + BulletList items -> all isSimpleListItem items + OrderedList (num, sty, _) items -> all isSimpleListItem items && + num == 1 && sty `elem` [DefaultStyle, Decimal] + DefinitionList items -> all isSimpleListItem $ concatMap 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 + +-- | Concatenates strings with line breaks between them. +vcat :: [String] -> String +vcat = intercalate "\n" + +-- Auxiliary functions for tables: + +tableRowToDokuWiki :: WriterOptions + -> [String] + -> Int + -> [[Block]] + -> State WriterState String +tableRowToDokuWiki opts alignStrings rownum cols' = do + let celltype = if rownum == 0 then "th" else "td" + let rowclass = case rownum of + 0 -> "header" + x | x `rem` 2 == 1 -> "odd" + _ -> "even" + cols'' <- sequence $ zipWith + (\alignment item -> tableItemToDokuWiki opts celltype alignment item) + alignStrings cols' + return $ "\n" ++ unlines cols'' ++ "" + +alignmentToString :: Alignment -> [Char] +alignmentToString alignment = case alignment of + AlignLeft -> "left" + AlignRight -> "right" + AlignCenter -> "center" + AlignDefault -> "left" + +tableItemToDokuWiki :: WriterOptions + -> String + -> String + -> [Block] + -> State WriterState String +tableItemToDokuWiki opts celltype align' item = do + let mkcell x = "<" ++ celltype ++ " align=\"" ++ align' ++ "\">" ++ + x ++ "" + contents <- blockListToDokuWiki opts item + return $ mkcell contents + +-- | Convert list of Pandoc block elements to DokuWiki. +blockListToDokuWiki :: WriterOptions -- ^ Options + -> [Block] -- ^ List of block elements + -> State WriterState String +blockListToDokuWiki opts blocks = + mapM (blockToDokuWiki opts) blocks >>= return . vcat + +-- | Convert list of Pandoc inline elements to DokuWiki. +inlineListToDokuWiki :: WriterOptions -> [Inline] -> State WriterState String +inlineListToDokuWiki opts lst = + mapM (inlineToDokuWiki opts) lst >>= return . concat + +-- | Convert Pandoc inline element to DokuWiki. +inlineToDokuWiki :: WriterOptions -> Inline -> State WriterState String + +inlineToDokuWiki opts (Emph lst) = do + contents <- inlineListToDokuWiki opts lst + return $ "''" ++ contents ++ "''" + +inlineToDokuWiki opts (Strong lst) = do + contents <- inlineListToDokuWiki opts lst + return $ "'''" ++ contents ++ "'''" + +inlineToDokuWiki opts (Strikeout lst) = do + contents <- inlineListToDokuWiki opts lst + return $ "" ++ contents ++ "" + +inlineToDokuWiki opts (Superscript lst) = do + contents <- inlineListToDokuWiki opts lst + return $ "" ++ contents ++ "" + +inlineToDokuWiki opts (Subscript lst) = do + contents <- inlineListToDokuWiki opts lst + return $ "" ++ contents ++ "" + +inlineToDokuWiki opts (SmallCaps lst) = inlineListToDokuWiki opts lst + +inlineToDokuWiki opts (Quoted SingleQuote lst) = do + contents <- inlineListToDokuWiki opts lst + return $ "\8216" ++ contents ++ "\8217" + +inlineToDokuWiki opts (Quoted DoubleQuote lst) = do + contents <- inlineListToDokuWiki opts lst + return $ "\8220" ++ contents ++ "\8221" + +inlineToDokuWiki opts (Cite _ lst) = inlineListToDokuWiki opts lst + +inlineToDokuWiki _ (Code _ str) = + return $ "" ++ (escapeString str) ++ "" + +inlineToDokuWiki _ (Str str) = return $ escapeString str + +inlineToDokuWiki _ (Math _ str) = return $ "" ++ str ++ "" + -- note: str should NOT be escaped + +inlineToDokuWiki _ (RawInline "mediawiki" str) = return str +inlineToDokuWiki _ (RawInline "html" str) = return str +inlineToDokuWiki _ (RawInline _ _) = return "" + +inlineToDokuWiki _ (LineBreak) = return "
    " + +inlineToDokuWiki _ Space = return " " + +inlineToDokuWiki opts (Link txt (src, _)) = do + label <- inlineListToDokuWiki opts txt + case txt of + [Str s] | escapeURI s == src -> return src + _ -> if isURI src + then return $ "[" ++ src ++ " " ++ label ++ "]" + else return $ "[[" ++ src' ++ "|" ++ label ++ "]]" + where src' = case src of + '/':xs -> xs -- with leading / it's a + _ -> src -- link to a help page +inlineToDokuWiki opts (Image alt (source, tit)) = do + alt' <- inlineListToDokuWiki opts alt + let txt = if (null tit) + then if null alt + then "" + else "|" ++ alt' + else "|" ++ tit + return $ "[[Image:" ++ source ++ txt ++ "]]" + +inlineToDokuWiki opts (Note contents) = do + contents' <- blockListToDokuWiki opts contents + modify (\s -> s { stNotes = True }) + return $ "" ++ contents' ++ "" + -- note - may not work for notes with multiple blocks -- cgit v1.2.3