{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-|
Module      : Data.SafeJSON.Test
Copyright   : (c) 2019 Felix Paulusma
License     : MIT
Maintainer  : felix.paulusma@gmail.com
Stability   : experimental

This module contains some functions to use for testing
'SafeJSON' and 'Migrate' instances.
-}
module Data.SafeJSON.Test (
  -- * Consistency checks
  --
  -- | It is advised to always run 'testConsistency' (or
  --   'testConsistency'') for all your types that have
  --   a 'SafeJSON' instance.
  --
  --   __Note that any type that fails this test will also__
  --   __fail any 'safeFromJSON' parsing!__

  -- ** Using TypeApplications
    testConsistency
  -- ** Using a Proxy argument
  , testConsistency'
  -- * Unit tests
  --
  -- ** Migration tests
  --
  -- | These tests can be used to verify the implemented
  --   'migrate' function acts as expected.
  , testMigration
  , testReverseMigration
  -- *** Synonyms
  , (<=?)
  , (>=?)
  -- ** Round trip tests
  --
  -- | These tests can be used to verify that round trips are
  --   consistent. Either directly ('testRoundTrip'), through
  --   a forward migration ('migrateRoundTrip') or a reversed
  --   backward migration ('migrateReverseRoundTrip').
  , testRoundTrip
  , migrateRoundTrip
  , migrateReverseRoundTrip
  -- * Property tests
  --
  -- | Useful if your types also have 'Arbitrary' instances.

  -- *** Constraint synonyms for readability
  --
  , TestMigrate
  , TestReverseMigrate
  -- ** Using TypeApplications
  , testRoundTripProp
  , migrateRoundTripProp
  , migrateReverseRoundTripProp
  -- ** Using a Proxy argument
  , testRoundTripProp'
  , migrateRoundTripProp'
  , migrateReverseRoundTripProp'
  -- * Re-export for convenience
  , Proxy(..)
  ) where


import Data.Aeson.Types (parseEither)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Data.Proxy
import Data.SafeJSON.Internal
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (Assertion, assertEqual)
import Test.Tasty.QuickCheck (Arbitrary, testProperty)


-- | Useful in test suites. Will fail if anything in the
--   chain of your types is inconsistent.
--
--   === __Example usage:__
--
-- > testConsistency @MyType
testConsistency :: forall a. SafeJSON a => Assertion
testConsistency :: Assertion
testConsistency = Proxy a -> (ProfileVersions -> Assertion) -> Assertion
forall a (m :: * -> *) b.
(SafeJSON a, MonadFail m) =>
Proxy a -> (ProfileVersions -> m b) -> m b
checkConsistency Proxy a
p ((ProfileVersions -> Assertion) -> Assertion)
-> (ProfileVersions -> Assertion) -> Assertion
forall a b. (a -> b) -> a -> b
$ \ProfileVersions
_ -> () -> Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where p :: Proxy a
p = Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a

-- | Useful in test suites. Will fail if anything in the
--   chain of your types is inconsistent.
testConsistency' :: forall a. SafeJSON a => Proxy a -> Assertion
testConsistency' :: Proxy a -> Assertion
testConsistency' = (Proxy a -> (ProfileVersions -> Assertion) -> Assertion)
-> (ProfileVersions -> Assertion) -> Proxy a -> Assertion
forall a b c. (a -> b -> c) -> b -> a -> c
flip Proxy a -> (ProfileVersions -> Assertion) -> Assertion
forall a (m :: * -> *) b.
(SafeJSON a, MonadFail m) =>
Proxy a -> (ProfileVersions -> m b) -> m b
checkConsistency ((ProfileVersions -> Assertion) -> Proxy a -> Assertion)
-> (ProfileVersions -> Assertion) -> Proxy a -> Assertion
forall a b. (a -> b) -> a -> b
$ \ProfileVersions
_ -> () -> Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Tests that the following holds:
--
--   prop> Just a == parseMaybe safeFromJSON (safeToJSON a)
testRoundTrip :: forall a. (Show a, Eq a, SafeJSON a) => a -> Assertion
testRoundTrip :: a -> Assertion
testRoundTrip a
a = (Proxy a -> String
forall a. SafeJSON a => Proxy a -> String
typeName (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": to JSON and back not consistent") String -> Either String a -> Either String a -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
`assertEqual` a -> Either String a
forall a b. b -> Either a b
Right a
a (Either String a -> Assertion) -> Either String a -> Assertion
forall a b. (a -> b) -> a -> b
$
    (a -> Parser a) -> a -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
parseEither (Value -> Parser a
forall a. SafeJSON a => Value -> Parser a
safeFromJSON (Value -> Parser a) -> (a -> Value) -> a -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. SafeJSON a => a -> Value
safeToJSON) a
a

-- | Tests that the following holds __for all @a@__:
--
--   prop> Just a == parseMaybe safeFromJSON (safeToJSON a)
testRoundTripProp' :: forall a. (Eq a, Show a, Arbitrary a, SafeJSON a) => Proxy a -> String -> TestTree
testRoundTripProp' :: Proxy a -> String -> TestTree
testRoundTripProp' Proxy a
_ String
s = String -> (a -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
s ((a -> Bool) -> TestTree) -> (a -> Bool) -> TestTree
forall a b. (a -> b) -> a -> b
$ \a
a ->
    a -> Either String a
forall a b. b -> Either a b
Right (a
a :: a) Either String a -> Either String a -> Bool
forall a. Eq a => a -> a -> Bool
== (a -> Parser a) -> a -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
parseEither (Value -> Parser a
forall a. SafeJSON a => Value -> Parser a
safeFromJSON (Value -> Parser a) -> (a -> Value) -> a -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. SafeJSON a => a -> Value
safeToJSON) a
a

-- | Tests that the following holds for all @a@:
--
--   prop> Just a == parseMaybe safeFromJSON (safeToJSON a)
--
--   === __Example usage:__
--
-- > testRoundTripProp @MyType s
testRoundTripProp :: forall a. (Eq a, Show a, Arbitrary a, SafeJSON a) => String -> TestTree
testRoundTripProp :: String -> TestTree
testRoundTripProp String
s = String -> (a -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
s ((a -> Bool) -> TestTree) -> (a -> Bool) -> TestTree
forall a b. (a -> b) -> a -> b
$ \a
a ->
    a -> Either String a
forall a b. b -> Either a b
Right (a
a :: a) Either String a -> Either String a -> Bool
forall a. Eq a => a -> a -> Bool
== (a -> Parser a) -> a -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
parseEither (Value -> Parser a
forall a. SafeJSON a => Value -> Parser a
safeFromJSON (Value -> Parser a) -> (a -> Value) -> a -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. SafeJSON a => a -> Value
safeToJSON) a
a

-- | Migration test. Mostly useful as regression test.
--
--   First argument is the older type which should turn into
--   the second argument after migrating using 'migrate'.
--
--   prop> Just (migrate a) == parseMaybe safeFromJSON (safeToJSON a)
testMigration :: (Show a, Eq a, Migrate a) => MigrateFrom a -> a -> Assertion
testMigration :: MigrateFrom a -> a -> Assertion
testMigration = String -> a -> a -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"Unexpected result of SafeJSON migration" (a -> a -> Assertion)
-> (MigrateFrom a -> a) -> MigrateFrom a -> a -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MigrateFrom a -> a
forall a. Migrate a => MigrateFrom a -> a
migrate

-- | Similar to 'testMigration', but using @Migrate (Reverse a)@.
--
--   The first argument here is the newer type, which will be migrated back
--   to the expected second argument (older type).
--
--   prop> Just (unReverse $ migrate a) == parseMaybe safeFromJSON (safeToJSON a)
testReverseMigration :: (Show a, Eq a, Migrate (Reverse a)) => MigrateFrom (Reverse a) -> a -> Assertion
testReverseMigration :: MigrateFrom (Reverse a) -> a -> Assertion
testReverseMigration = String -> a -> a -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"Unexpected result of SafeJSON migration" (a -> a -> Assertion)
-> (MigrateFrom (Reverse a) -> a)
-> MigrateFrom (Reverse a)
-> a
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reverse a -> a
forall a. Reverse a -> a
unReverse (Reverse a -> a)
-> (MigrateFrom (Reverse a) -> Reverse a)
-> MigrateFrom (Reverse a)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MigrateFrom (Reverse a) -> Reverse a
forall a. Migrate a => MigrateFrom a -> a
migrate

infix 1 >=?, <=?
-- | Operator synonymous with 'testMigration'
(<=?) :: (Show a, Eq a, Migrate a) => MigrateFrom a -> a -> Assertion
<=? :: MigrateFrom a -> a -> Assertion
(<=?) = MigrateFrom a -> a -> Assertion
forall a.
(Show a, Eq a, Migrate a) =>
MigrateFrom a -> a -> Assertion
testMigration

-- | Operator synonymous with 'testReverseMigration'
(>=?) :: (Show a, Eq a, Migrate (Reverse a)) => MigrateFrom (Reverse a) -> a -> Assertion
>=? :: MigrateFrom (Reverse a) -> a -> Assertion
(>=?) = MigrateFrom (Reverse a) -> a -> Assertion
forall a.
(Show a, Eq a, Migrate (Reverse a)) =>
MigrateFrom (Reverse a) -> a -> Assertion
testReverseMigration

-- | This test verifies that direct migration, and migration
--   through encoding and decoding to the newer type, is equivalent.
migrateRoundTrip :: forall a. (Eq a, Show a, SafeJSON a, Migrate a) => MigrateFrom a -> Assertion
migrateRoundTrip :: MigrateFrom a -> Assertion
migrateRoundTrip MigrateFrom a
oldType = String
"Unexpected result of decoding encoded older type" String -> Either String a -> Either String a -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
`assertEqual` a -> Either String a
forall a b. b -> Either a b
Right (MigrateFrom a -> a
forall a. Migrate a => MigrateFrom a -> a
migrate MigrateFrom a
oldType :: a) (Either String a -> Assertion) -> Either String a -> Assertion
forall a b. (a -> b) -> a -> b
$
    (MigrateFrom a -> Parser a) -> MigrateFrom a -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
parseEither (Value -> Parser a
forall a. SafeJSON a => Value -> Parser a
safeFromJSON (Value -> Parser a)
-> (MigrateFrom a -> Value) -> MigrateFrom a -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MigrateFrom a -> Value
forall a. SafeJSON a => a -> Value
safeToJSON) MigrateFrom a
oldType

-- | Similar to 'migrateRoundTrip', but tests the migration from a newer type
--   to the older type, in case of a @'Migrate' ('Reverse' a)@ instance
migrateReverseRoundTrip :: forall a. (Eq a, Show a, SafeJSON a, Migrate (Reverse a)) => MigrateFrom (Reverse a) -> Assertion
migrateReverseRoundTrip :: MigrateFrom (Reverse a) -> Assertion
migrateReverseRoundTrip MigrateFrom (Reverse a)
newType = String
"Unexpected result of decoding encoded newer type" String -> Either String a -> Either String a -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
`assertEqual` a -> Either String a
forall a b. b -> Either a b
Right (Reverse a -> a
forall a. Reverse a -> a
unReverse (Reverse a -> a) -> Reverse a -> a
forall a b. (a -> b) -> a -> b
$ MigrateFrom (Reverse a) -> Reverse a
forall a. Migrate a => MigrateFrom a -> a
migrate MigrateFrom (Reverse a)
newType :: a) (Either String a -> Assertion) -> Either String a -> Assertion
forall a b. (a -> b) -> a -> b
$
    (MigrateFrom (Reverse a) -> Parser a)
-> MigrateFrom (Reverse a) -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
parseEither (Value -> Parser a
forall a. SafeJSON a => Value -> Parser a
safeFromJSON (Value -> Parser a)
-> (MigrateFrom (Reverse a) -> Value)
-> MigrateFrom (Reverse a)
-> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MigrateFrom (Reverse a) -> Value
forall a. SafeJSON a => a -> Value
safeToJSON) MigrateFrom (Reverse a)
newType

-- | Constraints for migrating from a previous version
type TestMigrate a b =
    ( Eq a
    , Show b
    , Arbitrary b
    , SafeJSON a
    , Migrate a
    , MigrateFrom a ~ b
    )

-- | This test verifies that direct migration, and migration
--   through encoding and decoding to the newer type, is equivalent
--   __for all @a@__.
--
--   prop> Just (migrate a) == parseMaybe safeFromJSON (safeToJSON a)
migrateRoundTripProp' :: forall a b. TestMigrate a b => Proxy (a,b) -> String -> TestTree
migrateRoundTripProp' :: Proxy (a, b) -> String -> TestTree
migrateRoundTripProp' Proxy (a, b)
_ String
s = String -> (b -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
s ((b -> Bool) -> TestTree) -> (b -> Bool) -> TestTree
forall a b. (a -> b) -> a -> b
$ \b
a ->
    a -> Either String a
forall a b. b -> Either a b
Right (MigrateFrom a -> a
forall a. Migrate a => MigrateFrom a -> a
migrate b
MigrateFrom a
a :: a) Either String a -> Either String a -> Bool
forall a. Eq a => a -> a -> Bool
== (b -> Parser a) -> b -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
parseEither (Value -> Parser a
forall a. SafeJSON a => Value -> Parser a
safeFromJSON (Value -> Parser a) -> (b -> Value) -> b -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Value
forall a. SafeJSON a => a -> Value
safeToJSON) b
a

-- | This test verifies that direct migration, and migration
--   through encoding and decoding to the newer type, is equivalent
--   __for all @a@__.
--
--   prop> Just (migrate a) == parseMaybe safeFromJSON (safeToJSON a)
--
--   === __Example usage:__
--
-- > migrateRoundTripProp @NewType @OldType s
migrateRoundTripProp :: forall a b. TestMigrate a b => String -> TestTree
migrateRoundTripProp :: String -> TestTree
migrateRoundTripProp String
s = String -> (b -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
s ((b -> Bool) -> TestTree) -> (b -> Bool) -> TestTree
forall a b. (a -> b) -> a -> b
$ \b
a ->
    a -> Either String a
forall a b. b -> Either a b
Right (MigrateFrom a -> a
forall a. Migrate a => MigrateFrom a -> a
migrate b
MigrateFrom a
a :: a) Either String a -> Either String a -> Bool
forall a. Eq a => a -> a -> Bool
== (b -> Parser a) -> b -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
parseEither (Value -> Parser a
forall a. SafeJSON a => Value -> Parser a
safeFromJSON (Value -> Parser a) -> (b -> Value) -> b -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Value
forall a. SafeJSON a => a -> Value
safeToJSON) b
a

-- | Constraints for migrating from a future version
type TestReverseMigrate a b =
    ( Eq a
    , Show b
    , Arbitrary b
    , SafeJSON a
    , Migrate (Reverse a)
    , MigrateFrom (Reverse a) ~ b
    )

-- | Similar to 'migrateRoundTripProp', but tests the migration from a newer type
--   to the older type, in case of a @'Migrate' ('Reverse' a)@ instance.
--
--   prop> Just (unReverse $ migrate a) == parseMaybe safeFromJSON (safeToJSON a)
migrateReverseRoundTripProp' :: forall a b. TestReverseMigrate a b => Proxy (a,b) -> String -> TestTree
migrateReverseRoundTripProp' :: Proxy (a, b) -> String -> TestTree
migrateReverseRoundTripProp' Proxy (a, b)
_ String
s = String -> (b -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
s ((b -> Bool) -> TestTree) -> (b -> Bool) -> TestTree
forall a b. (a -> b) -> a -> b
$ \b
a ->
    a -> Either String a
forall a b. b -> Either a b
Right (Reverse a -> a
forall a. Reverse a -> a
unReverse (Reverse a -> a) -> Reverse a -> a
forall a b. (a -> b) -> a -> b
$ MigrateFrom (Reverse a) -> Reverse a
forall a. Migrate a => MigrateFrom a -> a
migrate b
MigrateFrom (Reverse a)
a :: a) Either String a -> Either String a -> Bool
forall a. Eq a => a -> a -> Bool
== (b -> Parser a) -> b -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
parseEither (Value -> Parser a
forall a. SafeJSON a => Value -> Parser a
safeFromJSON (Value -> Parser a) -> (b -> Value) -> b -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Value
forall a. SafeJSON a => a -> Value
safeToJSON) b
a

-- | Similar to 'migrateRoundTripProp', but tests the migration from a newer type
--   to the older type, in case of a @'Migrate' ('Reverse' a)@ instance.
--
--   prop> Just (unReverse $ migrate a) == parseMaybe safeFromJSON (safeToJSON a)
--
--   === __Example usage:__
--
--   /Please also note the reversing of the type applications./
--
-- > migrateReverseRoundTripProp @OldType @NewType s
migrateReverseRoundTripProp :: forall a b. TestReverseMigrate a b => String -> TestTree
migrateReverseRoundTripProp :: String -> TestTree
migrateReverseRoundTripProp String
s = String -> (b -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
s ((b -> Bool) -> TestTree) -> (b -> Bool) -> TestTree
forall a b. (a -> b) -> a -> b
$ \b
a ->
    a -> Either String a
forall a b. b -> Either a b
Right (Reverse a -> a
forall a. Reverse a -> a
unReverse (Reverse a -> a) -> Reverse a -> a
forall a b. (a -> b) -> a -> b
$ MigrateFrom (Reverse a) -> Reverse a
forall a. Migrate a => MigrateFrom a -> a
migrate b
MigrateFrom (Reverse a)
a :: a) Either String a -> Either String a -> Bool
forall a. Eq a => a -> a -> Bool
== (b -> Parser a) -> b -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
parseEither (Value -> Parser a
forall a. SafeJSON a => Value -> Parser a
safeFromJSON (Value -> Parser a) -> (b -> Value) -> b -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Value
forall a. SafeJSON a => a -> Value
safeToJSON) b
a