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