From bb9723313cb17156ba4aa748affe38f1de17f94f Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <m@jaspervdj.be>
Date: Fri, 4 Aug 2023 13:45:48 +0200
Subject: [PATCH] Check discriminators in FromJSON Assert (#36)

See #22
---
 goldplate.cabal  |  2 +-
 src/Goldplate.hs | 41 ++++++++++++++++++++++++++---------------
 tests/Tests.hs   | 23 ++++++++++++++++++++---
 3 files changed, 47 insertions(+), 19 deletions(-)

diff --git a/goldplate.cabal b/goldplate.cabal
index 874485f..6e5ca5d 100644
--- a/goldplate.cabal
+++ b/goldplate.cabal
@@ -76,4 +76,4 @@ Test-suite tests
   Main-is:            Tests.hs
   Build-tool-depends: goldplate:goldplate
   Hs-source-dirs:     tests
-  Build-depends:      base, process
+  Build-depends:      aeson, base, bytestring, goldplate, process
diff --git a/src/Goldplate.hs b/src/Goldplate.hs
index bb0ae51..6b36484 100644
--- a/src/Goldplate.hs
+++ b/src/Goldplate.hs
@@ -9,9 +9,12 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module Goldplate
     ( main
+
+    , Spec (..)
+    , Assert (..)
     ) where
 
-import           Control.Applicative       ((<|>))
+import           Control.Applicative       (optional, (<|>))
 import qualified Control.Concurrent.Async  as Async
 import qualified Control.Concurrent.MVar   as MVar
 import           Control.Exception         (finally, throwIO)
@@ -27,6 +30,7 @@ import           Data.Function             (on)
 import qualified Data.HashMap.Strict       as HMS
 import qualified Data.IORef                as IORef
 import qualified Data.List                 as List
+import           Data.Maybe                (catMaybes)
 import qualified Data.Text                 as T
 import qualified Data.Text.Encoding        as T
 import           Data.Version              (showVersion)
@@ -143,22 +147,29 @@ data Assert a
     deriving (Foldable, Functor, Traversable)
 
 instance A.FromJSON a => A.FromJSON (Assert a) where
-    parseJSON = A.withObject "FromJSON Assert" $ \o ->
-        (ExitCodeAssert <$> o A..: "exit_code") <|>
-        (StdoutAssert <$> o A..: "stdout" <*> pp o) <|>
-        (StderrAssert <$> o A..: "stderr" <*> pp o) <|>
-        (CreatedFileAssert
-            <$> o A..: "created_file" <*> o A..:? "contents" <*> pp o) <|>
-        (CreatedDirectoryAssert <$> o A..: "created_directory")
+    parseJSON = A.withObject "FromJSON Assert" $ \o -> do
+        options <- sequenceA $ map optional
+            [ ExitCodeAssert <$> o A..: "exit_code"
+            , StdoutAssert <$> o A..: "stdout" <*> pp o
+            , StderrAssert <$> o A..: "stderr" <*> pp o
+            , CreatedFileAssert
+                <$> o A..: "created_file" <*> o A..:? "contents" <*> pp o
+            , CreatedDirectoryAssert <$> o A..: "created_directory"
+            ]
+        case catMaybes options of
+            [opt] -> pure opt
+            []    -> fail "no assert discriminator"
+            opts  -> fail $ "multiple assert discriminators: " ++
+                List.intercalate ", " (map assertDiscriminator opts)
       where
         pp o = maybe [] multipleToList <$> o A..:? "post_process"
 
-describeAssert :: Assert a -> String
-describeAssert (ExitCodeAssert     _)     = "exit_code"
-describeAssert (StdoutAssert       _ _)   = "stdout"
-describeAssert (StderrAssert       _ _)   = "stderr"
-describeAssert (CreatedFileAssert  _ _ _) = "created_file"
-describeAssert (CreatedDirectoryAssert _) = "created_directory"
+assertDiscriminator :: Assert a -> String
+assertDiscriminator (ExitCodeAssert     _)     = "exit_code"
+assertDiscriminator (StdoutAssert       _ _)   = "stdout"
+assertDiscriminator (StderrAssert       _ _)   = "stderr"
+assertDiscriminator (CreatedFileAssert  _ _ _) = "created_file"
+assertDiscriminator (CreatedDirectoryAssert _) = "created_directory"
 
 --------------------------------------------------------------------------------
 
@@ -379,7 +390,7 @@ runAssert env execution@Execution {..} ExecutionResult {..} assert =
                     pure $ makeAssertResult True []
   where
     makeAssertResult ok = AssertResult ok
-        (executionHeader execution ++ describeAssert assert)
+        (executionHeader execution ++ assertDiscriminator assert)
 
     inExecutionDir :: FilePath -> FilePath
     inExecutionDir fp =
diff --git a/tests/Tests.hs b/tests/Tests.hs
index f8a3e87..bd1d8fe 100644
--- a/tests/Tests.hs
+++ b/tests/Tests.hs
@@ -1,6 +1,23 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Main (main) where
-import           System.Exit    (exitWith)
-import           System.Process (system)
+import qualified Data.Aeson            as A
+import           Data.ByteString.Char8 ()
+import qualified Data.List             as List
+import           Goldplate             (Assert)
+import           System.Exit           (exitWith)
+import           System.Process        (system)
+
+-- See https://github.com/jaspervdj/goldplate/issues/22
+testAssertMultipleDiscriminator :: IO ()
+testAssertMultipleDiscriminator =
+    case A.eitherDecode bytes :: Either String (Assert String) of
+        Left err | "discriminator" `List.isInfixOf` err -> pure ()
+        _ -> fail $
+            "testAssertMultipleDiscriminator: expected discriminator error"
+  where
+    bytes = "{\"exit_code\": 0, \"stdout\": \"stdout.txt\"}"
 
 main :: IO ()
-main = exitWith =<< system ("goldplate tests")
+main = do
+    testAssertMultipleDiscriminator
+    exitWith =<< system ("goldplate tests")