From 61143e4c27e58f5aac8beb5fa92925173f397e23 Mon Sep 17 00:00:00 2001 From: Jaro Date: Thu, 20 Apr 2023 21:33:42 +0200 Subject: [PATCH] Colocate golden test definitions with specs. --- test/Data/Text/ParagraphLayoutSpec.hs | 92 +++++++++------------------ 1 file changed, 30 insertions(+), 62 deletions(-) diff --git a/test/Data/Text/ParagraphLayoutSpec.hs b/test/Data/Text/ParagraphLayoutSpec.hs index 8fe4d0d..1506c1b 100644 --- a/test/Data/Text/ParagraphLayoutSpec.hs +++ b/test/Data/Text/ParagraphLayoutSpec.hs @@ -1,7 +1,5 @@ module Data.Text.ParagraphLayoutSpec (spec) where -import Data.Text.Glyphize (Font) - import Test.Hspec import Test.Hspec.Golden import System.FilePath ((<.>), ()) @@ -14,15 +12,6 @@ import Data.Text.ParagraphLayout.Rect type Page = (PageContinuity, ParagraphLayout) -goldenLayoutDir :: FilePath -goldenLayoutDir = ".golden" "paragraphLayout" - -goldenPagesDir :: FilePath -goldenPagesDir = ".golden" "paginatedParagraphLayout" - -goldenShapedRunsDir :: FilePath -goldenShapedRunsDir = ".golden" "shapedRuns" - goldenPath :: FilePath -> String -> FilePath goldenPath dir name = dir name <.> "golden" @@ -32,44 +21,17 @@ actualPath dir name = dir name <.> "actual" fontInfoPath :: FilePath -> String -> FilePath fontInfoPath dir name = dir name <.> "fontInfo" -class ShouldBeGolden a where - shouldBeGolden :: a -> FilePath -> Golden a - -instance ShouldBeGolden ParagraphLayout where - shouldBeGolden output_ name = Golden - { output = output_ - , encodePretty = show - , writeToFile = \ path -> writeFile path . prettyShow - , readFromFile = \ path -> readFile path >>= return . read - , goldenFile = goldenPath goldenLayoutDir name - , actualFile = Just (actualPath goldenLayoutDir name) - , failFirstTime = True - } - -instance ShouldBeGolden Pages where - shouldBeGolden output_ name = Golden - { output = output_ - , encodePretty = show . getPages - , writeToFile = \ path -> writeFile path . prettyShow - , readFromFile = \ path -> readFile path >>= return . Pages . read - , goldenFile = goldenPath goldenPagesDir name - , actualFile = Just (actualPath goldenPagesDir name) - , failFirstTime = True - } - -instance ShouldBeGolden ShapedRuns where - shouldBeGolden output_ name = Golden - { output = output_ - , encodePretty = show . getShapedRuns - , writeToFile = \ path -> writeFile path . prettyShow - , readFromFile = \ path -> readFile path >>= return . ShapedRuns . read - , goldenFile = goldenPath goldenShapedRunsDir name - , actualFile = Just (actualPath goldenShapedRunsDir name) - , failFirstTime = True - } - -shapedRuns' :: ParagraphLayout -> ShapedRuns -shapedRuns' = ShapedRuns . shapedRuns +goldenTest :: (PrettyShow a, Show inner, Read inner) => + FilePath -> (a -> inner) -> (inner -> a) -> inner -> FilePath -> Golden a +goldenTest goldenDir unwrap wrap innerOutput name = Golden + { output = wrap innerOutput + , encodePretty = show . unwrap + , writeToFile = \ path -> writeFile path . prettyShow + , readFromFile = \ path -> readFile path >>= return . wrap . read + , goldenFile = goldenPath goldenDir name + , actualFile = Just (actualPath goldenDir name) + , failFirstTime = True + } emptyLayout :: ParagraphLayout emptyLayout = ParagraphLayout (Rect 0 0 0 0) [] @@ -77,17 +39,6 @@ emptyLayout = ParagraphLayout (Rect 0 0 0 0) [] emptySpanLayout :: ParagraphLayout emptySpanLayout = ParagraphLayout (Rect 0 0 0 0) [SpanLayout []] --- | Test shaped runs against an expected value, and write metadata about the --- used font afterwards. -shapedRunsSpecWithFont :: - FilePath -> Font -> String -> FilePath -> Paragraph -> SpecWith () -shapedRunsSpecWithFont fontPath font subject name p = do - let infoPath = fontInfoPath goldenShapedRunsDir name - let writeInfo = writeFontInfo infoPath fontPath font - after_ writeInfo $ it subject $ do - let result = layoutPlain p - shapedRuns' result `shouldBeGolden` name - paginateAll :: PageOptions -> ParagraphLayout -> [Page] paginateAll opts pl = case paginate opts pl of (c, pl1, next) -> (c, pl1) : case next of @@ -100,6 +51,9 @@ spec :: Spec spec = do describe "layoutPlain" $ do + let + goldenDir = ".golden" "paragraphLayout" + shouldBeGolden = goldenTest goldenDir id id describe "with Arabic font" $ do font <- runIO $ loadFont arabicFont 0 testingOptions @@ -263,6 +217,9 @@ spec = do result `shouldBeGolden` "hardBreaksLTR" describe "paginate" $ do + let + goldenDir = ".golden" "paginatedParagraphLayout" + shouldBeGolden = goldenTest goldenDir getPages Pages describe "with Arabic font" $ do font <- runIO $ loadFont arabicFont 0 testingOptions @@ -278,7 +235,7 @@ spec = do , pageWidows = 2 } pages = paginateAll popts pl - Pages pages `shouldBeGolden` "spannedArabicFiller20em" + pages `shouldBeGolden` "spannedArabicFiller20em" describe "with Latin font" $ do font <- runIO $ loadFont latinFont 0 testingOptions @@ -294,9 +251,20 @@ spec = do , pageWidows = 3 } pages = paginateAll popts pl - Pages pages `shouldBeGolden` "loremIpsum20em" + pages `shouldBeGolden` "loremIpsum20em" describe "shaped runs for demo" $ do + let + goldenDir = ".golden" "shapedRuns" + shouldBeGolden = goldenTest goldenDir getShapedRuns ShapedRuns + -- | Test shaped runs against an expected value, + -- and write metadata about the used font afterwards. + shapedRunsSpecWithFont fontPath font subject name p = do + let infoPath = fontInfoPath goldenDir name + let writeInfo = writeFontInfo infoPath fontPath font + after_ writeInfo $ it subject $ do + let result = layoutPlain p + shapedRuns result `shouldBeGolden` name describe "with Latin font" $ do let fontPath = latinFont -- 2.30.2