diff options
Diffstat (limited to 'src/Text')
| -rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 40 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Markdown.hs | 38 |
2 files changed, 52 insertions, 26 deletions
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 6c30fe3c3..b3459eec0 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -1271,14 +1271,22 @@ gridTableSplitLine :: [Int] -> String -> [String] gridTableSplitLine indices line = map removeFinalBar $ tail $ splitStringByIndices (init indices) $ trimr line -gridPart :: Char -> Parser [Char] st (Int, Int) +gridPart :: Char -> Parser [Char] st ((Int, Int), Alignment) gridPart ch = do + leftColon <- option False (True <$ char ':') dashes <- many1 (char ch) + rightColon <- option False (True <$ char ':') char '+' - let lengthDashes = length dashes - return (lengthDashes, lengthDashes + 1) - -gridDashedLines :: Char -> Parser [Char] st [(Int,Int)] + let lengthDashes = length dashes + (if leftColon then 1 else 0) + + (if rightColon then 1 else 0) + let alignment = case (leftColon, rightColon) of + (True, True) -> AlignCenter + (True, False) -> AlignLeft + (False, True) -> AlignRight + (False, False) -> AlignDefault + return ((lengthDashes, lengthDashes + 1), alignment) + +gridDashedLines :: Char -> Parser [Char] st [((Int, Int), Alignment)] gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) <* blankline removeFinalBar :: String -> String @@ -1296,19 +1304,17 @@ gridTableHeader headless = try $ do optional blanklines dashes <- gridDashedLines '-' rawContent <- if headless - then return $ repeat "" - else many1 - (notFollowedBy (gridTableSep '=') >> char '|' >> - many1Till anyChar newline) - if headless - then return () - else gridTableSep '=' >> return () - let lines' = map snd dashes + then return [] + else many1 (try (char '|' >> anyLine)) + underDashes <- if headless + then return dashes + else gridDashedLines '=' + guard $ length dashes == length underDashes + let lines' = map (snd . fst) underDashes let indices = scanl (+) 0 lines' - let aligns = replicate (length lines') AlignDefault - -- RST does not have a notion of alignments + let aligns = map snd underDashes let rawHeads = if headless - then replicate (length dashes) "" + then replicate (length underDashes) "" else map (unlines . map trim) $ transpose $ map (gridTableSplitLine indices) rawContent heads <- fmap sequence $ mapM (parseFromString parseBlocks . trim) rawHeads @@ -1317,7 +1323,7 @@ gridTableHeader headless = try $ do gridTableRawLine :: [Int] -> MarkdownParser [String] gridTableRawLine indices = do char '|' - line <- many1Till anyChar newline + line <- anyLine return (gridTableSplitLine indices line) -- | Parse row of grid table. diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 6e6b6dcae..f46699d74 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -632,12 +632,13 @@ pandocTable opts headless aligns widths rawHeaders rawRows = do gridTable :: WriterOptions -> Bool -> [Alignment] -> [Double] -> [Doc] -> [[Doc]] -> MD Doc -gridTable opts headless _aligns widths headers' rawRows = do +gridTable opts headless aligns widths headers' rawRows = do let numcols = length headers' let widths' = if all (==0) widths then replicate numcols (1.0 / fromIntegral numcols) else widths - let widthsInChars = map (floor . (fromIntegral (writerColumns opts) *)) widths' + let widthsInChars = map + ((\x -> x - 1) . floor . (fromIntegral (writerColumns opts) *)) widths' let hpipeBlocks blocks = hcat [beg, middle, end] where h = maximum (1 : map height blocks) sep' = lblock 3 $ vcat (map text $ replicate h " | ") @@ -647,15 +648,34 @@ gridTable opts headless _aligns widths headers' rawRows = do let makeRow = hpipeBlocks . zipWith lblock widthsInChars let head' = makeRow headers' let rows' = map (makeRow . map chomp) 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 borderpart ch align widthInChars = + let widthInChars' = if widthInChars < 1 then 1 else widthInChars + in (if (align == AlignLeft || align == AlignCenter) + then char ':' + else char ch) <> + text (replicate widthInChars' ch) <> + (if (align == AlignRight || align == AlignCenter) + then char ':' + else char ch) + let border ch aligns' widthsInChars' = + char '+' <> + hcat (intersperse (char '+') (zipWith (borderpart ch) + aligns' widthsInChars')) <> char '+' + let body = vcat $ intersperse (border '-' (repeat AlignDefault) widthsInChars) + rows' let head'' = if headless then empty - else head' $$ border '=' - return $ border '-' $$ head'' $$ body $$ border '-' + else head' $$ border '=' aligns widthsInChars + if headless + then return $ + border '-' aligns widthsInChars $$ + body $$ + border '-' (repeat AlignDefault) widthsInChars + else return $ + border '-' (repeat AlignDefault) widthsInChars $$ + head'' $$ + body $$ + border '-' (repeat AlignDefault) widthsInChars itemEndsWithTightList :: [Block] -> Bool itemEndsWithTightList bs = |