{-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Writers.DokuWiki Copyright : Copyright (C) 2008-2024 John MacFarlane License : GNU GPL, version 2 or above Maintainer : Clare Macrae Stability : alpha Portability : portable Conversion of 'Pandoc' documents to DokuWiki markup. DokuWiki: -} {- [x] Implement nested blockquotes (currently only ever does one level) [x] Implement alignment of text in tables [ ] Implement comments [ ] Work through the Dokuwiki spec, and check I've not missed anything out [ ] Remove dud/duplicate code -} module Text.Pandoc.Writers.DokuWiki ( writeDokuWiki ) where import Control.Monad (zipWithM) import Control.Monad.Reader (ReaderT, asks, local, runReaderT) import Control.Monad.State.Strict (StateT, evalStateT) import Data.Default (Default (..)) import Data.List (transpose) import Data.List.NonEmpty (nonEmpty) import Data.Text (Text) import qualified Data.Text as T import Text.Pandoc.Class.PandocMonad (PandocMonad, report) import Text.Pandoc.Definition import Text.Pandoc.Extensions import Text.Pandoc.ImageSize import Text.Pandoc.Logging import Text.Pandoc.Options (WrapOption (..), WriterOptions (writerTableOfContents, writerTemplate, writerWrapText), isEnabled) import Text.Pandoc.Shared (figureDiv, linesToPara, removeFormatting, trimr) import Text.Pandoc.URI (escapeURI, isURI) import Text.Pandoc.Templates (renderTemplate) import Text.DocLayout (render, literal) import Text.Pandoc.Writers.Shared (defField, metaToContext, toLegacyTable) import Data.Maybe (fromMaybe) import qualified Data.Map as M data WriterState = WriterState { } data WriterEnvironment = WriterEnvironment { stIndent :: Text -- Indent after the marker at the beginning of list items , stBackSlashLB :: Bool -- True if we should produce formatted strings with newlines (as in a table cell) , stBlockQuoteLevel :: Int -- Block quote level } instance Default WriterState where def = WriterState {} instance Default WriterEnvironment where def = WriterEnvironment { stIndent = "" , stBackSlashLB = False , stBlockQuoteLevel = 0 } type DokuWiki m = ReaderT WriterEnvironment (StateT WriterState m) -- | Convert Pandoc to DokuWiki. writeDokuWiki :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeDokuWiki opts document = runDokuWiki (pandocToDokuWiki opts document) runDokuWiki :: PandocMonad m => DokuWiki m a -> m a runDokuWiki = flip evalStateT def . flip runReaderT def -- | Return DokuWiki representation of document. pandocToDokuWiki :: PandocMonad m => WriterOptions -> Pandoc -> DokuWiki m Text pandocToDokuWiki opts (Pandoc meta blocks) = do metadata <- metaToContext opts (fmap (literal . trimr) . blockListToDokuWiki opts) (fmap (literal . trimr) . inlineListToDokuWiki opts) meta body <- blockListToDokuWiki opts blocks let context = defField "body" body $ defField "toc" (writerTableOfContents opts) metadata return $ case writerTemplate opts of Nothing -> body Just tpl -> render Nothing $ renderTemplate tpl context -- | Escape special characters for DokuWiki. escapeString :: Text -> Text escapeString = T.replace "__" "%%__%%" . T.replace "**" "%%**%%" . T.replace "//" "%%//%%" -- | Convert Pandoc block element to DokuWiki. blockToDokuWiki :: PandocMonad m => WriterOptions -- ^ Options -> Block -- ^ Block element -> DokuWiki m Text blockToDokuWiki opts (Div _attrs bs) = do contents <- blockListToDokuWiki opts bs indent <- asks stIndent return $ contents <> if T.null indent then "\n" else "" blockToDokuWiki opts (Plain inlines) = inlineListToDokuWiki opts inlines blockToDokuWiki opts (Para inlines) = do bqLevel <- asks stBlockQuoteLevel let bqPrefix = case bqLevel of 0 -> "" n -> T.replicate n ">" <> " " indent <- asks stIndent contents <- inlineListToDokuWiki opts inlines return $ bqPrefix <> contents <> if T.null indent then "\n" else "" blockToDokuWiki opts (LineBlock lns) = blockToDokuWiki opts $ linesToPara lns blockToDokuWiki opts b@(RawBlock f str) | f == Format "dokuwiki" = return str -- See https://www.dokuwiki.org/wiki:syntax -- use uppercase HTML tag for block-level content: | f == Format "html" , isEnabled Ext_raw_html opts = return $ "\n" <> str <> "\n" | otherwise = "" <$ report (BlockNotRendered b) blockToDokuWiki _ HorizontalRule = return "\n----\n" blockToDokuWiki opts (Header level _ inlines) = do -- emphasis, links etc. not allowed in headers, apparently, -- so we remove formatting: contents <- inlineListToDokuWiki opts $ removeFormatting inlines let eqs = T.replicate ( 7 - level ) "=" return $ eqs <> " " <> contents <> " " <> eqs <> "\n" blockToDokuWiki _ (CodeBlock (_,classes,_) str) = do bqLevel <- asks stBlockQuoteLevel let bqPrefix = case bqLevel of 0 -> "" n -> T.replicate n ">" <> " " return $ bqPrefix <> " (case classes of [] -> "" (x:_) -> " " <> fromMaybe x (M.lookup x languageNames)) <> ">\n" <> str <> (if "\n" `T.isSuffixOf` str then "" else "\n") <> "\n" blockToDokuWiki opts (BlockQuote blocks) = local (\st -> st{ stBlockQuoteLevel = stBlockQuoteLevel st + 1 }) (blockListToDokuWiki opts blocks) blockToDokuWiki opts (Table _ blkCapt specs thead tbody tfoot) = do let (capt, aligns, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot captionDoc <- if null capt then return "" else do c <- inlineListToDokuWiki opts capt return $ "" <> c <> "\n" headers' <- if all null headers then return [] else zipWithM (tableItemToDokuWiki opts) aligns headers rows' <- mapM (zipWithM (tableItemToDokuWiki opts) aligns) rows let widths = map (maybe 0 maximum . nonEmpty . map T.length) $ transpose (headers':rows') let padTo (width, al) s = case width - T.length s of x | x > 0 -> if al == AlignLeft || al == AlignDefault then s <> T.replicate x " " else if al == AlignRight then T.replicate x " " <> s else T.replicate (x `div` 2) " " <> s <> T.replicate (x - x `div` 2) " " | otherwise -> s let renderRow sep cells = sep <> T.intercalate sep (zipWith padTo (zip widths aligns) cells) <> sep return $ captionDoc <> (if null headers' then "" else renderRow "^" headers' <> "\n") <> T.unlines (map (renderRow "|") rows') blockToDokuWiki opts (BulletList items) = do indent <- asks stIndent backSlash <- asks stBackSlashLB contents <- local (\s -> s { stIndent = stIndent s <> " " , stBackSlashLB = backSlash}) (mapM (listItemToDokuWiki opts) items) return $ vcat contents <> if T.null indent then "\n" else "" blockToDokuWiki opts (OrderedList _attribs items) = do indent <- asks stIndent backSlash <- asks stBackSlashLB contents <- local (\s -> s { stIndent = stIndent s <> " " , stBackSlashLB = backSlash}) (mapM (orderedListItemToDokuWiki opts) items) return $ vcat contents <> if T.null indent then "\n" else "" blockToDokuWiki opts (Figure attr capt body) = blockToDokuWiki opts $ figureDiv attr capt body -- TODO Need to decide how to make definition lists work on dokuwiki - I don't think there -- is a specific representation of them. -- TODO This creates double '; ; ' if there is a bullet or ordered list inside a definition list blockToDokuWiki opts (DefinitionList items) = do indent <- asks stIndent backSlash <- asks stBackSlashLB contents <- local (\s -> s { stIndent = stIndent s <> " " , stBackSlashLB = backSlash}) (mapM (definitionListItemToDokuWiki opts) items) return $ vcat contents <> if T.null indent then "\n" else "" -- Auxiliary functions for lists: -- | Convert bullet list item (list of blocks) to DokuWiki. listItemToDokuWiki :: PandocMonad m => WriterOptions -> [Block] -> DokuWiki m Text listItemToDokuWiki opts items = do bqLevel <- asks stBlockQuoteLevel let bqPrefix = case bqLevel of 0 -> "" n -> T.replicate n ">" <> " " let useWrap = not (isSimpleListItem items) bs <- mapM (blockToDokuWiki opts) items let contents = case items of [_, CodeBlock _ _] -> T.concat bs _ -> vcat bs indent <- asks stIndent backSlash <- asks stBackSlashLB let indent' = if backSlash then T.drop 2 indent else indent return $ bqPrefix <> indent' <> "* " <> if useWrap then "\n" <> contents <> "\n" else contents -- | Convert ordered list item (list of blocks) to DokuWiki. -- | TODO Emiminate dreadful duplication of text from listItemToDokuWiki orderedListItemToDokuWiki :: PandocMonad m => WriterOptions -> [Block] -> DokuWiki m Text orderedListItemToDokuWiki opts items = do bqLevel <- asks stBlockQuoteLevel let bqPrefix = case bqLevel of 0 -> "" n -> T.replicate n ">" <> " " let useWrap = not (isSimpleListItem items) contents <- local (\st -> st{ stBlockQuoteLevel = 0 }) (blockListToDokuWiki opts items) indent <- asks stIndent backSlash <- asks stBackSlashLB let indent' = if backSlash then T.drop 2 indent else indent return $ bqPrefix <> indent' <> "- " <> if useWrap then "\n" <> contents <> "\n" else contents -- | Convert definition list item (label, list of blocks) to DokuWiki. definitionListItemToDokuWiki :: PandocMonad m => WriterOptions -> ([Inline],[[Block]]) -> DokuWiki m Text definitionListItemToDokuWiki opts (label, items) = do let useWrap = not (all isSimpleListItem items) bqLevel <- asks stBlockQuoteLevel let bqPrefix = case bqLevel of 0 -> "" n -> T.replicate n ">" <> " " labelText <- inlineListToDokuWiki opts label contents <- local (\st -> st{ stBlockQuoteLevel = 0 }) (mapM (blockListToDokuWiki opts) items) indent <- asks stIndent backSlash <- asks stBackSlashLB let indent' = if backSlash then T.drop 2 indent else indent return $ bqPrefix <> indent' <> "* **" <> labelText <> "** " <> if useWrap then "\n" <> vcat contents <> "\n" else T.intercalate "; " contents -- | True if list item can be handled with the simple wiki syntax. False if -- WRAP tags will be needed. isSimpleListItem :: [Block] -> Bool isSimpleListItem [] = True isSimpleListItem [x, CodeBlock{}] | isPlainOrPara x = True isSimpleListItem (Div _ bs : ys) = -- see #8920 isSimpleListItem bs && all isSimpleList ys isSimpleListItem (x:ys) | isPlainOrPara x = all isSimpleList ys isSimpleListItem _ = False --- | 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 (1, _, _) items -> all isSimpleListItem items DefinitionList items -> all (all isSimpleListItem . snd) items _ -> False isPlainOrPara :: Block -> Bool isPlainOrPara (Plain _) = True isPlainOrPara (Para _) = True isPlainOrPara _ = False -- | Concatenates strings with line breaks between them. vcat :: [Text] -> Text vcat = T.intercalate "\n" -- | For each string in the input list, convert all newlines to -- dokuwiki escaped newlines. Then concat the list using double linebreaks. backSlashLineBreaks :: [Text] -> Text backSlashLineBreaks ls = vcatBackSlash $ map (T.pack . escape . T.unpack) ls where vcatBackSlash = T.intercalate "\\\\ \\\\ " -- simulate paragraphs. escape ['\n'] = "" -- remove trailing newlines escape ('\n':cs) = "\\\\ " <> escape cs escape (c:cs) = c : escape cs escape [] = [] -- Auxiliary functions for tables: tableItemToDokuWiki :: PandocMonad m => WriterOptions -> Alignment -> [Block] -> DokuWiki m Text tableItemToDokuWiki opts align' item = do let mkcell x = (if align' == AlignRight || align' == AlignCenter then " " else "") <> x <> (if align' == AlignLeft || align' == AlignCenter then " " else "") contents <- local (\s -> s { stBackSlashLB = True , stBlockQuoteLevel = 0 }) $ blockListToDokuWiki opts item return $ mkcell contents -- | Convert list of Pandoc block elements to DokuWiki. blockListToDokuWiki :: PandocMonad m => WriterOptions -- ^ Options -> [Block] -- ^ List of block elements -> DokuWiki m Text blockListToDokuWiki opts blocks = do backSlash <- asks stBackSlashLB let blocks' = consolidateRawBlocks blocks if backSlash then backSlashLineBreaks <$> mapM (blockToDokuWiki opts) blocks' else vcat <$> mapM (blockToDokuWiki opts) blocks' consolidateRawBlocks :: [Block] -> [Block] consolidateRawBlocks [] = [] consolidateRawBlocks (RawBlock f1 b1 : RawBlock f2 b2 : xs) | f1 == f2 = consolidateRawBlocks (RawBlock f1 (b1 <> "\n" <> b2) : xs) consolidateRawBlocks (x:xs) = x : consolidateRawBlocks xs -- | Convert list of Pandoc inline elements to DokuWiki. inlineListToDokuWiki :: PandocMonad m => WriterOptions -> [Inline] -> DokuWiki m Text inlineListToDokuWiki opts lst = T.concat <$> mapM (inlineToDokuWiki opts) lst -- | Convert Pandoc inline element to DokuWiki. inlineToDokuWiki :: PandocMonad m => WriterOptions -> Inline -> DokuWiki m Text inlineToDokuWiki opts (Span _attrs ils) = inlineListToDokuWiki opts ils inlineToDokuWiki opts (Emph lst) = do contents <- inlineListToDokuWiki opts lst return $ "//" <> contents <> "//" inlineToDokuWiki opts (Underline 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) = -- In dokuwiki, text surrounded by '' is really just a font statement, i.e. , -- and so other formatting can be present inside. -- However, in pandoc, and markdown, inlined code doesn't contain formatting. -- So I have opted for using %% to disable all formatting inside inline code blocks. -- This gives the best results when converting from other formats to dokuwiki, even if -- the resultand code is a little ugly, for short strings that don't contain formatting -- characters. -- It does mean that if pandoc could ever read dokuwiki, and so round-trip the format, -- any formatting inside inlined code blocks would be lost, or presented incorrectly. return $ "''%%" <> str <> "%%''" inlineToDokuWiki _ (Str str) = return $ escapeString str inlineToDokuWiki _ (Math mathType str) = return $ delim <> str <> delim -- note: str should NOT be escaped where delim = case mathType of DisplayMath -> "$$" InlineMath -> "$" inlineToDokuWiki opts il@(RawInline f str) | f == Format "dokuwiki" = return str | f == Format "html" , isEnabled Ext_raw_html opts = return $ "" <> str <> "" | otherwise = "" <$ report (InlineNotRendered il) inlineToDokuWiki _ LineBreak = do backSlash <- asks stBackSlashLB return $ if backSlash then "\n" else "\\\\\n" inlineToDokuWiki opts SoftBreak = case writerWrapText opts of WrapNone -> return " " WrapAuto -> return " " WrapPreserve -> return "\n" inlineToDokuWiki _ Space = return " " inlineToDokuWiki opts (Link _ txt (src, _)) = do label <- inlineListToDokuWiki opts txt case txt of [Str s] | "mailto:" `T.isPrefixOf` src -> return $ "<" <> s <> ">" | escapeURI s == src -> return src _ -> if isURI src then return $ "[[" <> src <> "|" <> label <> "]]" else return $ "[[" <> src' <> "|" <> label <> "]]" where src' = case T.uncons src of Just ('/',xs) -> xs -- with leading / it's a _ -> src -- link to a help page inlineToDokuWiki opts (Image attr alt (source, tit)) = do alt' <- inlineListToDokuWiki opts alt let txt = case (tit, alt) of ("", []) -> "" ("", _ ) -> "|" <> alt' (_ , _ ) -> "|" <> tit return $ "{{" <> source <> imageDims opts attr <> txt <> "}}" inlineToDokuWiki opts (Note contents) = do contents' <- local (\st -> st{ stBlockQuoteLevel = 0 }) (blockListToDokuWiki opts contents) return $ "((" <> contents' <> "))" -- note - may not work for notes with multiple blocks imageDims :: WriterOptions -> Attr -> Text imageDims opts attr = go (toPx $ dimension Width attr) (toPx $ dimension Height attr) where toPx = fmap (showInPixel opts) . checkPct checkPct (Just (Percent _)) = Nothing checkPct maybeDim = maybeDim go (Just w) Nothing = "?" <> w go (Just w) (Just h) = "?" <> w <> "x" <> h go Nothing (Just h) = "?0x" <> h go Nothing Nothing = "" languageNames :: M.Map Text Text languageNames = M.fromList [("cs", "csharp") ,("coffee", "cofeescript") ,("commonlisp", "lisp") ,("gcc", "c") ,("html", "html5") ,("makefile", "make") ,("objectivec", "objc") ,("r", "rsplus") ,("sqlmysql", "mysql") ,("sqlpostgresql", "postgresql") ,("sci", "scilab") ,("xorg", "xorgconf") ]