diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/ZimWiki.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/ZimWiki.hs | 219 |
1 files changed, 130 insertions, 89 deletions
diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs index 423928c8a..dec1f9d4a 100644 --- a/src/Text/Pandoc/Writers/ZimWiki.hs +++ b/src/Text/Pandoc/Writers/ZimWiki.hs @@ -1,5 +1,6 @@ {- -Copyright (C) 2008-2015 John MacFarlane <jgm@berkeley.edu> +Copyright (C) 2008-2018 John MacFarlane <jgm@berkeley.edu> + 2017-2018 Alex Ivkin 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 @@ -18,11 +19,11 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.ZimWiki - Copyright : Copyright (C) 2008-2015 John MacFarlane, 2016 Alex Ivkin + Copyright : Copyright (C) 2008-2018 John MacFarlane, 2017-2018 Alex Ivkin License : GNU GPL, version 2 or above Maintainer : Alex Ivkin <alex@ivkin.net> - Stability : alpha + Stability : beta Portability : portable Conversion of 'Pandoc' documents to ZimWiki markup. @@ -31,48 +32,53 @@ http://zim-wiki.org/manual/Help/Wiki_Syntax.html -} module Text.Pandoc.Writers.ZimWiki ( writeZimWiki ) where +import Control.Monad (zipWithM) +import Control.Monad.State.Strict (StateT, evalStateT, gets, modify) +import Data.Default (Default (..)) +import Data.List (intercalate, isInfixOf, isPrefixOf, transpose) +import qualified Data.Map as Map +import Data.Maybe (fromMaybe) +import Data.Text (Text, breakOnAll, pack) +import Text.Pandoc.Class (PandocMonad, report) import Text.Pandoc.Definition -import Text.Pandoc.Options ( WriterOptions(writerTableOfContents, writerTemplate, writerWrapText), WrapOption(..) ) -import Text.Pandoc.Shared ( escapeURI, linesToPara, removeFormatting, trimr - , substitute ) -import Text.Pandoc.Writers.Shared ( defField, metaToJSON ) import Text.Pandoc.ImageSize -import Text.Pandoc.Templates ( renderTemplate' ) -import Data.List ( intercalate, isPrefixOf, transpose, isInfixOf ) -import Data.Text ( breakOnAll, pack ) -import Data.Default (Default(..)) -import Network.URI ( isURI ) -import Control.Monad ( zipWithM ) -import Control.Monad.State ( modify, State, get, evalState ) ---import Control.Monad.Reader ( ReaderT, runReaderT, ask, local ) +import Text.Pandoc.Logging +import Text.Pandoc.Options (WrapOption (..), WriterOptions (writerTableOfContents, writerTemplate, writerWrapText)) +import Text.Pandoc.Shared (escapeURI, isURI, linesToPara, removeFormatting, + substitute, trimr) +import Text.Pandoc.Templates (renderTemplate') +import Text.Pandoc.Writers.Shared (defField, metaToJSON) data WriterState = WriterState { - stItemNum :: Int, - stIndent :: String -- Indent after the marker at the beginning of list items + stItemNum :: Int, + stIndent :: String, -- Indent after the marker at the beginning of list items + stInTable :: Bool, -- Inside a table + stInLink :: Bool -- Inside a link description } instance Default WriterState where - def = WriterState { stItemNum = 1, stIndent = "" } + def = WriterState { stItemNum = 1, stIndent = "", stInTable = False, stInLink = False } + +type ZW = StateT WriterState -- | Convert Pandoc to ZimWiki. -writeZimWiki :: WriterOptions -> Pandoc -> String -writeZimWiki opts document = evalState (pandocToZimWiki opts document) (WriterState 1 "") +writeZimWiki :: PandocMonad m => WriterOptions -> Pandoc -> m Text +writeZimWiki opts document = evalStateT (pandocToZimWiki opts document) def -- | Return ZimWiki representation of document. -pandocToZimWiki :: WriterOptions -> Pandoc -> State WriterState String +pandocToZimWiki :: PandocMonad m => WriterOptions -> Pandoc -> ZW m Text pandocToZimWiki opts (Pandoc meta blocks) = do metadata <- metaToJSON opts (fmap trimr . blockListToZimWiki opts) (inlineListToZimWiki opts) meta - body <- blockListToZimWiki opts blocks + body <- pack <$> blockListToZimWiki opts blocks --let header = "Content-Type: text/x-zim-wiki\nWiki-Format: zim 0.4\n" let main = body let context = defField "body" main - $ defField "toc" (writerTableOfContents opts) - $ metadata + $ defField "toc" (writerTableOfContents opts) metadata case writerTemplate opts of - Just tpl -> return $ renderTemplate' tpl context + Just tpl -> renderTemplate' tpl context Nothing -> return main -- | Escape special characters for ZimWiki. @@ -83,7 +89,7 @@ escapeString = substitute "__" "''__''" . substitute "//" "''//''" -- | Convert Pandoc block element to ZimWiki. -blockToZimWiki :: WriterOptions -> Block -> State WriterState String +blockToZimWiki :: PandocMonad m => WriterOptions -> Block -> ZW m String blockToZimWiki _ Null = return "" @@ -107,18 +113,20 @@ blockToZimWiki opts (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do return $ "{{" ++ prefix ++ src ++ imageDims opts attr ++ opt ++ "}}\n" blockToZimWiki opts (Para inlines) = do - indent <- stIndent <$> get - -- useTags <- stUseTags <$> get + indent <- gets stIndent + -- useTags <- gets stUseTags contents <- inlineListToZimWiki opts inlines return $ contents ++ if null indent then "\n" else "" -blockToZimWiki opts (LineBlock lns) = do +blockToZimWiki opts (LineBlock lns) = blockToZimWiki opts $ linesToPara lns -blockToZimWiki opts (RawBlock f str) +blockToZimWiki opts b@(RawBlock f str) | f == Format "zimwiki" = return str - | f == Format "html" = do cont <- indentFromHTML opts str; return cont - | otherwise = return "" + | f == Format "html" = indentFromHTML opts str + | otherwise = do + report $ BlockNotRendered b + return "" blockToZimWiki _ HorizontalRule = return "\n----\n" @@ -128,9 +136,13 @@ blockToZimWiki opts (Header level _ inlines) = do return $ eqs ++ " " ++ contents ++ " " ++ eqs ++ "\n" blockToZimWiki _ (CodeBlock (_,classes,_) str) = do + -- Remap languages into the gtksourceview2 convention that ZimWiki source code plugin is using + let langal = [("javascript", "js"), ("bash", "sh"), ("winbatch", "dosbatch")] + let langmap = Map.fromList langal return $ case classes of - [] -> "'''\n" ++ cleanupCode str ++ "\n'''\n" -- no lang block is a quote block - (x:_) -> "{{{code: lang=\"" ++ x ++ "\" linenumbers=\"True\"\n" ++ str ++ "\n}}}\n" -- for zim's code plugin, go verbatim on the lang spec + [] -> "'''\n" ++ cleanupCode str ++ "\n'''\n" -- turn no lang block into a quote block + (x:_) -> "{{{code: lang=\"" ++ + fromMaybe x (Map.lookup x langmap) ++ "\" linenumbers=\"True\"\n" ++ str ++ "\n}}}\n" -- for zim's code plugin, go verbatim on the lang spec blockToZimWiki opts (BlockQuote blocks) = do contents <- blockListToZimWiki opts blocks @@ -143,12 +155,12 @@ blockToZimWiki opts (Table capt aligns _ headers rows) = do c <- inlineListToZimWiki opts capt return $ "" ++ c ++ "\n" headers' <- if all null headers - then zipWithM (tableItemToZimWiki opts) aligns (rows !! 0) - else zipWithM (tableItemToZimWiki opts) aligns headers + then zipWithM (tableItemToZimWiki opts) aligns (head rows) + else mapM (inlineListToZimWiki opts . removeFormatting)headers -- emphasis, links etc. are not allowed in table headers rows' <- mapM (zipWithM (tableItemToZimWiki opts) aligns) rows let widths = map (maximum . map length) $ transpose (headers':rows') let padTo (width, al) s = - case (width - length s) of + case width - length s of x | x > 0 -> if al == AlignLeft || al == AlignDefault then s ++ replicate x ' ' @@ -157,63 +169,63 @@ blockToZimWiki opts (Table capt aligns _ headers rows) = do else replicate (x `div` 2) ' ' ++ s ++ replicate (x - x `div` 2) ' ' | otherwise -> s - let borderCell (width, al) _ = - if al == AlignLeft - then ":"++ replicate (width-1) '-' - else if al == AlignDefault - then replicate width '-' - else if al == AlignRight - then replicate (width-1) '-' ++ ":" - else ":" ++ replicate (width-2) '-' ++ ":" + let borderCell (width, al) _ + | al == AlignLeft = ":"++ replicate (width-1) '-' + | al == AlignDefault = replicate width '-' + | al == AlignRight = replicate (width-1) '-' ++ ":" + | otherwise = ":" ++ replicate (width-2) '-' ++ ":" let underheader = "|" ++ intercalate "|" (zipWith borderCell (zip widths aligns) headers') ++ "|" - let renderRow sep cells = sep ++ intercalate sep (zipWith padTo (zip widths aligns) cells) ++ sep + let renderRow cells = "|" ++ intercalate "|" (zipWith padTo (zip widths aligns) cells) ++ "|" return $ captionDoc ++ - (if null headers' then "" else renderRow "|" headers' ++ "\n") ++ underheader ++ "\n" ++ - unlines (map (renderRow "|") rows') + (if null headers' then "" else renderRow headers' ++ "\n") ++ underheader ++ "\n" ++ + unlines (map renderRow rows') blockToZimWiki opts (BulletList items) = do - indent <- stIndent <$> get + indent <- gets stIndent modify $ \s -> s { stIndent = stIndent s ++ "\t" } - contents <- (mapM (listItemToZimWiki opts) items) + contents <- mapM (listItemToZimWiki opts) items modify $ \s -> s{ stIndent = indent } -- drop 1 (stIndent s) } return $ vcat contents ++ if null indent then "\n" else "" blockToZimWiki opts (OrderedList _ items) = do - indent <- stIndent <$> get + indent <- gets stIndent modify $ \s -> s { stIndent = stIndent s ++ "\t", stItemNum = 1 } - contents <- (mapM (orderedListItemToZimWiki opts) items) + contents <- mapM (orderedListItemToZimWiki opts) items modify $ \s -> s{ stIndent = indent } -- drop 1 (stIndent s) } return $ vcat contents ++ if null indent then "\n" else "" blockToZimWiki opts (DefinitionList items) = do - contents <- (mapM (definitionListItemToZimWiki opts) items) + contents <- mapM (definitionListItemToZimWiki opts) items return $ vcat contents -definitionListItemToZimWiki :: WriterOptions -> ([Inline],[[Block]]) -> State WriterState String +definitionListItemToZimWiki :: PandocMonad m + => WriterOptions + -> ([Inline],[[Block]]) + -> ZW m String definitionListItemToZimWiki opts (label, items) = do labelText <- inlineListToZimWiki opts label contents <- mapM (blockListToZimWiki opts) items - indent <- stIndent <$> get + indent <- gets stIndent return $ indent ++ "* **" ++ labelText ++ "** " ++ concat contents -- Auxiliary functions for lists: -indentFromHTML :: WriterOptions -> String -> State WriterState String +indentFromHTML :: PandocMonad m => WriterOptions -> String -> ZW m String indentFromHTML _ str = do - indent <- stIndent <$> get - itemnum <- stItemNum <$> get - if isInfixOf "<li>" str then return $ indent ++ show itemnum ++ "." - else if isInfixOf "</li>" str then return "\n" - else if isInfixOf "<li value=" str then do + indent <- gets stIndent + itemnum <- gets stItemNum + if "<li>" `isInfixOf` str then return $ indent ++ show itemnum ++ "." + else if "</li>" `isInfixOf` str then return "\n" + else if "<li value=" `isInfixOf` str then do -- poor man's cut let val = drop 10 $ reverse $ drop 1 $ reverse str --let val = take ((length valls) - 2) valls modify $ \s -> s { stItemNum = read val } return "" - else if isInfixOf "<ol>" str then do + else if "<ol>" `isInfixOf` str then do let olcount=countSubStrs "<ol>" str modify $ \s -> s { stIndent = stIndent s ++ replicate olcount '\t', stItemNum = 1 } return "" - else if isInfixOf "</ol>" str then do + else if "</ol>" `isInfixOf` str then do let olcount=countSubStrs "/<ol>" str modify $ \s -> s{ stIndent = drop olcount (stIndent s) } return "" @@ -230,23 +242,25 @@ vcat :: [String] -> String vcat = intercalate "\n" -- | Convert bullet list item (list of blocks) to ZimWiki. -listItemToZimWiki :: WriterOptions -> [Block] -> State WriterState String +listItemToZimWiki :: PandocMonad m => WriterOptions -> [Block] -> ZW m String listItemToZimWiki opts items = do contents <- blockListToZimWiki opts items - indent <- stIndent <$> get + indent <- gets stIndent return $ indent ++ "* " ++ contents -- | Convert ordered list item (list of blocks) to ZimWiki. -orderedListItemToZimWiki :: WriterOptions -> [Block] -> State WriterState String +orderedListItemToZimWiki :: PandocMonad m + => WriterOptions -> [Block] -> ZW m String orderedListItemToZimWiki opts items = do contents <- blockListToZimWiki opts items - indent <- stIndent <$> get - itemnum <- stItemNum <$> get + indent <- gets stIndent + itemnum <- gets stItemNum --modify $ \s -> s { stItemNum = itemnum + 1 } -- this is not strictly necessary for zim as zim does its own renumbering return $ indent ++ show itemnum ++ ". " ++ contents -- Auxiliary functions for tables: -tableItemToZimWiki :: WriterOptions -> Alignment -> [Block] -> State WriterState String +tableItemToZimWiki :: PandocMonad m + => WriterOptions -> Alignment -> [Block] -> ZW m String tableItemToZimWiki opts align' item = do let mkcell x = (if align' == AlignRight || align' == AlignCenter then " " @@ -254,19 +268,24 @@ tableItemToZimWiki opts align' item = do (if align' == AlignLeft || align' == AlignCenter then " " else "") - contents <- blockListToZimWiki opts item -- local (\s -> s { stBackSlashLB = True }) $ + modify $ \s -> s { stInTable = True } + contents <- blockListToZimWiki opts item + modify $ \s -> s { stInTable = False } return $ mkcell contents -- | Convert list of Pandoc block elements to ZimWiki. -blockListToZimWiki :: WriterOptions -> [Block] -> State WriterState String +blockListToZimWiki :: PandocMonad m + => WriterOptions -> [Block] -> ZW m String blockListToZimWiki opts blocks = vcat <$> mapM (blockToZimWiki opts) blocks -- | Convert list of Pandoc inline elements to ZimWiki. -inlineListToZimWiki :: WriterOptions -> [Inline] -> State WriterState String -inlineListToZimWiki opts lst = concat <$> (mapM (inlineToZimWiki opts) lst) +inlineListToZimWiki :: PandocMonad m + => WriterOptions -> [Inline] -> ZW m String +inlineListToZimWiki opts lst = concat <$> mapM (inlineToZimWiki opts) lst -- | Convert Pandoc inline element to ZimWiki. -inlineToZimWiki :: WriterOptions -> Inline -> State WriterState String +inlineToZimWiki :: PandocMonad m + => WriterOptions -> Inline -> ZW m String inlineToZimWiki opts (Emph lst) = do contents <- inlineListToZimWiki opts lst @@ -304,7 +323,15 @@ inlineToZimWiki opts (Cite _ lst) = inlineListToZimWiki opts lst inlineToZimWiki _ (Code _ str) = return $ "''" ++ str ++ "''" -inlineToZimWiki _ (Str str) = return $ escapeString str +inlineToZimWiki _ (Str str) = do + inTable <- gets stInTable + inLink <- gets stInLink + if inTable + then return $ substitute "|" "\\|" . escapeString $ str + else + if inLink + then return str + else return $ escapeString str inlineToZimWiki _ (Math mathType str) = return $ delim ++ str ++ delim -- note: str should NOT be escaped where delim = case mathType of @@ -312,12 +339,18 @@ inlineToZimWiki _ (Math mathType str) = return $ delim ++ str ++ delim -- note InlineMath -> "$" -- | f == Format "html" = return $ "<html>" ++ str ++ "</html>" -inlineToZimWiki opts (RawInline f str) +inlineToZimWiki opts il@(RawInline f str) | f == Format "zimwiki" = return str - | f == Format "html" = do cont <- indentFromHTML opts str; return cont - | otherwise = return "" + | f == Format "html" = indentFromHTML opts str + | otherwise = do + report $ InlineNotRendered il + return "" -inlineToZimWiki _ (LineBreak) = return "\n" -- was \\\\ +inlineToZimWiki _ LineBreak = do + inTable <- gets stInTable + if inTable + then return "\\n" + else return "\n" inlineToZimWiki opts SoftBreak = case writerWrapText opts of @@ -328,37 +361,45 @@ inlineToZimWiki opts SoftBreak = inlineToZimWiki _ Space = return " " inlineToZimWiki opts (Link _ txt (src, _)) = do - label <- inlineListToZimWiki opts txt + inTable <- gets stInTable + modify $ \s -> s { stInLink = True } + label <- inlineListToZimWiki opts $ removeFormatting txt -- zim does not allow formatting in link text, it takes the text verbatim, no need to escape it + modify $ \s -> s { stInLink = False } + let label'= if inTable + then "" -- no label is allowed in a table + else "|"++label case txt of [Str s] | "mailto:" `isPrefixOf` src -> return $ "<" ++ s ++ ">" | escapeURI s == src -> return src _ -> if isURI src - then return $ "[[" ++ src ++ "|" ++ label ++ "]]" - else return $ "[[" ++ src' ++ "|" ++ label ++ "]]" + 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 inlineToZimWiki opts (Image attr alt (source, tit)) = do alt' <- inlineListToZimWiki opts alt - let txt = case (tit, alt) of - ("", []) -> "" - ("", _ ) -> "|" ++ alt' - (_ , _ ) -> "|" ++ tit + inTable <- gets stInTable + let txt = case (tit, alt, inTable) of + ("",[], _) -> "" + ("", _, False ) -> "|" ++ alt' + (_ , _, False ) -> "|" ++ tit + (_ , _, True ) -> "" -- Relative links fail isURI and receive a colon prefix = if isURI source then "" else ":" return $ "{{" ++ prefix ++ source ++ imageDims opts attr ++ txt ++ "}}" inlineToZimWiki opts (Note contents) = do + -- no concept of notes in zim wiki, use a text block contents' <- blockListToZimWiki opts contents - return $ "((" ++ contents' ++ "))" - -- note - may not work for notes with multiple blocks + return $ " **{Note:** " ++ trimr contents' ++ "**}**" imageDims :: WriterOptions -> Attr -> String 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 + checkPct maybeDim = maybeDim go (Just w) Nothing = "?" ++ w go (Just w) (Just h) = "?" ++ w ++ "x" ++ h go Nothing (Just h) = "?0x" ++ h |