diff options
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r-- | src/Text/Pandoc/Readers/Docx.hs | 13 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/DokuWiki.hs | 146 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 18 |
3 files changed, 105 insertions, 72 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/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 966cabe67..acbe8a48d 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -471,12 +471,18 @@ blockToLaTeX (Header level (id',classes,_) lst) = blockToLaTeX (Table caption aligns widths heads rows) = do headers <- if all null heads then return empty - else ($$ "\\midrule\\endhead") `fmap` + else ($$ "\\midrule\n") `fmap` (tableRowToLaTeX True aligns widths) heads + let endhead = if all null heads + then empty + else text "\\endhead" captionText <- inlineListToLaTeX caption let capt = if isEmpty captionText then empty - else text "\\caption" <> braces captionText <> "\\\\" + else text "\\caption" <> braces captionText + <> "\\tabularnewline\n\\toprule\n" + <> headers + <> "\\endfirsthead" rows' <- mapM (tableRowToLaTeX False aligns widths) rows let colDescriptors = text $ concat $ map toColDescriptor aligns modify $ \s -> s{ stTable = True } @@ -484,8 +490,9 @@ blockToLaTeX (Table caption aligns widths heads rows) = do braces ("@{}" <> colDescriptors <> "@{}") -- the @{} removes extra space at beginning and end $$ capt - $$ "\\toprule\\addlinespace" + $$ "\\toprule" $$ headers + $$ endhead $$ vcat rows' $$ "\\bottomrule" $$ "\\end{longtable}" @@ -512,7 +519,7 @@ tableRowToLaTeX header aligns widths cols = do let scaleFactor = 0.97 ** fromIntegral (length aligns) let widths' = map (scaleFactor *) widths cells <- mapM (tableCellToLaTeX header) $ zip3 widths' aligns cols - return $ hsep (intersperse "&" cells) $$ "\\\\\\addlinespace" + return $ hsep (intersperse "&" cells) <> "\\tabularnewline" -- For simple latex tables (without minipages or parboxes), -- we need to go to some lengths to get line breaks working: @@ -549,7 +556,8 @@ tableCellToLaTeX header (width, align, blocks) = do AlignDefault -> "\\raggedright" return $ ("\\begin{minipage}" <> valign <> braces (text (printf "%.2f\\columnwidth" width)) <> - (halign <> cr <> cellContents <> cr) <> "\\end{minipage}") + (halign <> "\\strut" <> cr <> cellContents <> cr) <> + "\\strut\\end{minipage}") $$ case notes of [] -> empty ns -> (case length ns of |