From 1a8b32afd5cb5b230ff5170e4203fc8a361f140d Mon Sep 17 00:00:00 2001 From: fiddlosopher Date: Wed, 4 Jul 2007 18:53:12 +0000 Subject: 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 --- src/Text/Pandoc/Blocks.hs | 63 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) create mode 100644 src/Text/Pandoc/Blocks.hs 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 [" "])) + -- cgit v1.2.3