aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Writers
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Writers')
-rw-r--r--src/Text/Pandoc/Writers/ZimWiki.hs361
1 files changed, 361 insertions, 0 deletions
diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs
new file mode 100644
index 000000000..38a03cd83
--- /dev/null
+++ b/src/Text/Pandoc/Writers/ZimWiki.hs
@@ -0,0 +1,361 @@
+{-
+Copyright (C) 2008-2015 John MacFarlane <jgm@berkeley.edu>
+
+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.ZimWiki
+ Copyright : Copyright (C) 2008-2015 John MacFarlane, 2016 Alex Ivkin
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Alex Ivkin <alex@ivkin.net>
+ Stability : alpha
+ Portability : portable
+
+Conversion of 'Pandoc' documents to ZimWiki markup.
+
+http://zim-wiki.org/manual/Help/Wiki_Syntax.html
+-}
+
+module Text.Pandoc.Writers.ZimWiki ( writeZimWiki ) where
+import Text.Pandoc.Definition
+import Text.Pandoc.Options ( WriterOptions(writerTableOfContents, writerStandalone, writerTemplate, writerWrapText), WrapOption(..) )
+import Text.Pandoc.Shared ( escapeURI, 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 )
+
+data WriterState = WriterState {
+ stItemNum :: Int,
+ stIndent :: String -- Indent after the marker at the beginning of list items
+ }
+
+instance Default WriterState where
+ def = WriterState { stItemNum = 1, stIndent = "" }
+
+-- | Convert Pandoc to ZimWiki.
+writeZimWiki :: WriterOptions -> Pandoc -> String
+writeZimWiki opts document = evalState (pandocToZimWiki opts document) (WriterState 1 "")
+
+-- | Return ZimWiki representation of document.
+pandocToZimWiki :: WriterOptions -> Pandoc -> State WriterState String
+pandocToZimWiki opts (Pandoc meta blocks) = do
+ metadata <- metaToJSON opts
+ (fmap trimr . blockListToZimWiki opts)
+ (inlineListToZimWiki opts)
+ meta
+ body <- 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
+ if writerStandalone opts
+ then return $ renderTemplate' (writerTemplate opts) context
+ else return main
+
+-- | Escape special characters for ZimWiki.
+escapeString :: String -> String
+escapeString = substitute "__" "''__''" .
+ substitute "**" "''**''" .
+ substitute "~~" "''~~''" .
+ substitute "//" "''//''"
+
+-- | Convert Pandoc block element to ZimWiki.
+blockToZimWiki :: WriterOptions -> Block -> State WriterState String
+
+blockToZimWiki _ Null = return ""
+
+blockToZimWiki opts (Div _attrs bs) = do
+ contents <- blockListToZimWiki opts bs
+ return $ contents ++ "\n"
+
+blockToZimWiki opts (Plain inlines) = inlineListToZimWiki opts inlines
+
+-- title beginning with fig: indicates that the image is a figure
+-- ZimWiki doesn't support captions - so combine together alt and caption into alt
+blockToZimWiki opts (Para [Image attr txt (src,'f':'i':'g':':':tit)]) = do
+ capt <- if null txt
+ then return ""
+ else (" " ++) `fmap` inlineListToZimWiki opts txt
+ let opt = if null txt
+ then ""
+ else "|" ++ if null tit then capt else tit ++ capt
+ -- Relative links fail isURI and receive a colon
+ prefix = if isURI src then "" else ":"
+ return $ "{{" ++ prefix ++ src ++ imageDims opts attr ++ opt ++ "}}\n"
+
+blockToZimWiki opts (Para inlines) = do
+ indent <- stIndent <$> get
+ -- useTags <- stUseTags <$> get
+ contents <- inlineListToZimWiki opts inlines
+ return $ contents ++ if null indent then "\n" else ""
+
+blockToZimWiki opts (RawBlock f str)
+ | f == Format "zimwiki" = return str
+ | f == Format "html" = do cont <- indentFromHTML opts str; return cont
+ | otherwise = return "" -- $ "** unknown raw block "++ show f ++ "=" ++ str ++ " **"
+
+blockToZimWiki _ HorizontalRule = return "\n----\n"
+
+blockToZimWiki opts (Header level _ inlines) = do
+ contents <- inlineListToZimWiki opts $ removeFormatting inlines -- emphasis, links etc. not allowed in headers
+ let eqs = replicate ( 7 - level ) '='
+ return $ eqs ++ " " ++ contents ++ " " ++ eqs ++ "\n"
+
+blockToZimWiki _ (CodeBlock (_,classes,_) str) = do
+ 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
+
+blockToZimWiki opts (BlockQuote blocks) = do
+ contents <- blockListToZimWiki opts blocks
+ return $ unlines $ map ("> " ++) $ lines contents
+
+blockToZimWiki opts (Table capt aligns _ headers rows) = do
+ captionDoc <- if null capt
+ then return ""
+ else 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
+ 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
+ x | x > 0 ->
+ if al == AlignLeft || al == AlignDefault
+ then s ++ replicate x ' '
+ else if al == AlignRight
+ then replicate x ' ' ++ s
+ 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 underheader = "|" ++ intercalate "|" (zipWith borderCell (zip widths aligns) headers') ++ "|"
+ let renderRow sep cells = sep ++ intercalate sep (zipWith padTo (zip widths aligns) cells) ++ sep
+ return $ captionDoc ++
+ (if null headers' then "" else renderRow "|" headers' ++ "\n") ++ underheader ++ "\n" ++
+ unlines (map (renderRow "|") rows')
+
+blockToZimWiki opts (BulletList items) = do
+ indent <- stIndent <$> get
+ modify $ \s -> s { stIndent = stIndent s ++ "\t" }
+ 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
+ modify $ \s -> s { stIndent = stIndent s ++ "\t", stItemNum = 1 }
+ 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)
+ return $ vcat contents
+
+definitionListItemToZimWiki :: WriterOptions -> ([Inline],[[Block]]) -> State WriterState String
+definitionListItemToZimWiki opts (label, items) = do
+ labelText <- inlineListToZimWiki opts label
+ contents <- mapM (blockListToZimWiki opts) items
+ indent <- stIndent <$> get
+ return $ indent ++ "* **" ++ labelText ++ "** " ++ concat contents
+
+-- Auxiliary functions for lists:
+indentFromHTML :: WriterOptions -> String -> State WriterState 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
+ -- 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 "" -- $ indent ++ val ++ "." -- zim does its own numbering
+ else if isInfixOf "<ol>" str then do
+ let olcount=countSubStrs "<ol>" str
+ modify $ \s -> s { stIndent = stIndent s ++ replicate olcount '\t', stItemNum = 1 }
+ return "" -- $ "OL-ON[" ++ newfix ++"]"
+ else if isInfixOf "</ol>" str then do
+ let olcount=countSubStrs "/<ol>" str
+ modify $ \s -> s{ stIndent = drop olcount (stIndent s) }
+ return "" -- $ "OL-OFF[" ++ newfix ++"]"
+ else
+ return $ "" -- ** unknown inner HTML "++ str ++"**"
+
+countSubStrs :: String -> String -> Int
+countSubStrs sub str = length $ breakOnAll (pack sub) (pack str)
+
+cleanupCode :: String -> String
+cleanupCode = substitute "<nowiki>" "" . substitute "</nowiki>" ""
+
+vcat :: [String] -> String
+vcat = intercalate "\n"
+
+-- | Convert bullet list item (list of blocks) to ZimWiki.
+listItemToZimWiki :: WriterOptions -> [Block] -> State WriterState String
+listItemToZimWiki opts items = do
+ contents <- blockListToZimWiki opts items
+ indent <- stIndent <$> get
+ return $ indent ++ "* " ++ contents
+
+-- | Convert ordered list item (list of blocks) to ZimWiki.
+orderedListItemToZimWiki :: WriterOptions -> [Block] -> State WriterState String
+orderedListItemToZimWiki opts items = do
+ contents <- blockListToZimWiki opts items
+ indent <- stIndent <$> get
+ itemnum <- stItemNum <$> get
+ --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 opts align' item = do
+ let mkcell x = (if align' == AlignRight || align' == AlignCenter
+ then " "
+ else "") ++ x ++
+ (if align' == AlignLeft || align' == AlignCenter
+ then " "
+ else "")
+ contents <- blockListToZimWiki opts item -- local (\s -> s { stBackSlashLB = True }) $
+ return $ mkcell contents
+
+-- | Convert list of Pandoc block elements to ZimWiki.
+blockListToZimWiki :: WriterOptions -> [Block] -> State WriterState 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)
+
+-- | Convert Pandoc inline element to ZimWiki.
+inlineToZimWiki :: WriterOptions -> Inline -> State WriterState String
+
+inlineToZimWiki opts (Emph lst) = do
+ contents <- inlineListToZimWiki opts lst
+ return $ "//" ++ contents ++ "//"
+
+inlineToZimWiki opts (Strong lst) = do
+ contents <- inlineListToZimWiki opts lst
+ return $ "**" ++ contents ++ "**"
+
+inlineToZimWiki opts (Strikeout lst) = do
+ contents <- inlineListToZimWiki opts lst
+ return $ "~~" ++ contents ++ "~~"
+
+inlineToZimWiki opts (Superscript lst) = do
+ contents <- inlineListToZimWiki opts lst
+ return $ "^{" ++ contents ++ "}"
+
+inlineToZimWiki opts (Subscript lst) = do
+ contents <- inlineListToZimWiki opts lst
+ return $ "_{" ++ contents ++ "}"
+
+inlineToZimWiki opts (Quoted SingleQuote lst) = do
+ contents <- inlineListToZimWiki opts lst
+ return $ "\8216" ++ contents ++ "\8217"
+
+inlineToZimWiki opts (Quoted DoubleQuote lst) = do
+ contents <- inlineListToZimWiki opts lst
+ return $ "\8220" ++ contents ++ "\8221"
+
+inlineToZimWiki opts (Span _attrs ils) = inlineListToZimWiki opts ils
+
+inlineToZimWiki opts (SmallCaps lst) = inlineListToZimWiki opts lst
+
+inlineToZimWiki opts (Cite _ lst) = inlineListToZimWiki opts lst
+
+inlineToZimWiki _ (Code _ str) = return $ "''" ++ str ++ "''"
+
+inlineToZimWiki _ (Str str) = return $ escapeString str
+
+inlineToZimWiki _ (Math mathType str) = return $ delim ++ str ++ delim -- note: str should NOT be escaped
+ where delim = case mathType of
+ DisplayMath -> "$$"
+ InlineMath -> "$"
+
+-- | f == Format "html" = return $ "<html>" ++ str ++ "</html>"
+inlineToZimWiki opts (RawInline f str)
+ | f == Format "zimwiki" = return str
+ | f == Format "html" = do cont <- indentFromHTML opts str; return cont
+ | otherwise = return ""
+
+inlineToZimWiki _ (LineBreak) = return "\n" -- was \\\\
+
+inlineToZimWiki opts SoftBreak =
+ case writerWrapText opts of
+ WrapNone -> return " "
+ WrapAuto -> return " "
+ WrapPreserve -> return "\n"
+
+inlineToZimWiki _ Space = return " "
+
+inlineToZimWiki opts (Link _ txt (src, _)) = do
+ label <- inlineListToZimWiki opts txt
+ 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 ++ "]]"
+ 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
+ -- 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
+ contents' <- blockListToZimWiki opts contents
+ return $ "((" ++ contents' ++ "))"
+ -- note - may not work for notes with multiple blocks
+
+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
+ go (Just w) Nothing = "?" ++ w
+ go (Just w) (Just h) = "?" ++ w ++ "x" ++ h
+ go Nothing (Just h) = "?0x" ++ h
+ go Nothing Nothing = ""
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-21 02:41:43 +0000