Added Zim Wiki writer, template and tests.

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  = ""