{-# LANGUAGE DataKinds #-}

module Test.Syd.Aeson
  ( -- * Golden tests
    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

-- | Test that the produced 'JSON.Value' is the same as what we find in the given golden file.
--
-- This function shows a diff based on the encoding of the values.
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)
              )
    }

-- | Test that the given 'JSON.Value' is the same as what we find in the given golden file.
--
-- This function shows a diff based on the encoding of the values.
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

-- | Test that the produced 'JSON.Value' is the same as what we find in the given golden file.
--
-- This test also tests that the previously written 'toJSON'-ed version of the given value is still parseable as to same value.
--
-- This function shows a diff based on the pretty 'Show'ing of the values.
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))
    }

-- | Test that the given 'JSON.Value' is the same as what we find in the given golden file.
--
-- This test also tests that the previously written 'toJSON'-ed version of the given value is still parseable as to same value.
--
-- This function shows a diff based on the pretty 'Show'ing of the values.
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