{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-|
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 :: forall a. SafeJSON a => Assertion
testConsistency = forall a (m :: * -> *) b.
(SafeJSON a, MonadFail m) =>
Proxy a -> (ProfileVersions -> m b) -> m b
checkConsistency Proxy a
p forall a b. (a -> b) -> a -> b
$ \ProfileVersions
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where p :: Proxy a
p = 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' :: forall a. SafeJSON a => Proxy a -> Assertion
testConsistency' = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a (m :: * -> *) b.
(SafeJSON a, MonadFail m) =>
Proxy a -> (ProfileVersions -> m b) -> m b
checkConsistency forall a b. (a -> b) -> a -> b
$ \ProfileVersions
_ -> 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 :: forall a. (Show a, Eq a, SafeJSON a) => a -> Assertion
testRoundTrip a
a = (forall a. SafeJSON a => Proxy a -> String
typeName (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) forall a. Semigroup a => a -> a -> a
<> String
": to JSON and back not consistent") forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
`assertEqual` forall a b. b -> Either a b
Right a
a forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> Parser b) -> a -> Either String b
parseEither (forall a. SafeJSON a => Value -> Parser a
safeFromJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: forall a.
(Eq a, Show a, Arbitrary a, SafeJSON a) =>
Proxy a -> String -> TestTree
testRoundTripProp' Proxy a
_ String
s = forall a. Testable a => String -> a -> TestTree
testProperty String
s forall a b. (a -> b) -> a -> b
$ \a
a ->
    forall a b. b -> Either a b
Right (a
a :: a) forall a. Eq a => a -> a -> Bool
== forall a b. (a -> Parser b) -> a -> Either String b
parseEither (forall a. SafeJSON a => Value -> Parser a
safeFromJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a.
(Eq a, Show a, Arbitrary a, SafeJSON a) =>
String -> TestTree
testRoundTripProp String
s = forall a. Testable a => String -> a -> TestTree
testProperty String
s forall a b. (a -> b) -> a -> b
$ \a
a ->
    forall a b. b -> Either a b
Right (a
a :: a) forall a. Eq a => a -> a -> Bool
== forall a b. (a -> Parser b) -> a -> Either String b
parseEither (forall a. SafeJSON a => Value -> Parser a
safeFromJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a.
(Show a, Eq a, Migrate a) =>
MigrateFrom a -> a -> Assertion
testMigration = forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"Unexpected result of SafeJSON migration" forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a.
(Show a, Eq a, Migrate (Reverse a)) =>
MigrateFrom (Reverse a) -> a -> Assertion
testReverseMigration = forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"Unexpected result of SafeJSON migration" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Reverse a -> a
unReverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Migrate a => MigrateFrom a -> a
migrate

infix 1 >=?, <=?
-- | Operator synonymous with 'testMigration'
(<=?) :: (Show a, Eq a, Migrate a) => MigrateFrom a -> a -> Assertion
<=? :: forall a.
(Show a, Eq a, Migrate a) =>
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
>=? :: forall a.
(Show a, Eq a, Migrate (Reverse a)) =>
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 :: forall a.
(Eq a, Show a, SafeJSON a, Migrate a) =>
MigrateFrom a -> Assertion
migrateRoundTrip MigrateFrom a
oldType = String
"Unexpected result of decoding encoded older type" forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
`assertEqual` forall a b. b -> Either a b
Right (forall a. Migrate a => MigrateFrom a -> a
migrate MigrateFrom a
oldType :: a) forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> Parser b) -> a -> Either String b
parseEither (forall a. SafeJSON a => Value -> Parser a
safeFromJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a.
(Eq a, Show a, SafeJSON a, Migrate (Reverse a)) =>
MigrateFrom (Reverse a) -> Assertion
migrateReverseRoundTrip MigrateFrom (Reverse a)
newType = String
"Unexpected result of decoding encoded newer type" forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
`assertEqual` forall a b. b -> Either a b
Right (forall a. Reverse a -> a
unReverse forall a b. (a -> b) -> a -> b
$ forall a. Migrate a => MigrateFrom a -> a
migrate MigrateFrom (Reverse a)
newType :: a) forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> Parser b) -> a -> Either String b
parseEither (forall a. SafeJSON a => Value -> Parser a
safeFromJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: forall a b. TestMigrate a b => Proxy (a, b) -> String -> TestTree
migrateRoundTripProp' Proxy (a, b)
_ String
s = forall a. Testable a => String -> a -> TestTree
testProperty String
s forall a b. (a -> b) -> a -> b
$ \b
a ->
    forall a b. b -> Either a b
Right (forall a. Migrate a => MigrateFrom a -> a
migrate b
a :: a) forall a. Eq a => a -> a -> Bool
== forall a b. (a -> Parser b) -> a -> Either String b
parseEither (forall a. SafeJSON a => Value -> Parser a
safeFromJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b. TestMigrate a b => String -> TestTree
migrateRoundTripProp String
s = forall a. Testable a => String -> a -> TestTree
testProperty String
s forall a b. (a -> b) -> a -> b
$ \b
a ->
    forall a b. b -> Either a b
Right (forall a. Migrate a => MigrateFrom a -> a
migrate b
a :: a) forall a. Eq a => a -> a -> Bool
== forall a b. (a -> Parser b) -> a -> Either String b
parseEither (forall a. SafeJSON a => Value -> Parser a
safeFromJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: forall a b.
TestReverseMigrate a b =>
Proxy (a, b) -> String -> TestTree
migrateReverseRoundTripProp' Proxy (a, b)
_ String
s = forall a. Testable a => String -> a -> TestTree
testProperty String
s forall a b. (a -> b) -> a -> b
$ \b
a ->
    forall a b. b -> Either a b
Right (forall a. Reverse a -> a
unReverse forall a b. (a -> b) -> a -> b
$ forall a. Migrate a => MigrateFrom a -> a
migrate b
a :: a) forall a. Eq a => a -> a -> Bool
== forall a b. (a -> Parser b) -> a -> Either String b
parseEither (forall a. SafeJSON a => Value -> Parser a
safeFromJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a b. TestReverseMigrate a b => String -> TestTree
migrateReverseRoundTripProp String
s = forall a. Testable a => String -> a -> TestTree
testProperty String
s forall a b. (a -> b) -> a -> b
$ \b
a ->
    forall a b. b -> Either a b
Right (forall a. Reverse a -> a
unReverse forall a b. (a -> b) -> a -> b
$ forall a. Migrate a => MigrateFrom a -> a
migrate b
a :: a) forall a. Eq a => a -> a -> Bool
== forall a b. (a -> Parser b) -> a -> Either String b
parseEither (forall a. SafeJSON a => Value -> Parser a
safeFromJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SafeJSON a => a -> Value
safeToJSON) b
a