{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Haskoin.Test.Util
-- Copyright   : No rights reserved
-- License     : MIT
-- Maintainer  : jprupp@protonmail.ch
-- Stability   : experimental
-- Portability : POSIX
module Haskoin.Util.Arbitrary.Util
  ( arbitraryBS,
    arbitraryBS1,
    arbitraryBSn,
    arbitraryBSS,
    arbitraryBSS1,
    arbitraryBSSn,
    arbitraryMaybe,
    arbitraryNetwork,
    arbitraryUTCTime,
    ReadBox (..),
    JsonBox (..),
    MarshalJsonBox (..),
    SerialBox (..),
    MarshalBox (..),
    IdentityTests (..),
    testIdentity,
    testSerial,
    testRead,
    testJson,
  )
where

import Control.Monad (forM_, (<=<))
import qualified Data.Aeson as A
import qualified Data.Aeson.Encoding as A
import qualified Data.Aeson.Types as A
import Data.ByteString (ByteString, pack)
import Data.ByteString.Lazy (fromStrict, toStrict)
import qualified Data.ByteString.Short as BSS
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Default
import qualified Data.Map.Strict as Map
import Data.Proxy
import Data.Time.Clock (UTCTime (..))
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import qualified Data.Typeable as T
import Data.Word (Word32)
import Haskoin.Crypto (Ctx)
import Haskoin.Network.Constants
import Haskoin.Network.Data
import Haskoin.Util
import Test.Hspec (Spec, describe, shouldBe, shouldSatisfy)
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck

-- | Arbitrary strict 'ByteString'.
arbitraryBS :: Gen ByteString
arbitraryBS :: Gen ByteString
arbitraryBS = [Word8] -> ByteString
pack ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Word8]
forall a. Arbitrary a => Gen a
arbitrary

-- | Arbitrary non-empty strict 'ByteString'
arbitraryBS1 :: Gen ByteString
arbitraryBS1 :: Gen ByteString
arbitraryBS1 = [Word8] -> ByteString
pack ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word8 -> Gen [Word8]
forall a. Gen a -> Gen [a]
listOf1 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

-- | Arbitrary strict 'ByteString' of a given length
arbitraryBSn :: Int -> Gen ByteString
arbitraryBSn :: Int -> Gen ByteString
arbitraryBSn Int
n = [Word8] -> ByteString
pack ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

-- | Arbitrary 'ShortByteString'.
arbitraryBSS :: Gen BSS.ShortByteString
arbitraryBSS :: Gen ShortByteString
arbitraryBSS = [Word8] -> ShortByteString
BSS.pack ([Word8] -> ShortByteString) -> Gen [Word8] -> Gen ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Word8]
forall a. Arbitrary a => Gen a
arbitrary

-- | Arbitrary non-empty 'ShortByteString'
arbitraryBSS1 :: Gen BSS.ShortByteString
arbitraryBSS1 :: Gen ShortByteString
arbitraryBSS1 = [Word8] -> ShortByteString
BSS.pack ([Word8] -> ShortByteString) -> Gen [Word8] -> Gen ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word8 -> Gen [Word8]
forall a. Gen a -> Gen [a]
listOf1 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

-- | Arbitrary 'ShortByteString' of a given length
arbitraryBSSn :: Int -> Gen BSS.ShortByteString
arbitraryBSSn :: Int -> Gen ShortByteString
arbitraryBSSn Int
n = [Word8] -> ShortByteString
BSS.pack ([Word8] -> ShortByteString) -> Gen [Word8] -> Gen ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

-- | Arbitrary UTCTime that generates dates after 01 Jan 1970 01:00:00 CET
arbitraryUTCTime :: Gen UTCTime
arbitraryUTCTime :: Gen UTCTime
arbitraryUTCTime = do
  Word32
w <- Gen Word32
forall a. Arbitrary a => Gen a
arbitrary :: Gen Word32
  UTCTime -> Gen UTCTime
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> Gen UTCTime) -> UTCTime -> Gen UTCTime
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> POSIXTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Word32 -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Word32
w

