Add DerivingVia newtype for generic arbitrary

Add a newtype, GenericArbitrary, which can be used with -XDerivingVia to
derive Arbitrary instances for types with Generic, via patching
generic-arbitrary to expose the underlying typeclass it uses for
surfacing the type information.
This commit is contained in:
Griffin Smith 2019-11-29 22:57:58 -05:00
parent 0abcd8c958
commit 7d8ce026a2
5 changed files with 47 additions and 4 deletions

View file

@ -1,15 +1,21 @@
{-# LANGUAGE UndecidableInstances #-}
module Xanthous.Util.QuickCheck
( FunctionShow(..)
( functionShow
, FunctionShow(..)
, functionJSON
, FunctionJSON(..)
, genericArbitrary
, GenericArbitrary(..)
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude
import Test.QuickCheck
import Test.QuickCheck.Function
import Test.QuickCheck.Instances.ByteString ()
import Test.QuickCheck.Arbitrary.Generic
import Data.Aeson
import Data.Coerce
import GHC.Generics (Rep)
--------------------------------------------------------------------------------
newtype FunctionShow a = FunctionShow a
@ -26,3 +32,12 @@ newtype FunctionJSON a = FunctionJSON a
instance (ToJSON a, FromJSON a) => Function (FunctionJSON a) where
function = functionJSON
--------------------------------------------------------------------------------
newtype GenericArbitrary a = GenericArbitrary a
deriving newtype Generic
instance (Generic a, GArbitrary rep, Rep a ~ rep)
=> Arbitrary (GenericArbitrary a) where
arbitrary = genericArbitrary