Use golden tests for the CLI.

Author: Patrick Thomson

test/Semantic/CLI/Spec.hs

@@ -4,33 +4,52 @@ import           Control.Monad (when)
 import qualified Data.ByteString as B
 import           Data.ByteString.Builder
 import           Data.Foldable (for_)
-import           Semantic.Api hiding (File, Blob, BlobPair)
+import           Semantic.Api hiding (Blob, BlobPair, File)
 import           Semantic.CLI
 import           Semantic.IO
 import           Semantic.Task
 import           Serializing.Format
+import           System.Directory
+import           System.IO.Unsafe
+import           System.Process
 
 import SpecHelpers
+import Test.Tasty
+import Test.Tasty.Golden
 
+spec :: TestTree
+spec = testGroup "Semantic.CLI"
+  [ testGroup "parseDiffBuilder" $ fmap testForDiffFixture diffFixtures
+  , testGroup "parseTermBuilder" $ fmap testForParseFixture parseFixtures
+  ]
+
+-- If you're investigating these tests and find this output hard to read
+-- the `jd` CLI tool (https://github.com/josephburnett/jd) will print
+-- a detailed summary of the differences between these JSON files.
+renderDiff :: String -> String -> [String]
+renderDiff ref new = unsafePerformIO $ do
+  useJD <- (isExtensionOf ".json" ref &&) <$> fmap isJust (findExecutable "jd")
+  pure $ if useJD
+    then ["jd", "-set", ref, new]
+    else ["git", "diff", ref, new]
+{-# NOINLINE renderDiff #-}
+
+
+-- PT TODO: reduce duplication
+
+testForDiffFixture (diffRenderer, runDiff, files, expected) =
+  goldenVsStringDiff
+    ("renders to " <> diffRenderer)
+    renderDiff
+    expected
+    (fmap toLazyByteString . runTaskOrDie $ readBlobPairs (Right files) >>= runDiff)
 
-spec :: Spec
-spec = parallel $ do
-  describe "parseDiffBuilder" $
-    for_ diffFixtures $ \ (diffRenderer, runDiff, files, expected) ->
-      it ("renders to " <> diffRenderer <> " with files " <> show files) $ do
-        output <- runTaskOrDie $ readBlobPairs (Right files) >>= runDiff
-        runBuilder output `shouldBe'` expected
-
-  describe "parseTermBuilder" $
-    for_ parseFixtures $ \ (format, runParse, files, expected) ->
-      it ("renders to " <> format <> " with files " <> show files) $ do
-        output <- runTaskOrDie $ readBlobs (FilesFromPaths files) >>= runParse
-        runBuilder output `shouldBe'` expected
-  where
-    shouldBe' actual' expectedFile = do
-      let actual = verbatim actual'
-      expected <- verbatim <$> B.readFile expectedFile
-      actual `shouldBe` expected
+testForParseFixture (format, runParse, files, expected) =
+  goldenVsStringDiff
+    ("renders to " <> format)
+    renderDiff
+    expected
+    (fmap toLazyByteString . runTaskOrDie $ readBlobs (FilesFromPaths files) >>= runParse)
 
 parseFixtures :: [(String, [Blob] -> TaskEff Builder, [File], FilePath)]
 parseFixtures =

test/Spec.hs

@@ -44,6 +44,7 @@ import Test.Tasty.Options as Tasty
 tests :: TaskSession -> [TestTree]
 tests session =
   [ Integration.Spec.spec session
+  , Semantic.CLI.Spec.spec
   ]
 
 -- We can't bring this out of the IO monad until we divest
@@ -93,7 +94,6 @@ legacySpecs args = do
     describe "Rewriting.Python" Rewriting.Python.Spec.spec
     describe "Tags.Spec" Tags.Spec.spec
     describe "Semantic" Semantic.Spec.spec
-    describe "Semantic.CLI" Semantic.CLI.Spec.spec
     describe "Semantic.IO" Semantic.IO.Spec.spec
     describe "Parsing" Parsing.Spec.spec