Skip to content

Commit

Permalink
Check discriminators in FromJSON Assert (#36)
Browse files Browse the repository at this point in the history
See #22
  • Loading branch information
jaspervdj authored Aug 4, 2023
1 parent 1091877 commit bb97233
Show file tree
Hide file tree
Showing 3 changed files with 47 additions and 19 deletions.
2 changes: 1 addition & 1 deletion goldplate.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
41 changes: 26 additions & 15 deletions src/Goldplate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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)
Expand Down Expand Up @@ -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"

--------------------------------------------------------------------------------

Expand Down Expand Up @@ -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 =
Expand Down
23 changes: 20 additions & 3 deletions tests/Tests.hs
Original file line number Diff line number Diff line change
@@ -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")

0 comments on commit bb97233

Please sign in to comment.