-- | Generate a Maybe from a Gen a
arbitraryMaybe :: Gen a -> Gen (Maybe a)
arbitraryMaybe :: forall a. Gen a -> Gen (Maybe a)
arbitraryMaybe Gen a
g =
  [(Int, Gen (Maybe a))] -> Gen (Maybe a)
forall a. [(Int, Gen a)] -> Gen a
frequency
    [ (Int
1, Maybe a -> Gen (Maybe a)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing),
      (Int
5, a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Gen a -> Gen (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
g)
    ]

-- | Generate an Network
arbitraryNetwork :: Gen Network
arbitraryNetwork :: Gen Network
arbitraryNetwork = [Network] -> Gen Network
forall a. [a] -> Gen a
elements [Network]
allNets

-- Helpers for creating Serial and JSON Identity tests

instance Show Ctx where
  show :: Ctx -> String
show Ctx
_ = String
"Ctx"

data ReadBox
  = forall a.
    (Read a, Show a, Eq a, T.Typeable a) =>
    ReadBox (Gen a)

data JsonBox
  = forall a.
    (Show a, Eq a, T.Typeable a, A.ToJSON a, A.FromJSON a) =>
    JsonBox (Gen a)

data MarshalJsonBox
  = forall s a.
    (Show a, Show s, Eq a, T.Typeable a, MarshalJSON s a) =>
    MarshalJsonBox (Gen (s, a))

data SerialBox
  = forall a.
    (Show a, Eq a, T.Typeable a, Serial a) =>
    SerialBox (Gen a)

data MarshalBox
  = forall s a.
    (Show a, Show s, Eq a, T.Typeable a, Marshal s a) =>
    MarshalBox (Gen (s, a))

data IdentityTests = IdentityTests
  { IdentityTests -> [ReadBox]
readTests :: [ReadBox],
    IdentityTests -> [JsonBox]
jsonTests :: [JsonBox],
    IdentityTests -> [MarshalJsonBox]
marshalJsonTests :: [MarshalJsonBox],
    IdentityTests -> [SerialBox]
serialTests :: [SerialBox],
    IdentityTests -> [MarshalBox]
marshalTests :: [MarshalBox]
  }

instance Default IdentityTests where
  def :: IdentityTests
def =
    IdentityTests
      { readTests :: [ReadBox]
readTests = [],
        jsonTests :: [JsonBox]
jsonTests = [],
        marshalJsonTests :: [MarshalJsonBox]
marshalJsonTests = [],
        serialTests :: [SerialBox]
serialTests = [],
        marshalTests :: [MarshalBox]
marshalTests = []
      }

testIdentity :: IdentityTests -> Spec
testIdentity :: IdentityTests -> Spec
testIdentity IdentityTests
t = do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Read/Show Encoding" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
    [ReadBox] -> (ReadBox -> Spec) -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ IdentityTests
t.readTests ((ReadBox -> Spec) -> Spec) -> (ReadBox -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$
      \(ReadBox Gen a
g) -> Gen a -> Spec
forall a. (Eq a, Read a, Show a, Typeable a) => Gen a -> Spec
testRead Gen a
g
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Data.Aeson Encoding" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
    [JsonBox] -> (JsonBox -> Spec) -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ IdentityTests
t.jsonTests ((JsonBox -> Spec) -> Spec) -> (JsonBox -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$
      \(JsonBox Gen a
g) -> Gen a -> Spec
forall a.
(Eq a, Show a, Typeable a, ToJSON a, FromJSON a) =>
Gen a -> Spec
testJson Gen a
g
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"MarshalJSON Encoding" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
    [MarshalJsonBox] -> (MarshalJsonBox -> Spec) -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ IdentityTests
t.marshalJsonTests ((MarshalJsonBox -> Spec) -> Spec)
-> (MarshalJsonBox -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$
      \(MarshalJsonBox Gen (s, a)
g) -> Gen (s, a) -> Spec
forall a s.
(Eq a, Show a, Show s, Typeable a, MarshalJSON s a) =>
Gen (s, a) -> Spec
testMarshalJson Gen (s, a)
g
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Binary Encoding" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
    [SerialBox] -> (SerialBox -> Spec) -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ IdentityTests
t.serialTests ((SerialBox -> Spec) -> Spec) -> (SerialBox -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$
      \(SerialBox Gen a
g) -> Gen a -> Spec
forall a. (Eq a, Show a, Typeable a, Serial a) => Gen a -> Spec
testSerial Gen a
g
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Marshal Encoding" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
    [MarshalBox] -> (MarshalBox -> Spec) -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ IdentityTests
t.marshalTests ((MarshalBox -> Spec) -> Spec) -> (MarshalBox -> Spec) -> Spec
forall a b. (a -> b) -> a -> b
$
      \(MarshalBox Gen (s, a)
g) -> Gen (s, a) -> Spec
forall a s.
(Eq a, Show a, Show s, Typeable a, Marshal s a) =>
Gen (s, a) -> Spec
testMarshal Gen (s, a)
g

-- | Generate Read/Show identity tests
testRead ::
  (Eq a, Read a, Show a, T.Typeable a) => Gen a -> Spec
testRead :: forall a. (Eq a, Read a, Show a, Typeable a) => Gen a -> Spec
testRead Gen a
gen =
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (String
"read/show identity for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
name) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen a -> (a -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
gen ((a -> Expectation) -> Property) -> (a -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$
      \a
x -> (String -> a
forall a. Read a => String -> a
read (String -> a) -> (a -> String) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show) a
x a -> a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a
x
  where
    name :: String
name = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
T.typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ Gen a -> Proxy a
forall a. Gen a -> Proxy a
proxy Gen a
gen
    proxy :: Gen a -> Proxy a
    proxy :: forall a. Gen a -> Proxy a
proxy = Proxy a -> Gen a -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall {k} (t :: k). Proxy t
Proxy

-- | Generate binary identity tests
testSerial ::
  (Eq a, Show a, T.Typeable a, Serial a) => Gen a -> Spec
testSerial :: forall a. (Eq a, Show a, Typeable a, Serial a) => Gen a -> Spec
testSerial Gen a
gen =
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (String
"Binary encoding/decoding identity for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
name) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen a -> (a -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
gen ((a -> Expectation) -> Property) -> (a -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \a
x -> do
      (Get a -> ByteString -> a
forall a. Get a -> ByteString -> a
runGetL Get a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m a
deserialize (ByteString -> a) -> (a -> ByteString) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => a -> m ()
serialize) a
x a -> a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a
x
      (Get a -> ByteString -> a
forall a. Get a -> ByteString -> a
runGetL Get a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m a
deserialize (ByteString -> a) -> (a -> ByteString) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => a -> m ()
serialize) a
x a -> a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a
x
      (Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
runGetS Get a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m a
deserialize (ByteString -> Either String a)
-> (a -> ByteString) -> a -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => a -> m ()
serialize) a
x Either String a -> Either String a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a -> Either String a
forall a b. b -> Either a b
Right a
x
      (Get a -> ByteString -> Either String a
forall a. Get a -> ByteString -> Either String a
runGetS Get a
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m a
deserialize (ByteString -> Either String a)
-> (a -> ByteString) -> a -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutL (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => a -> m ()
serialize) a
x Either String a -> Either String a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a -> Either String a
forall a b. b -> Either a b
Right a
x
  where
    name :: String
name = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
T.typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ Gen a -> Proxy a
forall a. Gen a -> Proxy a
proxy Gen a
gen
    proxy :: Gen a -> Proxy a
    proxy :: forall a. Gen a -> Proxy a
proxy = Proxy a -> Gen a -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall {k} (t :: k). Proxy t
Proxy

-- | Generate Marshal identity tests
testMarshal ::
  (Eq a, Show a, Show s, T.Typeable a, Marshal s a) =>
  Gen (s, a) ->
  Spec
testMarshal :: forall a s.
(Eq a, Show a, Show s, Typeable a, Marshal s a) =>
Gen (s, a) -> Spec
testMarshal Gen (s, a)
gen = do
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (String
"Marshal marshalPut/marshalGet identity for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
name) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen (s, a) -> ((s, a) -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (s, a)
gen (((s, a) -> Expectation) -> Property)
-> ((s, a) -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \(s
s, a
a) -> do
      (s -> ByteString -> Either String a
forall s a. Marshal s a => s -> ByteString -> Either String a
unmarshal s
s (ByteString -> Either String a)
-> (a -> ByteString) -> a -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> a -> ByteString
forall s a. Marshal s a => s -> a -> ByteString
marshal s
s) a
a Either String a -> Either String a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a -> Either String a
forall a b. b -> Either a b
Right a
a
      (s -> ByteString -> a
forall s a. Marshal s a => s -> ByteString -> a
unmarshalLazy s
s (ByteString -> a) -> (a -> ByteString) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> a -> ByteString
forall s a. Marshal s a => s -> a -> ByteString
marshalLazy s
s) a
a a -> a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a
a
  where
    name :: String
name = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
T.typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ Gen (s, a) -> Proxy a
forall s a. Gen (s, a) -> Proxy a
proxy Gen (s, a)
gen
    proxy :: Gen (s, a) -> Proxy a
    proxy :: forall s a. Gen (s, a) -> Proxy a
proxy = Proxy a -> Gen (s, a) -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall {k} (t :: k). Proxy t
Proxy

-- | Generate Data.Aeson identity tests
testJson ::
  (Eq a, Show a, T.Typeable a, A.ToJSON a, A.FromJSON a) => Gen a -> Spec
testJson :: forall a.
(Eq a, Show a, Typeable a, ToJSON a, FromJSON a) =>
Gen a -> Spec
testJson Gen a
gen = do
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (String
"Data.Aeson toJSON/fromJSON identity for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
name) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen a -> (a -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
gen (a -> (a -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` a -> Bool
forall {a}. (Eq a, FromJSON a, ToJSON a) => a -> Bool
jsonID)
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (String
"Data.Aeson toEncoding/fromJSON identity for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
name) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen a -> (a -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
gen (a -> (a -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` a -> Bool
forall {a}. (Eq a, FromJSON a, ToJSON a) => a -> Bool
encodingID)
  where
    name :: String
name = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
T.typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ Gen a -> Proxy a
forall a. Gen a -> Proxy a
proxy Gen a
gen
    proxy :: Gen a -> Proxy a
    proxy :: forall a. Gen a -> Proxy a
proxy = Proxy a -> Gen a -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall {k} (t :: k). Proxy t
Proxy
    jsonID :: a -> Bool
jsonID a
x = (Value -> Result (Map String a)
forall a. FromJSON a => Value -> Result a
A.fromJSON (Value -> Result (Map String a))
-> (Map String a -> Value) -> Map String a -> Result (Map String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String a -> Value
forall a. ToJSON a => a -> Value
A.toJSON) (a -> Map String a
forall a. a -> Map String a
toMap a
x) Result (Map String a) -> Result (Map String a) -> Bool
forall a. Eq a => a -> a -> Bool
== Map String a -> Result (Map String a)
forall a. a -> Result a
A.Success (a -> Map String a
forall a. a -> Map String a
toMap a
x)
    encodingID :: a -> Bool
encodingID a
x =
      (ByteString -> Maybe (Map String a)
forall a. FromJSON a => ByteString -> Maybe a
A.decode (ByteString -> Maybe (Map String a))
-> (Map String a -> ByteString)
-> Map String a
-> Maybe (Map String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding' Value -> ByteString
forall a. Encoding' a -> ByteString
A.encodingToLazyByteString (Encoding' Value -> ByteString)
-> (Map String a -> Encoding' Value) -> Map String a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String a -> Encoding' Value
forall a. ToJSON a => a -> Encoding' Value
A.toEncoding) (a -> Map String a
forall a. a -> Map String a
toMap a
x)
        Maybe (Map String a) -> Maybe (Map String a) -> Bool
forall a. Eq a => a -> a -> Bool
== Map String a -> Maybe (Map String a)
forall a. a -> Maybe a
Just (a -> Map String a
forall a. a -> Map String a
toMap a
x)

-- | Generate MarshalJSON identity tests
testMarshalJson ::
  (Eq a, Show a, Show s, T.Typeable a, MarshalJSON s a) =>
  Gen (s, a) ->
  Spec
testMarshalJson :: forall a s.
(Eq a, Show a, Show s, Typeable a, MarshalJSON s a) =>
Gen (s, a) -> Spec
testMarshalJson Gen (s, a)
gen = do
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (String
"MarshalJSON marshalValue/unmarshalValue identity for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
name) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen (s, a) -> ((s, a) -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (s, a)
gen (((s, a) -> Expectation) -> Property)
-> ((s, a) -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$
      \(s
s, a
a) -> a
a a -> (a -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` s -> a -> Bool
forall {b} {s}. (Eq b, MarshalJSON s b) => s -> b -> Bool
marshalJsonID s
s
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (String
"MarshalJSON marshalEncoding/unmarshalValue identity for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
name) (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Gen (s, a) -> ((s, a) -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (s, a)
gen (((s, a) -> Expectation) -> Property)
-> ((s, a) -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$
      \(s
s, a
a) -> a
a a -> (a -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` s -> a -> Bool
forall {b} {s}. (Eq b, MarshalJSON s b) => s -> b -> Bool
marshalEncodingID s
s
  where
    name :: String
name = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
T.typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ Gen (s, a) -> Proxy a
forall s a. Gen (s, a) -> Proxy a
proxy Gen (s, a)
gen
    proxy :: Gen (s, a) -> Proxy a
    proxy :: forall s a. Gen (s, a) -> Proxy a
proxy = Proxy a -> Gen (s, a) -> Proxy a
forall a b. a -> b -> a
const Proxy a
forall {k} (t :: k). Proxy t
Proxy
    marshalJsonID :: s -> b -> Bool
marshalJsonID s
s b
a =
      (Value -> Parser b) -> Value -> Maybe b
forall a b. (a -> Parser b) -> a -> Maybe b
A.parseMaybe (s -> Value -> Parser b
forall s a. MarshalJSON s a => s -> Value -> Parser a
unmarshalValue s
s) (s -> b -> Value
forall s a. MarshalJSON s a => s -> a -> Value
marshalValue s
s b
a) Maybe b -> Maybe b -> Bool
forall a. Eq a => a -> a -> Bool
== b -> Maybe b
forall a. a -> Maybe a
Just b
a
    marshalEncodingID :: s -> a -> Bool
marshalEncodingID s
s a
a = s -> ByteString -> Maybe a
forall s a. MarshalJSON s a => s -> ByteString -> Maybe a
unmarshalJSON s
s (s -> a -> ByteString
forall s a. MarshalJSON s a => s -> a -> ByteString
marshalJSON s
s a
a) Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Maybe a
forall a. a -> Maybe a
Just a
a

toMap :: a -> Map.Map String a
toMap :: forall a. a -> Map String a
toMap = String -> a -> Map String a
forall k a. k -> a -> Map k a
Map.singleton String
"object"

toMapE :: A.Encoding -> A.Encoding
toMapE :: Encoding' Value -> Encoding' Value
toMapE = Series -> Encoding' Value
A.pairs (Series -> Encoding' Value)
-> (Encoding' Value -> Series)
-> Encoding' Value
-> Encoding' Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Encoding' Value -> Series
A.pair Key
"object"

fromMap :: Map.Map String a -> a
fromMap :: forall a. Map String a -> a
fromMap = (Map String a -> String -> a
forall k a. Ord k => Map k a -> k -> a
Map.! String
"object")