aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Text/Pandoc/Readers/Docx.hs13
-rw-r--r--src/Text/Pandoc/Writers/DokuWiki.hs146
-rw-r--r--tests/docx/tables.docxbin42792 -> 49780 bytes
-rw-r--r--tests/docx/tables.native50
4 files changed, 122 insertions, 87 deletions
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs
index 188fa4a42..8ebe59569 100644
--- a/src/Text/Pandoc/Readers/Docx.hs
+++ b/src/Text/Pandoc/Readers/Docx.hs
@@ -95,6 +95,7 @@ import Control.Monad.Reader
import Control.Monad.State
import Control.Applicative ((<$>))
import Data.Sequence (ViewL(..), viewl)
+import qualified Data.Sequence as Seq (null)
readDocx :: ReaderOptions
-> B.ByteString
@@ -391,11 +392,21 @@ makeHeaderAnchor' (Header n (_, classes, kvs) ils) =
return $ Header n (newIdent, classes, kvs) ils
makeHeaderAnchor' blk = return blk
+-- Rewrite a standalone paragraph block as a plain
+singleParaToPlain :: Blocks -> Blocks
+singleParaToPlain blks
+ | (Para (ils) :< seeq) <- viewl $ unMany blks
+ , Seq.null seeq =
+ singleton $ Plain ils
+singleParaToPlain blks = blks
+
cellToBlocks :: Cell -> DocxContext Blocks
cellToBlocks (Cell bps) = concatReduce <$> mapM bodyPartToBlocks bps
rowToBlocksList :: Row -> DocxContext [Blocks]
-rowToBlocksList (Row cells) = mapM cellToBlocks cells
+rowToBlocksList (Row cells) = do
+ blksList <- mapM cellToBlocks cells
+ return $ map singleParaToPlain blksList
trimLineBreaks :: [Inline] -> [Inline]
trimLineBreaks [] = []
diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs
index 26f9b5f62..bbfba83fd 100644
--- a/src/Text/Pandoc/Writers/DokuWiki.hs
+++ b/src/Text/Pandoc/Writers/DokuWiki.hs
@@ -40,35 +40,56 @@ DokuWiki: <https://www.dokuwiki.org/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.Options ( WriterOptions(
+ writerTableOfContents
+ , writerStandalone
+ , writerTemplate) )
+import Text.Pandoc.Shared ( escapeURI, removeFormatting, camelCaseToHyphenated
+ , trimr, normalize, substitute )
+import Text.Pandoc.Writers.Shared ( defField, metaToJSON )
+import Text.Pandoc.Templates ( renderTemplate' )
import Data.List ( intersect, intercalate, isPrefixOf )
+import Data.Default (Default(..))
import Network.URI ( isURI )
-import Control.Monad.State
+import Control.Monad ( zipWithM )
+import Control.Monad.State ( modify, State, get, evalState )
+import Control.Monad.Reader ( ReaderT, runReaderT, ask, local )
+import Control.Applicative ( (<$>) )
data WriterState = WriterState {
stNotes :: Bool -- True if there are notes
- , stIndent :: String -- Indent after the marker at the beginning of list items
+ }
+
+data WriterEnvironment = WriterEnvironment {
+ stIndent :: String -- Indent after the marker at the beginning of list items
, stUseTags :: Bool -- True if we should use HTML tags because we're in a complex list
}
+instance Default WriterState where
+ def = WriterState { stNotes = False }
+
+instance Default WriterEnvironment where
+ def = WriterEnvironment { stIndent = "", stUseTags = False }
+
+type DokuWiki = ReaderT WriterEnvironment (State WriterState)
+
-- | Convert Pandoc to DokuWiki.
writeDokuWiki :: WriterOptions -> Pandoc -> String
writeDokuWiki opts document =
- evalState (pandocToDokuWiki opts $ normalize document)
- (WriterState { stNotes = False, stIndent = "", stUseTags = False })
+ runDokuWiki (pandocToDokuWiki opts $ normalize document)
+
+runDokuWiki :: DokuWiki a -> a
+runDokuWiki = flip evalState def . flip runReaderT def
-- | Return DokuWiki representation of document.
-pandocToDokuWiki :: WriterOptions -> Pandoc -> State WriterState String
+pandocToDokuWiki :: WriterOptions -> Pandoc -> DokuWiki 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
+ notesExist <- stNotes <$> get
let notes = if notesExist
then "" -- TODO Was "\n<references />" Check whether I can really remove this:
-- if it is definitely to do with footnotes, can remove this whole bit
@@ -90,7 +111,7 @@ escapeString = substitute "__" "%%__%%" .
-- | Convert Pandoc block element to DokuWiki.
blockToDokuWiki :: WriterOptions -- ^ Options
-> Block -- ^ Block element
- -> State WriterState String
+ -> DokuWiki String
blockToDokuWiki _ Null = return ""
@@ -113,8 +134,8 @@ blockToDokuWiki opts (Para [Image txt (src,'f':'i':'g':':':tit)]) = do
return $ "{{:" ++ src ++ opt ++ "}}\n"
blockToDokuWiki opts (Para inlines) = do
- indent <- gets stIndent
- useTags <- gets stUseTags
+ indent <- stIndent <$> ask
+ useTags <- stUseTags <$> ask
contents <- inlineListToDokuWiki opts inlines
return $ if useTags
then "<HTML><p></HTML>" ++ contents ++ "<HTML></p></HTML>"
@@ -174,54 +195,48 @@ blockToDokuWiki opts (Table capt aligns _ headers rows') = do
unlines body'
blockToDokuWiki opts x@(BulletList items) = do
- oldUseTags <- get >>= return . stUseTags
- indent <- get >>= return . stIndent
+ oldUseTags <- stUseTags <$> ask
+ indent <- stIndent <$> ask
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 }
+ contents <- local (\s -> s { stUseTags = True })
+ (mapM (listItemToDokuWiki opts) items)
return $ "<HTML><ul></HTML>\n" ++ vcat contents ++ "<HTML></ul></HTML>\n"
else do
- modify $ \s -> s { stIndent = stIndent s ++ " " }
- contents <- mapM (listItemToDokuWiki opts) items
- modify $ \s -> s { stIndent = indent }
+ contents <- local (\s -> s { stIndent = stIndent s ++ " " })
+ (mapM (listItemToDokuWiki opts) items)
return $ vcat contents ++ if null indent then "\n" else ""
blockToDokuWiki opts x@(OrderedList attribs items) = do
- oldUseTags <- get >>= return . stUseTags
- indent <- get >>= return . stIndent
+ oldUseTags <- stUseTags <$> ask
+ indent <- stIndent <$> ask
let useTags = oldUseTags || not (isSimpleList x)
if useTags
then do
- modify $ \s -> s { stUseTags = True }
- contents <- mapM (orderedListItemToDokuWiki opts) items
- modify $ \s -> s { stUseTags = oldUseTags }
+ contents <- local (\s -> s { stUseTags = True })
+ (mapM (orderedListItemToDokuWiki opts) items)
return $ "<HTML><ol" ++ listAttribsToString attribs ++ "></HTML>\n" ++ vcat contents ++ "<HTML></ol></HTML>\n"
else do
- modify $ \s -> s { stIndent = stIndent s ++ " " }
- contents <- mapM (orderedListItemToDokuWiki opts) items
- modify $ \s -> s { stIndent = indent }
+ contents <- local (\s -> s { stIndent = stIndent s ++ " " })
+ (mapM (orderedListItemToDokuWiki opts) items)
return $ vcat contents ++ if null indent then "\n" else ""
-- 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 x@(DefinitionList items) = do
- oldUseTags <- get >>= return . stUseTags
- indent <- get >>= return . stIndent
+ oldUseTags <- stUseTags <$> ask
+ indent <- stIndent <$> ask
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 }
+ contents <- local (\s -> s { stUseTags = True })
+ (mapM (definitionListItemToDokuWiki opts) items)
return $ "<HTML><dl></HTML>\n" ++ vcat contents ++ "<HTML></dl></HTML>\n"
else do
- modify $ \s -> s { stIndent = stIndent s ++ " " }
- contents <- mapM (definitionListItemToDokuWiki opts) items
- modify $ \s -> s { stIndent = indent }
+ contents <- local (\s -> s { stIndent = stIndent s ++ " " })
+ (mapM (definitionListItemToDokuWiki opts) items)
return $ vcat contents ++ if null indent then "\n" else ""
-- Auxiliary functions for lists:
@@ -238,41 +253,41 @@ listAttribsToString (startnum, numstyle, _) =
else "")
-- | Convert bullet list item (list of blocks) to DokuWiki.
-listItemToDokuWiki :: WriterOptions -> [Block] -> State WriterState String
+listItemToDokuWiki :: WriterOptions -> [Block] -> DokuWiki String
listItemToDokuWiki opts items = do
contents <- blockListToDokuWiki opts items
- useTags <- get >>= return . stUseTags
+ useTags <- stUseTags <$> ask
if useTags
then return $ "<HTML><li></HTML>" ++ contents ++ "<HTML></li></HTML>"
else do
- indent <- get >>= return . stIndent
+ indent <- stIndent <$> ask
return $ indent ++ "* " ++ contents
-- | Convert ordered list item (list of blocks) to DokuWiki.
-- | TODO Emiminate dreadful duplication of text from listItemToDokuWiki
-orderedListItemToDokuWiki :: WriterOptions -> [Block] -> State WriterState String
+orderedListItemToDokuWiki :: WriterOptions -> [Block] -> DokuWiki String
orderedListItemToDokuWiki opts items = do
contents <- blockListToDokuWiki opts items
- useTags <- get >>= return . stUseTags
+ useTags <- stUseTags <$> ask
if useTags
then return $ "<HTML><li></HTML>" ++ contents ++ "<HTML></li></HTML>"
else do
- indent <- get >>= return . stIndent
+ indent <- stIndent <$> ask
return $ indent ++ "- " ++ contents
-- | Convert definition list item (label, list of blocks) to DokuWiki.
definitionListItemToDokuWiki :: WriterOptions
-> ([Inline],[[Block]])
- -> State WriterState String
+ -> DokuWiki String
definitionListItemToDokuWiki opts (label, items) = do
labelText <- inlineListToDokuWiki opts label
contents <- mapM (blockListToDokuWiki opts) items
- useTags <- get >>= return . stUseTags
+ useTags <- stUseTags <$> ask
if useTags
then return $ "<HTML><dt></HTML>" ++ labelText ++ "<HTML></dt></HTML>\n" ++
(intercalate "\n" $ map (\d -> "<HTML><dd></HTML>" ++ d ++ "<HTML></dd></HTML>") contents)
else do
- indent <- get >>= return . stIndent
+ indent <- stIndent <$> ask
return $ indent ++ "* **" ++ labelText ++ "** " ++ concat contents
-- | True if the list can be handled by simple wiki markup, False if HTML tags will be needed.
@@ -326,11 +341,11 @@ tableHeaderToDokuWiki :: WriterOptions
-> [String]
-> Int
-> [[Block]]
- -> State WriterState String
+ -> DokuWiki String
tableHeaderToDokuWiki opts alignStrings rownum cols' = do
let celltype = if rownum == 0 then "" else ""
- cols'' <- sequence $ zipWith
- (\alignment item -> tableItemToDokuWiki opts celltype alignment item)
+ cols'' <- zipWithM
+ (tableItemToDokuWiki opts celltype)
alignStrings cols'
return $ "^ " ++ "" ++ joinHeaders cols'' ++ " ^"
@@ -338,11 +353,11 @@ tableRowToDokuWiki :: WriterOptions
-> [String]
-> Int
-> [[Block]]
- -> State WriterState String
+ -> DokuWiki String
tableRowToDokuWiki opts alignStrings rownum cols' = do
let celltype = if rownum == 0 then "" else ""
- cols'' <- sequence $ zipWith
- (\alignment item -> tableItemToDokuWiki opts celltype alignment item)
+ cols'' <- zipWithM
+ (tableItemToDokuWiki opts celltype)
alignStrings cols'
return $ "| " ++ "" ++ joinColumns cols'' ++ " |"
@@ -357,7 +372,7 @@ tableItemToDokuWiki :: WriterOptions
-> String
-> String
-> [Block]
- -> State WriterState String
+ -> DokuWiki String
-- TODO Fix celltype and align' defined but not used
tableItemToDokuWiki opts _celltype _align' item = do
let mkcell x = "" ++ x ++ ""
@@ -375,20 +390,20 @@ joinHeaders = intercalate " ^ "
-- | Convert list of Pandoc block elements to DokuWiki.
blockListToDokuWiki :: WriterOptions -- ^ Options
-> [Block] -- ^ List of block elements
- -> State WriterState String
+ -> DokuWiki String
blockListToDokuWiki opts blocks =
- mapM (blockToDokuWiki opts) blocks >>= return . vcat
+ vcat <$> mapM (blockToDokuWiki opts) blocks
-- | Convert list of Pandoc inline elements to DokuWiki.
-inlineListToDokuWiki :: WriterOptions -> [Inline] -> State WriterState String
-inlineListToDokuWiki opts lst = mapM (inlineToDokuWiki opts) lst >>= return . concat
+inlineListToDokuWiki :: WriterOptions -> [Inline] -> DokuWiki String
+inlineListToDokuWiki opts lst =
+ concat <$> (mapM (inlineToDokuWiki opts) lst)
-- | Convert Pandoc inline element to DokuWiki.
-inlineToDokuWiki :: WriterOptions -> Inline -> State WriterState String
+inlineToDokuWiki :: WriterOptions -> Inline -> DokuWiki String
-inlineToDokuWiki opts (Span _attrs ils) = do
- contents <- inlineListToDokuWiki opts ils
- return contents
+inlineToDokuWiki opts (Span _attrs ils) =
+ inlineListToDokuWiki opts ils
inlineToDokuWiki opts (Emph lst) = do
contents <- inlineListToDokuWiki opts lst
@@ -461,11 +476,10 @@ inlineToDokuWiki opts (Link txt (src, _)) = do
_ -> 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
+ let txt = case (tit, alt) of
+ ("", []) -> ""
+ ("", _ ) -> "|" ++ alt'
+ (_ , _ ) -> "|" ++ tit
return $ "{{:" ++ source ++ txt ++ "}}"
inlineToDokuWiki opts (Note contents) = do
diff --git a/tests/docx/tables.docx b/tests/docx/tables.docx
index 7dcff8d35..28087ead5 100644
--- a/tests/docx/tables.docx
+++ b/tests/docx/tables.docx
Binary files differ
diff --git a/tests/docx/tables.native b/tests/docx/tables.native
index 2564afcec..cf23cf404 100644
--- a/tests/docx/tables.native
+++ b/tests/docx/tables.native
@@ -1,24 +1,34 @@
[Header 2 ("a-table-with-and-without-a-header-row",[],[]) [Str "A",Space,Str "table,",Space,Str "with",Space,Str "and",Space,Str "without",Space,Str "a",Space,Str "header",Space,Str "row"]
,Table [] [AlignDefault,AlignDefault,AlignDefault,AlignDefault] [0.0,0.0,0.0,0.0]
- [[Para [Str "Name"]]
- ,[Para [Str "Game"]]
- ,[Para [Str "Fame"]]
- ,[Para [Str "Blame"]]]
- [[[Para [Str "Lebron",Space,Str "James"]]
- ,[Para [Str "Basketball"]]
- ,[Para [Str "Very",Space,Str "High"]]
- ,[Para [Str "Leaving",Space,Str "Cleveland"]]]
- ,[[Para [Str "Ryan",Space,Str "Braun"]]
- ,[Para [Str "Baseball"]]
- ,[Para [Str "Moderate"]]
- ,[Para [Str "Steroids"]]]
- ,[[Para [Str "Russell",Space,Str "Wilson"]]
- ,[Para [Str "Football"]]
- ,[Para [Str "High"]]
- ,[Para [Str "Tacky",Space,Str "uniform"]]]]
+ [[Plain [Str "Name"]]
+ ,[Plain [Str "Game"]]
+ ,[Plain [Str "Fame"]]
+ ,[Plain [Str "Blame"]]]
+ [[[Plain [Str "Lebron",Space,Str "James"]]
+ ,[Plain [Str "Basketball"]]
+ ,[Plain [Str "Very",Space,Str "High"]]
+ ,[Plain [Str "Leaving",Space,Str "Cleveland"]]]
+ ,[[Plain [Str "Ryan",Space,Str "Braun"]]
+ ,[Plain [Str "Baseball"]]
+ ,[Plain [Str "Moderate"]]
+ ,[Plain [Str "Steroids"]]]
+ ,[[Plain [Str "Russell",Space,Str "Wilson"]]
+ ,[Plain [Str "Football"]]
+ ,[Plain [Str "High"]]
+ ,[Plain [Str "Tacky",Space,Str "uniform"]]]]
,Table [] [AlignDefault,AlignDefault] [0.0,0.0]
[]
- [[[Para [Str "Sinple"]]
- ,[Para [Str "Table"]]]
- ,[[Para [Str "Without"]]
- ,[Para [Str "Header"]]]]]
+ [[[Plain [Str "Sinple"]]
+ ,[Plain [Str "Table"]]]
+ ,[[Plain [Str "Without"]]
+ ,[Plain [Str "Header"]]]]
+,Table [] [AlignDefault,AlignDefault] [0.0,0.0]
+ []
+ [[[Para [Str "Simple"]
+ ,Para [Str "Multiparagraph"]]
+ ,[Para [Str "Table"]
+ ,Para [Str "Full"]]]
+ ,[[Para [Str "Of"]
+ ,Para [Str "Paragraphs"]]
+ ,[Para [Str "In",Space,Str "each"]
+ ,Para [Str "Cell."]]]]]
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-07 04:17:43 +0000