summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2017-03-21 10:02:30 +0100
committerJohn MacFarlane <jgm@berkeley.edu>2017-03-21 10:02:30 +0100
commite7336b1feb4c5282b15b0e369539a34984362b40 (patch)
treefa5f8249e463dabddc622a6f09b0ae407f43806d /src
parent48c88d566d19683a7d5b63f88c8b4487234e3712 (diff)
Moved gridTable from Markdown writer to Writers.Shared.
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Writers/Haddock.hs2
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs41
-rw-r--r--src/Text/Pandoc/Writers/Shared.hs43
3 files changed, 43 insertions, 43 deletions
diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs
index 7f7d89a43..e573704e7 100644
--- a/src/Text/Pandoc/Writers/Haddock.hs
+++ b/src/Text/Pandoc/Writers/Haddock.hs
@@ -45,7 +45,7 @@ import Text.Pandoc.Pretty
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Writers.Math (texMathToInlines)
-import Text.Pandoc.Writers.Shared
+import Text.Pandoc.Writers.Shared hiding (gridTable)
type Notes = [[Block]]
data WriterState = WriterState { stNotes :: Notes }
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index 8b58d5beb..d3d7abfd0 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -705,47 +705,6 @@ pandocTable opts headless aligns widths rawHeaders rawRows = do
else border
return $ head'' $$ underline $$ body $$ bottom
-gridTable :: PandocMonad m => Bool -> [Alignment] -> [Int]
- -> [Doc] -> [[Doc]] -> MD m Doc
-gridTable headless aligns widthsInChars headers' rawRows = do
- let hpipeBlocks blocks = hcat [beg, middle, end]
- where h = maximum (1 : map height 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 = chomp $ hcat $ intersperse sep' blocks
- let makeRow = hpipeBlocks . zipWith lblock widthsInChars
- let head' = makeRow headers'
- let rows' = map (makeRow . map chomp) rawRows
- 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 '=' 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 =
case bs of
diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs
index 34bfa0b64..e2853a9cb 100644
--- a/src/Text/Pandoc/Writers/Shared.hs
+++ b/src/Text/Pandoc/Writers/Shared.hs
@@ -39,13 +39,14 @@ module Text.Pandoc.Writers.Shared (
, tagWithAttrs
, fixDisplayMath
, unsmartify
+ , gridTable
)
where
import Control.Monad (liftM)
import Data.Aeson (FromJSON (..), Result (..), ToJSON (..), Value (Object),
encode, fromJSON)
import qualified Data.HashMap.Strict as H
-import Data.List (groupBy)
+import Data.List (groupBy, intersperse)
import qualified Data.Map as M
import Data.Maybe (isJust)
import qualified Data.Text as T
@@ -216,3 +217,43 @@ unsmartify opts ('\8212':xs)
unsmartify opts (x:xs) = x : unsmartify opts xs
unsmartify _ [] = []
+gridTable :: Monad m => Bool -> [Alignment] -> [Int]
+ -> [Doc] -> [[Doc]] -> m Doc
+gridTable headless aligns widthsInChars headers' rawRows = do
+ let hpipeBlocks blocks = hcat [beg, middle, end]
+ where h = maximum (1 : map height 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 = chomp $ hcat $ intersperse sep' blocks
+ let makeRow = hpipeBlocks . zipWith lblock widthsInChars
+ let head' = makeRow headers'
+ let rows' = map (makeRow . map chomp) rawRows
+ 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 '=' 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