balkon-1.0.0.0: test/Data/Text/ParagraphLayout/PrettyShow.hs

{-# OPTIONS_GHC -fno-warn-deprecations #-}
module Data.Text.ParagraphLayout.PrettyShow
    ( PrettyShow
    , prettyShow
    , Pages (..)
    , RichPages (..)
    , ShapedRuns (..)
    )
where

import Data.List (intersperse)
import Data.Text.ParagraphLayout
import Data.Text.ParagraphLayout.Internal.Fragment
    ( Fragment (Fragment)
    , ShapedRun
    )
import qualified Data.Text.ParagraphLayout.Plain as Plain
import qualified Data.Text.ParagraphLayout.Rich as Rich

class PrettyShow a where
    prettyShow :: a -> String

newtype ShapedRuns = ShapedRuns { getShapedRuns :: [ShapedRun] }
    deriving (Eq)

instance PrettyShow ShapedRuns where
    prettyShow (ShapedRuns xs) =
        concat $ commaFirstList indent0 $ map (prettyShow . ShapedRun') xs

newtype ShapedRun' = ShapedRun' ShapedRun

instance PrettyShow ShapedRun' where
    prettyShow (ShapedRun' (x, y, glyphs)) = concat
        [ "("
        , show x
        , ", "
        , show y
        , ", "
        , newline
        , concat $ commaFirstList indent1 $ map prettyShowPair glyphs
        , ")"
        ]

type Page d = (PageContinuity, Plain.ParagraphLayout d)

newtype Pages d = Pages { getPages :: [Page d] }
    deriving (Eq)

instance Show d => PrettyShow (Pages d) where
    prettyShow (Pages ps) =
        concat (commaFirstList indent0 $ map (prettyShow . Page') ps)
        ++ newline

newtype Page' d = Page' (Page d)

instance Show d => PrettyShow (Page' d) where
    prettyShow (Page' (c, pl)) = concat
        [ "("
        , show c
        , ", "
        , prettyShow pl
        , ")"
        ]

type RichPage d = (PageContinuity, Rich.ParagraphLayout d)

newtype RichPages d = RichPages { getRichPages :: [RichPage d] }
    deriving (Eq)

instance Show d => PrettyShow (RichPages d) where
    prettyShow (RichPages ps) =
        concat (commaFirstList indent0 $ map (prettyShow . RichPage') ps)
        ++ newline

newtype RichPage' d = RichPage' (RichPage d)

instance Show d => PrettyShow (RichPage' d) where
    prettyShow (RichPage' (c, pl)) = concat
        [ "("
        , show c
        , ", "
        , prettyShow pl
        , ")"
        ]

instance Show d => PrettyShow (Plain.ParagraphLayout d) where
    prettyShow (Plain.ParagraphLayout pr sls) = concat
        [ "ParagraphLayout"
        , newline
        , indent1
        , "{ paragraphRect = "
        , show pr
        , newline
        , indent1
        , ", spanLayouts = ["
        , newline
        , concat $ commaAloneList indent2 $ map prettyShow sls
        , newline
        , indent1
        , "]}"
        , newline
        ]

instance Show d => PrettyShow (Plain.SpanLayout d) where
    prettyShow (Plain.SpanLayout frags) = concat
        [ "SpanLayout"
        , newline
        , concat $ commaFirstList indent2 $ map prettyShow frags
        ]

instance Show d => PrettyShow (Fragment d) where
    prettyShow (Fragment d l bs r pen glyphs) = concat
        [ "Fragment"
        , newline
        , indent3
        , "{ fragmentUserData = "
        , show d
        , newline
        , indent3
        , ", fragmentLine = "
        , show l
        , newline
        , indent3
        , ", fragmentAncestorBoxes ="
        , newline
        , concat $ commaFirstList indent4 $ map show bs
        , newline
        , indent3
        , ", fragmentRect = "
        , show r
        , newline
        , indent3
        , ", fragmentPen = "
        , prettyShowPair pen
        , newline
        , indent3
        , ", fragmentGlyphs ="
        , newline
        , concat $ commaFirstList indent4 $ map prettyShowPair glyphs
        , newline
        , indent3
        , "}"
        ]

instance Show d => PrettyShow (Rich.ParagraphLayout d) where
    prettyShow (Rich.ParagraphLayout pr frags) = concat
        [ "ParagraphLayout"
        , newline
        , indent1
        , "{ paragraphRect = "
        , show pr
        , newline
        , indent1
        , ", paragraphFragments ="
        , newline
        , concat $ commaFirstList indent2 $ map prettyShow frags
        , newline
        , indent1
        , "}"
        , newline
        ]

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)

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)

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 = ""

indent1 :: String
indent1 = "    "

indent2 :: String
indent2 = indent1 ++ indent1

indent3 :: String
indent3 = indent1 ++ indent2

indent4 :: String
indent4 = indent1 ++ indent3

newline :: String
newline = "\n"