Restore Phylo tests

test/Test/Offline/Phylo.hs

 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TupleSections #-}
 
 module Test.Offline.Phylo (tests) where
 
@@ -26,6 +27,7 @@ import Prelude
 import Test.Tasty
 import Test.Tasty.Golden (goldenVsStringDiff)
 import Test.Tasty.HUnit
+import qualified Test.Tasty.Golden.Advanced as Advanced
 
 phyloTestConfig :: PhyloConfig
 phyloTestConfig = PhyloConfig {
@@ -57,6 +59,26 @@ phyloGolden testName (fp, action) =
   where
     differ ref new = [ "diff", "-u", "-w", "--color=always", ref, new]
 
+-- | Use this variant for those tests which requires a more sophisticated way of
+-- comparing outputs directly on the GraphData
+phyloGoldenGraphData :: TestName -> (FilePath, IO GraphData) -> TestTree
+phyloGoldenGraphData testName (goldenPath, getActual) =
+  Advanced.goldenTest testName getGolden getActual differ updateGolden
+  where
+    differ ref new = pure $ case compareGraphDataFuzzy ref new of
+      True  -> Nothing
+      False -> Just $ show (ansiWlEditExprCompact $ ediff ref new)
+
+    updateGolden :: GraphData -> IO ()
+    updateGolden gd = BL.writeFile goldenPath (JSON.encodePretty gd)
+
+    getGolden :: IO GraphData
+    getGolden = do
+      expected_e <- JSON.eitherDecodeFileStrict' =<< getDataFileName goldenPath
+      case expected_e of
+        Left err -> fail err
+        Right (expected :: GraphData) -> pure expected
+
 tests :: TestTree
 tests = testGroup "Phylo" [
   testGroup "Export" [
@@ -66,13 +88,13 @@ tests = testGroup "Phylo" [
   , testGroup "toPhyloWithoutLink" [
     testCase "returns expected data" testSmallPhyloWithoutLinkExpectedOutput
   , phyloGolden "phyloCleopatre returns expected data" testCleopatreWithoutLinkExpectedOutput
-  , testCase "Nadal canned corpus returns expected data" testNadalWithoutLinkExpectedOutput
+  , phyloGolden "Nadal canned corpus returns expected data" testNadalWithoutLinkExpectedOutput
   ]
   , testGroup "phylo2dot2json" [
-    testCase "is deterministic" testPhylo2dot2json
+    phyloGoldenGraphData "is deterministic" testPhylo2dot2json
   ]
   , testGroup "toPhylo" [
-    testCase "is deterministic" testToPhyloDeterminism
+    phyloGolden "is deterministic" testToPhyloDeterminism
   ]
   , testGroup "relatedComponents" [
     testCase "finds simple connection" testRelComp_Connected
@@ -85,8 +107,8 @@ testCleopatreWithoutLinkExpectedOutput =
   let actual = toPhyloWithoutLink Cleopatre.docs Cleopatre.config
   in ("test-data/phylo/cleopatre.golden.json", pure $ JSON.encodePretty actual)
 
-testNadalWithoutLinkExpectedOutput :: Assertion
-testNadalWithoutLinkExpectedOutput = do
+testNadalWithoutLinkExpectedOutput :: (FilePath, IO BL.ByteString)
+testNadalWithoutLinkExpectedOutput = ("test-data/phylo/nadal.golden.json",) $ do
   corpusPath'    <- getDataFileName "test-data/phylo/nadal_docslist.golden.tsv"
   listPath'      <- getDataFileName "test-data/phylo/nadal_ngramslist.golden.tsv"
   let config  = phyloTestConfig { corpusPath = corpusPath'
@@ -98,9 +120,7 @@ testNadalWithoutLinkExpectedOutput = do
                         (corpusPath config)
                         [Year 3 1 5,Month 3 1 5,Week 4 2 5]
                         mapList
-  let actual = setConfig phyloTestConfig $ toPhyloWithoutLink corpus config
-  expected   <- setConfig phyloTestConfig <$> (readPhylo =<< getDataFileName "test-data/phylo/nadal.golden.json")
-  assertBool (show $ ansiWlEditExprCompact $ ediff expected actual) (expected == actual)
+  pure $ JSON.encodePretty $ setConfig phyloTestConfig $ toPhyloWithoutLink corpus config
 
 testSmallPhyloWithoutLinkExpectedOutput :: Assertion
 testSmallPhyloWithoutLinkExpectedOutput = do
@@ -119,17 +139,12 @@ testSmallPhyloWithoutLinkExpectedOutput = do
   expected   <- setConfig phyloTestConfig <$> (readPhylo =<< getDataFileName "test-data/phylo/small-phylo.golden.json")
   assertBool (show $ ansiWlEditExprCompact $ ediff expected actual) (expected == actual)
 
-testPhylo2dot2json :: Assertion
-testPhylo2dot2json = do
-  expected_e <- JSON.eitherDecodeFileStrict' =<< getDataFileName "test-data/phylo/phylo2dot2json.golden.json"
-  case expected_e of
+testPhylo2dot2json :: (FilePath, IO GraphData)
+testPhylo2dot2json = ("test-data/phylo/phylo2dot2json.golden.json",) $ do
+  actual_e <- JSON.parseEither JSON.parseJSON <$> phylo2dot2json Cleopatre.phyloCleopatre
+  case actual_e of
     Left err -> fail err
-    Right (expected :: GraphData) -> do
-      actual_e <- JSON.parseEither JSON.parseJSON <$> phylo2dot2json Cleopatre.phyloCleopatre
-      case actual_e of
-        Left err -> fail err
-        Right (actual :: GraphData) -> do
-          assertBool ("Phylo mismatch!" <> show (ansiWlEditExprCompact $ ediff expected actual)) (expected `compareGraphDataFuzzy` actual)
+    Right (actual :: GraphData) -> pure actual
 
 compareGraphDataFuzzy :: GraphData -> GraphData -> Bool
 compareGraphDataFuzzy gd1 gd2 =
@@ -240,8 +255,8 @@ testRelComp_Connected = do
   (relatedComponents @Int) [[1,2], [3,5], [2,4],[9,5],[5,4]] @?= [[1,2,4,3,5,9]]
   (relatedComponents @Int) [[1,2,5], [4,5,9]]                @?= [[1,2,5,4,9]]
 
-testToPhyloDeterminism :: Assertion
-testToPhyloDeterminism = do
+testToPhyloDeterminism :: (FilePath, IO BL.ByteString)
+testToPhyloDeterminism = ("test-data/phylo/187481.json",) $ do
   corpusPath' <- getDataFileName "test-data/phylo/GarganText_DocsList-nodeId-187481.tsv"
   listPath'   <- getDataFileName "test-data/phylo/GarganText_NgramsList-187482.tsv"
   let config  = phyloTestConfig { corpusPath = corpusPath'
@@ -254,8 +269,7 @@ testToPhyloDeterminism = do
                               [Year 3 1 5,Month 3 1 5,Week 4 2 5]
                               mapList
   let actual = setConfig phyloTestConfig $ toPhylo $ toPhyloWithoutLink corpus config
-  expected    <- setConfig phyloTestConfig <$> (readPhylo =<< getDataFileName "test-data/phylo/187481.json")
-  assertBool ("Phylo mismatch! " <> show (ansiWlEditExprCompact $ ediff expected actual)) (expected == actual)
+  pure $ JSON.encodePretty actual
 
 testCsvPhylo :: Assertion
 testCsvPhylo = do