aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorfiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>2007-07-04 18:53:12 +0000
committerfiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>2007-07-04 18:53:12 +0000
commit1a8b32afd5cb5b230ff5170e4203fc8a361f140d (patch)
tree63b64552afd0a768caf9badec104c4c0d1fbac98
parent4fe56a8d18f49125a36f0c229548a23d5bbe0d13 (diff)
downloadpandoc-1a8b32afd5cb5b230ff5170e4203fc8a361f140d.tar.gz
Added Text.Pandoc.Blocks module for prettyprinting of
text tables. git-svn-id: https://pandoc.googlecode.com/svn/trunk@620 788f1e2b-df1e-0410-8736-df70ead52e1b
-rw-r--r--src/Text/Pandoc/Blocks.hs63
1 files changed, 63 insertions, 0 deletions
diff --git a/src/Text/Pandoc/Blocks.hs b/src/Text/Pandoc/Blocks.hs
new file mode 100644
index 000000000..995b2d009
--- /dev/null
+++ b/src/Text/Pandoc/Blocks.hs
@@ -0,0 +1,63 @@
+module Text.Blocks
+ (
+ docToBlock,
+ blockToDoc,
+ widthOfBlock,
+ heightOfBlock,
+ hcatBlocks,
+ hsepBlocks
+ )
+where
+
+import Text.PrettyPrint
+import Data.List (transpose, intersperse)
+
+data TextBlock = TextBlock Int Int [String] -- width height lines
+instance Show TextBlock where
+ show x = show $ blockToDoc x
+
+docToBlock :: Int -> Doc -> TextBlock
+docToBlock width doc =
+ let rendered = renderStyle (style {lineLength = width,
+ ribbonsPerLine = 1}) doc
+ lns = lines rendered
+ chop [] = []
+ chop (l:ls) = if length l > width
+ then (take width l):(chop ((drop width l):ls))
+ else l:(chop ls)
+ lns' = chop lns
+ in TextBlock width (length lns') lns'
+
+blockToDoc :: TextBlock -> Doc
+blockToDoc (TextBlock _ _ lns) =
+ if null lns
+ then empty
+ else text $ unlines (init lns) ++ last lns -- to avoid trailing \n
+
+widthOfBlock :: TextBlock -> Int
+widthOfBlock (TextBlock width _ _) = width
+
+heightOfBlock :: TextBlock -> Int
+heightOfBlock (TextBlock _ height _) = height
+
+-- pad line out to width using spaces
+hPad :: Int -> String -> String
+hPad width line =
+ let lineLength = length line
+ in if lineLength <= width
+ then line ++ replicate (width - lineLength) ' '
+ else take width line
+
+hcatBlocks :: [TextBlock] -> TextBlock
+hcatBlocks [] = TextBlock 0 0 []
+hcatBlocks ((TextBlock width1 height1 lns1):xs) =
+ let (TextBlock width2 height2 lns2) = hcatBlocks xs
+ height = max height1 height2
+ width = width1 + width2
+ lns1' = map (hPad width1) $ lns1 ++ replicate (height - height1) ""
+ lns2' = lns2 ++ replicate (height - height2) ""
+ lns = zipWith (++) lns1' lns2'
+ in TextBlock width height lns
+
+hsepBlocks = hcatBlocks . (intersperse (TextBlock 1 1 [" "]))
+