module Text.PrettyPrint.MPPPC.TwoDim.Render where
import Prelude
hiding
( head
, length
, replicate
, reverse
, splitAt
, tail
, unlines )
import Control.Arrow
( (***)
, first )
import qualified Data.List as List
( length
, replicate
, reverse
, splitAt )
import Text.PrettyPrint.MPPPC.Printable
import Text.PrettyPrint.MPPPC.TwoDim.Pretty
blanks :: Printable s t => Int -> s
blanks = flip replicate $ singleton tokSpace
renderPretty :: Printable s t => Pretty s t -> s
renderPretty = unlines . renderPrettyLines
renderPrettyLines :: Printable s t => Pretty s t -> [s]
renderPrettyLines (Pretty r c Blank) = resizePretty r c [singleton tokSpace]
renderPrettyLines (Pretty r c (Text t)) = resizePretty r c [t]
renderPrettyLines (Pretty r c (Row bs)) = resizePretty r c
. merge
. map (renderPrettyWithRows r)
$ bs
where
merge = foldr (zipWith append) (repeat seqEmpty)
renderPrettyLines (Pretty r c (Col bs)) = resizePretty r c
. concatMap (renderPrettyWithCols c)
$ bs
renderPrettyLines (Pretty r c (Sub ha va b)) = resizePrettyAligned r c ha va
. renderPrettyLines
$ b
renderPrettyWithRows :: Printable s t => Int -> Pretty s t -> [s]
renderPrettyWithRows r b = renderPrettyLines $ b { rows = r }
renderPrettyWithCols :: Printable s t => Int -> Pretty s t -> [s]
renderPrettyWithCols c b = renderPrettyLines $ b { cols = c }
resizePretty :: Printable s t => Int -> Int -> [s] -> [s]
resizePretty r c = takePadList (blanks c) r
. map (takePad (singleton tokSpace) c)
resizePrettyAligned :: Printable s t => Int -> Int -> Alignment -> Alignment -> [s] -> [s]
resizePrettyAligned r c ha va = takePadAlignList va (blanks c) r
. map (takePadAlign ha (singleton tokSpace) c)
takePad :: Printable s t => s -> Int -> s -> s
takePad _ n _ | n <= 0 = seqEmpty
takePad b n xs | isNull xs = replicate n b
takePad b n xs = head xs `cons` takePad b (n1) (tail xs)
takePadList :: Printable s t => s -> Int -> [s] -> [s]
takePadList _ n _ | n <= 0 = []
takePadList b n [] = List.replicate n b
takePadList b n (x:xs) = x : takePadList b (n1) xs
takePadAlign :: Printable s t => Alignment -> s -> Int -> s -> s
takePadAlign c b n = glue
. (takePad b (numRev c n) *** takePad b (numFwd c n))
. split
where
split t = first reverse
. splitAt (numRev c (length t))
$ t
glue = uncurry append
. first reverse
numFwd AlignFirst m = m
numFwd AlignLast _ = 0
numFwd AlignCenterTopLeft m = m `div` 2
numFwd AlignCenterBotRight m = (m+1) `div` 2
numRev AlignFirst _ = 0
numRev AlignLast m = m
numRev AlignCenterTopLeft m = (m+1) `div` 2
numRev AlignCenterBotRight m = m `div` 2
takePadAlignList :: Printable s t => Alignment -> s -> Int -> [s] -> [s]
takePadAlignList c b n = glue
. (takePadList b (numRev c n) *** takePadList b (numFwd c n))
. split
where
split t = first List.reverse
. List.splitAt (numRev c (List.length t))
$ t
glue = uncurry (++)
. first List.reverse
numFwd AlignFirst m = m
numFwd AlignLast _ = 0
numFwd AlignCenterTopLeft m = m `div` 2
numFwd AlignCenterBotRight m = (m+1) `div` 2
numRev AlignFirst _ = 0
numRev AlignLast m = m
numRev AlignCenterTopLeft m = (m+1) `div` 2
numRev AlignCenterBotRight m = m `div` 2