1 files changed, 72 insertions(+), 46 deletions(-)

M test/Data/Text/ParagraphLayout/PrettyShow.hs

@@ 6,6 6,7 @@ module Data.Text.ParagraphLayout.PrettyShow
     )
 where
 
+import Data.List (intersperse)
 import Data.Text.ParagraphLayout
 import Data.Text.ParagraphLayout.Internal.Fragment (ShapedRun)
 


@@ 16,11 17,8 @@ newtype ShapedRuns = ShapedRuns { getShapedRuns :: [ShapedRun] }
     deriving (Eq)
 
 instance PrettyShow ShapedRuns where
-    prettyShow (ShapedRuns xs) = concat
-        [ "["
-        , concat $ indentedList indent0 $ map (prettyShow . ShapedRun') xs
-        , "]"
-        ]
+    prettyShow (ShapedRuns xs) =
+        concat $ commaFirstList indent0 $ map (prettyShow . ShapedRun') xs
 
 newtype ShapedRun' = ShapedRun' ShapedRun
 


@@ 28,15 26,11 @@ instance PrettyShow ShapedRun' where
     prettyShow (ShapedRun' (x, y, glyphs)) = concat
         [ "("
         , show x
-        , ","
+        , ", "
         , show y
-        , ","
-        , newline
-        , indent1
-        , "["
-        , concat $ indentedList indent1 $ map show glyphs
-        , "]"
+        , ", "
         , newline
+        , concat $ commaFirstList indent1 $ map prettyShowPair glyphs
         , ")"
         ]
 


@@ 46,11 40,9 @@ newtype Pages = Pages { getPages :: [Page] }
     deriving (Eq)
 
 instance PrettyShow Pages where
-    prettyShow (Pages ps) = concat
-        [ "["
-        , concat $ indentedList indent0 $ map (prettyShow . Page') ps
-        , "]"
-        ]
+    prettyShow (Pages ps) =
+        concat (commaFirstList indent0 $ map (prettyShow . Page') ps)
+        ++ newline
 
 newtype Page' = Page' Page
 


@@ 65,49 57,68 @@ instance PrettyShow Page' where
 
 instance PrettyShow ParagraphLayout where
     prettyShow (ParagraphLayout pr sls) = concat
-        [ "ParagraphLayout {paragraphRect = "
+        [ "ParagraphLayout"
+        , newline
+        , indent1
+        , "{ paragraphRect = "
         , show pr
-        , commaSpace
-        , "spanLayouts = ["
         , newline
         , indent1
-        , concat $ indentedList indent1 $ map prettyShow sls
+        , ", spanLayouts = ["
+        , newline
+        , concat $ commaAloneList indent2 $ map prettyShow sls
         , newline
+        , indent1
         , "]}"
         , newline
         ]
 
 instance PrettyShow SpanLayout where
     prettyShow (SpanLayout frags) = concat
-        [ "SpanLayout ["
-        , concat $ inlineList $ map prettyShow frags
-        , "]"
+        [ "SpanLayout"
+        , newline
+        , concat $ commaFirstList indent2 $ map prettyShow frags
         ]
 
 instance PrettyShow Fragment where
     prettyShow (Fragment r pen glyphs) = concat
-        [ "Fragment {fragmentRect = "
+        [ "Fragment"
+        , newline
+        , indent3
+        , "{ fragmentRect = "
         , show r
-        , commaSpace
-        , "fragmentPen = "
-        , show pen
-        , commaSpace
-        , "fragmentGlyphs ="
         , newline
-        , indent2
-        , "["
-        , concat $ indentedList indent2 $ map show glyphs
-        , "]"
+        , indent3
+        , ", fragmentPen = "
+        , prettyShowPair pen
         , newline
-        , indent1
+        , indent3
+        , ", fragmentGlyphs ="
+        , newline
+        , concat $ commaFirstList indent4 $ map prettyShowPair glyphs
+        , newline
+        , indent3
         , "}"
         ]
 
-inlineList :: [String] -> [String]
-inlineList items = suffixInit commaSpace items
-
-indentedList :: String -> [String] -> [String]
-indentedList indent items = prefixTail indent $ suffixInit commaNewline items
+prettyShowPair :: (Show a, Show b) => (a, b) -> String
+prettyShowPair (a, b) = "(" ++ show a ++ ", " ++ show b ++ ")"
+
+commaAloneList :: String -> [String] -> [String]
+commaAloneList indent items =
+    map (indent ++) $
+    suffixInit newline $
+    intersperse "," $
+    items
+
+commaFirstList :: String -> [String] -> [String]
+commaFirstList indent [] = [indent ++ "[]"]
+commaFirstList indent items =
+    prefixHead (indent ++ "[ ") $
+    prefixTail (indent ++ ", ") $
+    suffixInit newline $
+    suffixLast (newline ++ indent ++ "]") $
+    items
 
 suffixInit :: String -> [String] -> [String]
 suffixInit suffix = mapInit (++ suffix)


@@ 124,6 135,21 @@ mapTail :: (a -> a) -> [a] -> [a]
 mapTail _ [] = []
 mapTail f (x : xs) = x : (map f xs)
 
+prefixHead :: String -> [String] -> [String]
+prefixHead prefix = mapHead (prefix ++)
+
+mapHead :: (a -> a) -> [a] -> [a]
+mapHead _ [] = []
+mapHead f (x : xs) = f x : xs
+
+suffixLast :: String -> [String] -> [String]
+suffixLast suffix = mapLast (++ suffix)
+
+mapLast :: (a -> a) -> [a] -> [a]
+mapLast _ [] = []
+mapLast f [x] = [f x]
+mapLast f (x : y : ys) = x : mapLast f (y : ys)
+
 indent0 :: String
 indent0 = ""
 


@@ 133,11 159,11 @@ indent1 = "    "
 indent2 :: String
 indent2 = indent1 ++ indent1
 
-newline :: String
-newline = "\n"
+indent3 :: String
+indent3 = indent1 ++ indent2
 
-commaSpace :: String
-commaSpace = ", "
+indent4 :: String
+indent4 = indent1 ++ indent3
 
-commaNewline :: String
-commaNewline = "," ++ newline
+newline :: String
+newline = "\n"