{-# LANGUAGE DataKinds #-}
module Test.Syd.Aeson
(
goldenJSONFile,
pureGoldenJSONFile,
goldenJSONValueFile,
pureGoldenJSONValueFile,
)
where
import Control.DeepSeq
import Control.Exception
import Control.Monad
import Data.Aeson as JSON
import Data.Aeson.Encode.Pretty as JSON
import qualified Data.ByteString as SB
import qualified Data.ByteString.Lazy as LB
import Data.Text.Encoding as TE
import Path
import Path.IO
import Test.Syd
goldenJSONFile :: FilePath -> IO JSON.Value -> GoldenTest JSON.Value
goldenJSONFile :: FilePath -> IO Value -> GoldenTest Value
goldenJSONFile FilePath
fp IO Value
produceActualValue =
GoldenTest :: forall a.
IO (Maybe a)
-> IO a
-> (a -> IO ())
-> (a -> a -> Maybe Assertion)
-> GoldenTest a
GoldenTest
{ goldenTestRead :: IO (Maybe Value)
goldenTestRead = do
Path Abs File
p <- FilePath -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
resolveFile' FilePath
fp
Maybe ByteString
mContents <- IO ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (IO ByteString -> IO (Maybe ByteString))
-> IO ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
SB.readFile (Path Abs File -> FilePath
fromAbsFile Path Abs File
p)
Maybe ByteString -> (ByteString -> IO Value) -> IO (Maybe Value)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe ByteString
mContents ((ByteString -> IO Value) -> IO (Maybe Value))
-> (ByteString -> IO Value) -> IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ \ByteString
contents ->
case ByteString -> Either FilePath Value
forall a. FromJSON a => ByteString -> Either FilePath a
JSON.eitherDecode (ByteString -> ByteString
LB.fromStrict ByteString
contents) of
Left FilePath
err -> FilePath -> IO Value
forall a. HasCallStack => FilePath -> IO a
expectationFailure FilePath
err
Right Value
r -> Value -> IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
r,
goldenTestProduce :: IO Value
goldenTestProduce = IO Value
produceActualValue,
goldenTestWrite :: Value -> IO ()
goldenTestWrite = \Value
v -> do
Value
value <- Value -> IO Value
forall a. a -> IO a
evaluate (Value -> IO Value) -> Value -> IO Value
forall a b. (a -> b) -> a -> b
$ Value -> Value
forall a. NFData a => a -> a
force (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ Value -> Value
forall a. ToJSON a => a -> Value
toJSON Value
v
Path Abs File
p <- FilePath -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
resolveFile' FilePath
fp
Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
p)
FilePath -> ByteString -> IO ()
SB.writeFile (Path Abs File -> FilePath
fromAbsFile Path Abs File
p) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LB.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encodePretty Value
value,
goldenTestCompare :: Value -> Value -> Maybe Assertion
goldenTestCompare = \Value
actual Value
expected ->
if Value
actual Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
expected
then Maybe Assertion
forall a. Maybe a
Nothing
else
Assertion -> Maybe Assertion
forall a. a -> Maybe a
Just
( Assertion -> FilePath -> Assertion
Context
( Text -> Text -> Assertion
textsNotEqualButShouldHaveBeenEqual
(ByteString -> Text
TE.decodeUtf8 (ByteString -> ByteString
LB.toStrict (Value -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encodePretty Value
actual)))
(ByteString -> Text
TE.decodeUtf8 (ByteString -> ByteString
LB.toStrict (Value -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encodePretty Value
expected)))
)
(FilePath -> FilePath
goldenContext FilePath
fp)
)
}
pureGoldenJSONFile :: FilePath -> JSON.Value -> GoldenTest JSON.Value
pureGoldenJSONFile :: FilePath -> Value -> GoldenTest Value
pureGoldenJSONFile FilePath
fp Value
actualValue = FilePath -> IO Value -> GoldenTest Value
goldenJSONFile FilePath
fp (IO Value -> GoldenTest Value) -> IO Value -> GoldenTest Value
forall a b. (a -> b) -> a -> b
$ Value -> IO Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
actualValue
goldenJSONValueFile :: (Show a, Eq a, FromJSON a, ToJSON a) => FilePath -> IO a -> GoldenTest a
goldenJSONValueFile :: FilePath -> IO a -> GoldenTest a
goldenJSONValueFile FilePath
fp IO a
produceActualValue =
GoldenTest :: forall a.
IO (Maybe a)
-> IO a
-> (a -> IO ())
-> (a -> a -> Maybe Assertion)
-> GoldenTest a
GoldenTest
{ goldenTestRead :: IO (Maybe a)
goldenTestRead = do
Path Abs File
p <- FilePath -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
resolveFile' FilePath
fp
Maybe ByteString
mContents <- IO ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (IO ByteString -> IO (Maybe ByteString))
-> IO ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
SB.readFile (Path Abs File -> FilePath
fromAbsFile Path Abs File
p)
Maybe ByteString -> (ByteString -> IO a) -> IO (Maybe a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe ByteString
mContents ((ByteString -> IO a) -> IO (Maybe a))
-> (ByteString -> IO a) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ \ByteString
contents ->
case ByteString -> Either FilePath a
forall a. FromJSON a => ByteString -> Either FilePath a
JSON.eitherDecode (ByteString -> ByteString
LB.fromStrict ByteString
contents) of
Left FilePath
err -> FilePath -> IO a
forall a. HasCallStack => FilePath -> IO a
expectationFailure FilePath
err
Right a
r -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r,
goldenTestProduce :: IO a
goldenTestProduce = IO a
produceActualValue,
goldenTestWrite :: a -> IO ()
goldenTestWrite = \a
v -> do
Value
value <- Value -> IO Value
forall a. a -> IO a
evaluate (Value -> IO Value) -> Value -> IO Value
forall a b. (a -> b) -> a -> b
$ Value -> Value
forall a. NFData a => a -> a
force (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJSON a => a -> Value
toJSON a
v
Path Abs File
p <- FilePath -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
resolveFile' FilePath
fp
Path Abs Dir -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
p)
FilePath -> ByteString -> IO ()
SB.writeFile (Path Abs File -> FilePath
fromAbsFile Path Abs File
p) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LB.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encodePretty Value
value,
goldenTestCompare :: a -> a -> Maybe Assertion
goldenTestCompare = \a
actual a
expected ->
if a
actual a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
expected
then Maybe Assertion
forall a. Maybe a
Nothing
else Assertion -> Maybe Assertion
forall a. a -> Maybe a
Just (Assertion -> FilePath -> Assertion
Context (FilePath -> FilePath -> Assertion
stringsNotEqualButShouldHaveBeenEqual (a -> FilePath
forall a. Show a => a -> FilePath
ppShow a
actual) (a -> FilePath
forall a. Show a => a -> FilePath
ppShow a
expected)) (FilePath -> FilePath
goldenContext FilePath
fp))
}
pureGoldenJSONValueFile :: (Show a, Eq a, FromJSON a, ToJSON a) => FilePath -> a -> GoldenTest a
pureGoldenJSONValueFile :: FilePath -> a -> GoldenTest a
pureGoldenJSONValueFile FilePath
fp a
actualValue = FilePath -> IO a -> GoldenTest a
forall a.
(Show a, Eq a, FromJSON a, ToJSON a) =>
FilePath -> IO a -> GoldenTest a
goldenJSONValueFile FilePath
fp (IO a -> GoldenTest a) -> IO a -> GoldenTest a
forall a b. (a -> b) -> a -> b
$ a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
actualValue