aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Writers/RST.hs43
-rw-r--r--src/Text/Pandoc/Writers/Shared.hs46
2 files changed, 40 insertions, 49 deletions
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index d4a537d72..24898d62e 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -33,7 +33,7 @@ reStructuredText: <http://docutils.sourceforge.net/rst.html>
module Text.Pandoc.Writers.RST ( writeRST ) where
import Control.Monad.State
import Data.Char (isSpace, toLower)
-import Data.List (intersperse, isPrefixOf, stripPrefix, transpose)
+import Data.List (isPrefixOf, stripPrefix)
import Data.Maybe (fromMaybe)
import Network.URI (isURI)
import qualified Text.Pandoc.Builder as B
@@ -269,39 +269,18 @@ blockToRST (BlockQuote blocks) = do
tabstop <- gets $ writerTabStop . stOptions
contents <- blockListToRST blocks
return $ (nest tabstop contents) <> blankline
-blockToRST (Table caption _ widths headers rows) = do
+blockToRST (Table caption aligns widths headers rows) = do
caption' <- inlineListToRST caption
- headers' <- mapM blockListToRST headers
- rawRows <- mapM (mapM blockListToRST) rows
- -- let isSimpleCell [Plain _] = True
- -- isSimpleCell [Para _] = True
- -- isSimpleCell [] = True
- -- isSimpleCell _ = False
- -- let isSimple = all (==0) widths && all (all isSimpleCell) rows
- let numChars = maximum . map offset
+ let blocksToDoc opts bs = do
+ oldOpts <- gets stOptions
+ modify $ \st -> st{ stOptions = opts }
+ result <- blockListToRST bs
+ modify $ \st -> st{ stOptions = oldOpts }
+ return result
opts <- gets stOptions
- let widthsInChars =
- if all (== 0) widths
- then map ((+2) . numChars) $ transpose (headers' : rawRows)
- else map (floor . (fromIntegral (writerColumns opts) *)) widths
- let hpipeBlocks blocks = hcat [beg, middle, end]
- where h = height (hcat blocks)
- sep' = lblock 3 $ vcat (map text $ replicate h " | ")
- beg = lblock 2 $ vcat (map text $ replicate h "| ")
- end = lblock 2 $ vcat (map text $ replicate h " |")
- middle = hcat $ intersperse sep' blocks
- let makeRow = hpipeBlocks . zipWith lblock widthsInChars
- let head' = makeRow headers'
- let rows' = map makeRow rawRows
- let border ch = char '+' <> char ch <>
- (hcat $ intersperse (char ch <> char '+' <> char ch) $
- map (\l -> text $ replicate l ch) widthsInChars) <>
- char ch <> char '+'
- let body = vcat $ intersperse (border '-') rows'
- let head'' = if all null headers
- then empty
- else head' $$ border '='
- let tbl = border '-' $$ head'' $$ body $$ border '-'
+ tbl <- gridTable opts blocksToDoc (all null headers)
+ (map (const AlignDefault) aligns) widths
+ headers rows
return $ if null caption
then tbl $$ blankline
else (".. table:: " <> caption') $$ blankline $$ nest 3 tbl $$
diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs
index 520df1037..3b28c58c8 100644
--- a/src/Text/Pandoc/Writers/Shared.hs
+++ b/src/Text/Pandoc/Writers/Shared.hs
@@ -46,7 +46,7 @@ import Control.Monad (liftM, zipWithM)
import Data.Aeson (FromJSON (..), Result (..), ToJSON (..), Value (Object),
encode, fromJSON)
import qualified Data.HashMap.Strict as H
-import Data.List (groupBy, intersperse)
+import Data.List (groupBy, intersperse, transpose)
import qualified Data.Map as M
import Data.Maybe (isJust)
import qualified Data.Text as T
@@ -229,22 +229,34 @@ gridTable :: Monad m
gridTable opts blocksToDoc headless aligns widths headers rows = do
let numcols = maximum (length aligns : length widths :
map length (headers:rows))
- let widths' = if all (==0) widths
- then replicate numcols
- (1.0 / fromIntegral numcols)
- else widths
- let widthsInChars = map ((\x -> x - 3) . floor .
- (fromIntegral (writerColumns opts) *)) widths'
- rawHeaders <- zipWithM blocksToDoc
- (map (\w -> opts{writerColumns =
- min (w - 2) (writerColumns opts)}) widthsInChars)
- headers
- rawRows <- mapM
- (\cs -> zipWithM blocksToDoc
- (map (\w -> opts{writerColumns =
- min (w - 2) (writerColumns opts)}) widthsInChars)
- cs)
- rows
+ let handleGivenWidths widths' = do
+ let widthsInChars' = map ((\x -> x - 3) . floor .
+ (fromIntegral (writerColumns opts) *)) widths'
+ rawHeaders' <- zipWithM blocksToDoc
+ (map (\w -> opts{writerColumns =
+ min (w - 2) (writerColumns opts)}) widthsInChars')
+ headers
+ rawRows' <- mapM
+ (\cs -> zipWithM blocksToDoc
+ (map (\w -> opts{writerColumns =
+ min (w - 2) (writerColumns opts)}) widthsInChars')
+ cs)
+ rows
+ return (widthsInChars', rawHeaders', rawRows')
+ let handleZeroWidths = do
+ rawHeaders' <- mapM (blocksToDoc opts) headers
+ rawRows' <- mapM (mapM (blocksToDoc opts)) rows
+ let numChars = maximum . map offset
+ let widthsInChars' =
+ map ((+2) . numChars) $ transpose (rawHeaders' : rawRows')
+ if sum widthsInChars' > writerColumns opts
+ then -- use even widths
+ handleGivenWidths
+ (replicate numcols (1.0 / fromIntegral numcols) :: [Double])
+ else return (widthsInChars', rawHeaders', rawRows')
+ (widthsInChars, rawHeaders, rawRows) <- if all (== 0) widths
+ then handleZeroWidths
+ else handleGivenWidths widths
let hpipeBlocks blocks = hcat [beg, middle, end]
where h = maximum (1 : map height blocks)
sep' = lblock 3 $ vcat (map text $ replicate h " | ")