module Data.Text.ParagraphLayout.PrettyShow ( PrettyShow , prettyShow , Pages (..) , ShapedRuns (..) ) where import Data.Text.ParagraphLayout import Data.Text.ParagraphLayout.Internal.Fragment (ShapedRun) class PrettyShow a where prettyShow :: a -> String newtype ShapedRuns = ShapedRuns { getShapedRuns :: [ShapedRun] } deriving (Eq) instance PrettyShow ShapedRuns where prettyShow (ShapedRuns xs) = concat [ "[" , concat $ indentedList indent0 $ map (prettyShow . ShapedRun') xs , "]" ] newtype ShapedRun' = ShapedRun' ShapedRun instance PrettyShow ShapedRun' where prettyShow (ShapedRun' (x, y, glyphs)) = concat [ "(" , show x , "," , show y , "," , newline , indent1 , "[" , concat $ indentedList indent1 $ map show glyphs , "]" , newline , ")" ] type Page = (PageContinuity, ParagraphLayout) newtype Pages = Pages { getPages :: [Page] } deriving (Eq) instance PrettyShow Pages where prettyShow (Pages ps) = concat [ "[" , concat $ indentedList indent0 $ map (prettyShow . Page') ps , "]" ] newtype Page' = Page' Page instance PrettyShow Page' where prettyShow (Page' (c, pl)) = concat [ "(" , show c , ", " , prettyShow pl , ")" ] instance PrettyShow ParagraphLayout where prettyShow (ParagraphLayout pr sls) = concat [ "ParagraphLayout {paragraphRect = " , show pr , commaSpace , "spanLayouts = [" , newline , indent1 , concat $ indentedList indent1 $ map prettyShow sls , newline , "]}" , newline ] instance PrettyShow SpanLayout where prettyShow (SpanLayout frags) = concat [ "SpanLayout [" , concat $ inlineList $ map prettyShow frags , "]" ] instance PrettyShow Fragment where prettyShow (Fragment r pen glyphs) = concat [ "Fragment {fragmentRect = " , show r , commaSpace , "fragmentPen = " , show pen , commaSpace , "fragmentGlyphs =" , newline , indent2 , "[" , concat $ indentedList indent2 $ map show glyphs , "]" , newline , indent1 , "}" ] inlineList :: [String] -> [String] inlineList items = suffixInit commaSpace items indentedList :: String -> [String] -> [String] indentedList indent items = prefixTail indent $ suffixInit commaNewline items suffixInit :: String -> [String] -> [String] suffixInit suffix = mapInit (++ suffix) mapInit :: (a -> a) -> [a] -> [a] mapInit _ [] = [] mapInit _ [x] = [x] mapInit f (x : y : ys) = f x : mapInit f (y : ys) prefixTail :: String -> [String] -> [String] prefixTail prefix = mapTail (prefix ++) mapTail :: (a -> a) -> [a] -> [a] mapTail _ [] = [] mapTail f (x : xs) = x : (map f xs) indent0 :: String indent0 = "" indent1 :: String indent1 = " " indent2 :: String indent2 = indent1 ++ indent1 newline :: String newline = "\n" commaSpace :: String commaSpace = ", " commaNewline :: String commaNewline = "," ++ newline