diff options
author | fiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b> | 2007-07-04 18:53:12 +0000 |
---|---|---|
committer | fiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b> | 2007-07-04 18:53:12 +0000 |
commit | 1a8b32afd5cb5b230ff5170e4203fc8a361f140d (patch) | |
tree | 63b64552afd0a768caf9badec104c4c0d1fbac98 /src/Text | |
parent | 4fe56a8d18f49125a36f0c229548a23d5bbe0d13 (diff) | |
download | pandoc-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
Diffstat (limited to 'src/Text')
-rw-r--r-- | src/Text/Pandoc/Blocks.hs | 63 |
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 [" "])) + |