From 06d97131e530d2ee9b14617290a157dd42c0db30 Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Tue, 10 Aug 2021 22:07:48 -0700
Subject: Tests.Helpers: export testGolden and use it in RTF reader.

This gives a diff output on failure.
---
 test/Tests/Helpers.hs     | 23 ++++++++++++++++++++++-
 test/Tests/Readers/RTF.hs | 17 +++++------------
 2 files changed, 27 insertions(+), 13 deletions(-)

(limited to 'test/Tests')

diff --git a/test/Tests/Helpers.hs b/test/Tests/Helpers.hs
index a48a5894e..6c06e3f71 100644
--- a/test/Tests/Helpers.hs
+++ b/test/Tests/Helpers.hs
@@ -16,6 +16,7 @@ module Tests.Helpers ( test
                      , TestResult(..)
                      , setupEnvironment
                      , showDiff
+                     , testGolden
                      , (=?>)
                      , purely
                      , ToString(..)
@@ -23,13 +24,16 @@ module Tests.Helpers ( test
                      )
                      where
 
+import System.FilePath
 import Data.Algorithm.Diff
 import qualified Data.Map as M
+import qualified Text.Pandoc.UTF8 as UTF8
 import Data.Text (Text, unpack)
+import qualified Data.Text as T
 import System.Exit
-import System.FilePath (takeDirectory)
 import qualified System.Environment as Env
 import Test.Tasty
+import Test.Tasty.Golden.Advanced (goldenTest)
 import Test.Tasty.HUnit
 import Text.Pandoc.Builder (Blocks, Inlines, doc, plain)
 import Text.Pandoc.Class
@@ -61,6 +65,23 @@ test fn name (input, expected) =
            dashes "" = replicate 72 '-'
            dashes x  = replicate (72 - length x - 5) '-' ++ " " ++ x ++ " ---"
 
+testGolden :: TestName -> FilePath -> FilePath -> (Text -> IO Text) -> TestTree
+testGolden  name expectedPath inputPath fn =
+  goldenTest
+    name
+    (UTF8.readFile expectedPath)
+    (UTF8.readFile inputPath >>= fn)
+    compareVals
+    (UTF8.writeFile expectedPath)
+ where
+  compareVals expected actual
+    | expected == actual = return Nothing
+    | otherwise =  return $ Just $
+        "\n--- " ++ expectedPath ++ "\n+++\n" ++
+        showDiff (1,1)
+          (getDiff (lines . filter (/='\r') $ T.unpack actual)
+                   (lines . filter (/='\r') $ T.unpack expected))
+
 -- | Set up environment for pandoc command tests.
 setupEnvironment :: FilePath -> IO [(String, String)]
 setupEnvironment testExePath = do
diff --git a/test/Tests/Readers/RTF.hs b/test/Tests/Readers/RTF.hs
index da0ddfc93..1b335274b 100644
--- a/test/Tests/Readers/RTF.hs
+++ b/test/Tests/Readers/RTF.hs
@@ -13,25 +13,18 @@ module Tests.Readers.RTF (tests) where
 
 import Test.Tasty
 import Tests.Helpers
-import Test.Tasty.Golden (goldenVsString)
-import qualified Data.ByteString as BS
 import Text.Pandoc
-import Text.Pandoc.UTF8 (toText, fromStringLazy)
-import Data.Text (Text, unpack)
 import System.FilePath (replaceExtension, (</>), (<.>))
 
-rtfToNative :: Text -> Text
-rtfToNative =
-  purely (writeNative def{ writerTemplate = Just mempty }) .
-    purely (readRTF def)
-
 rtfTest :: TestName -> TestTree
-rtfTest name = goldenVsString name native
-  (fromStringLazy . filter (/='\r') . unpack . rtfToNative . toText
-    <$> BS.readFile path)
+rtfTest name = testGolden name native path
+   (\t -> runIOorExplode
+            (readRTF def t >>=
+              writeNative def{ writerTemplate = Just mempty }))
   where native = replaceExtension path ".native"
         path = "rtf" </> name <.> "rtf"
 
+
 tests :: [TestTree]
 tests = map rtfTest [ "footnote"
                     , "accent"
-- 
cgit v1.2.3