~jaro/balkon

84f9c76357b7b7a2d88316f31d7a39c1ed335bd0 — Jaro 1 year, 6 months ago 5284d48
Prepare for test modules sharing PrettyShow.
3 files changed, 145 insertions(+), 132 deletions(-)

M balkon.cabal
A test/Data/Text/ParagraphLayout/PrettyShow.hs
M test/Data/Text/ParagraphLayoutSpec.hs
M balkon.cabal => balkon.cabal +1 -0
@@ 195,6 195,7 @@ test-suite balkon-test
        Data.Text.ParagraphLayout.Internal.TextContainerSpec,
        Data.Text.ParagraphLayout.Internal.ZipperSpec,
        Data.Text.ParagraphLayout.ParagraphData,
        Data.Text.ParagraphLayout.PrettyShow,
        Data.Text.ParagraphLayout.RectSpec,
        Data.Text.ParagraphLayout.SpanData


A test/Data/Text/ParagraphLayout/PrettyShow.hs => test/Data/Text/ParagraphLayout/PrettyShow.hs +143 -0
@@ 0,0 1,143 @@
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

M test/Data/Text/ParagraphLayoutSpec.hs => test/Data/Text/ParagraphLayoutSpec.hs +1 -132
@@ 7,144 7,13 @@ import Test.Hspec.Golden
import System.FilePath ((</>))
import Data.Text.ParagraphLayout
import Data.Text.ParagraphLayout.FontLoader
import Data.Text.ParagraphLayout.Internal.Fragment
import Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout
import Data.Text.ParagraphLayout.ParagraphData
import Data.Text.ParagraphLayout.PrettyShow
import Data.Text.ParagraphLayout.Rect

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

class ShouldBeGolden a where
    shouldBeGolden :: a -> FilePath -> Golden a