{-# LANGUAGE ExistentialQuantification #-}
module Test.Tasty.Golden.Extra.GoldenVsToJSON
( GoldenVsToJSON (..),
goldenVsToJson,
)
where
import qualified Data.Aeson as Aeson
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Lazy as BL
import Test.Tasty (TestName, TestTree)
import qualified Test.Tasty.Discover as Discover
import Test.Tasty.Golden.Advanced (goldenTest)
import Test.Tasty.Golden.Extra.Internal (checkJsonDifference, maybeDifference)
data GoldenVsToJSON = forall a. (Aeson.ToJSON a) => GoldenVsToJSON FilePath (IO a)
instance Discover.Tasty GoldenVsToJSON where
tasty :: TastyInfo -> GoldenVsToJSON -> IO TestTree
tasty TastyInfo
info (GoldenVsToJSON FilePath
ref IO a
act) = TestTree -> IO TestTree
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestTree -> IO TestTree) -> TestTree -> IO TestTree
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO a -> TestTree
forall a. ToJSON a => FilePath -> FilePath -> IO a -> TestTree
goldenVsToJson (TastyInfo -> FilePath
Discover.nameOf TastyInfo
info) FilePath
ref IO a
act
goldenVsToJson ::
forall a.
(Aeson.ToJSON a) =>
TestName ->
FilePath ->
IO a ->
TestTree
goldenVsToJson :: forall a. ToJSON a => FilePath -> FilePath -> IO a -> TestTree
goldenVsToJson FilePath
name FilePath
fp IO a
act =
FilePath
-> IO Value
-> IO Value
-> (Value -> Value -> IO (Maybe FilePath))
-> (Value -> IO ())
-> TestTree
forall a.
FilePath
-> IO a
-> IO a
-> (a -> a -> IO (Maybe FilePath))
-> (a -> IO ())
-> TestTree
goldenTest
FilePath
name
(FilePath -> IO (Maybe Value)
forall a. FromJSON a => FilePath -> IO (Maybe a)
Aeson.decodeFileStrict FilePath
fp IO (Maybe Value) -> (Maybe Value -> IO Value) -> IO Value
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Maybe Value -> IO Value
forall a. FilePath -> Maybe a -> IO a
orFailTest (FilePath
"Couldn't decode golden JSON file:" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
fp))
(a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (a -> Value) -> IO a -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
act)
(\Value
a Value
b -> Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> (JsonDifference -> Maybe FilePath)
-> JsonDifference
-> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonDifference -> Maybe FilePath
maybeDifference (JsonDifference -> IO (Maybe FilePath))
-> JsonDifference -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ Value -> Value -> JsonDifference
checkJsonDifference Value
a Value
b)
(FilePath -> ByteString -> IO ()
BL.writeFile FilePath
fp (ByteString -> IO ()) -> (Value -> ByteString) -> Value -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty)
orFailTest :: String -> Maybe a -> IO a
orFailTest :: forall a. FilePath -> Maybe a -> IO a
orFailTest FilePath
msg = IO a -> (a -> IO a) -> Maybe a -> IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO a
forall a. HasCallStack => FilePath -> a
error FilePath
msg) a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure