Moved gridTable from Markdown writer to Writers.Shared.

1 files changed, 42 insertions, 1 deletions

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