1 files changed, 30 insertions(+), 62 deletions(-)

M 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