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:
		
							parent
							
								
									0abcd8c958
								
							
						
					
					
						commit
						7d8ce026a2
					
				
					 5 changed files with 47 additions and 4 deletions
				
			
		| 
						 | 
					@ -1,8 +1,11 @@
 | 
				
			||||||
{ nixpkgs ? import ./nixpkgs.nix {}, compiler ? "ghc865" }:
 | 
					{ nixpkgs ? import ./nixpkgs.nix {}
 | 
				
			||||||
 | 
					, compiler ? "ghc865" }:
 | 
				
			||||||
let
 | 
					let
 | 
				
			||||||
  inherit (nixpkgs) pkgs;
 | 
					  inherit (nixpkgs) pkgs;
 | 
				
			||||||
  all-hies = import (fetchTarball "https://github.com/infinisil/all-hies/tarball/master") {};
 | 
					  all-hies = import (fetchTarball "https://github.com/infinisil/all-hies/tarball/master") {};
 | 
				
			||||||
  hie = all-hies.selection { selector = p: { inherit (p) ghc865; }; };
 | 
					  hie = all-hies.selection { selector = p: { inherit (p) ghc865; }; };
 | 
				
			||||||
  xanthous = pkgs.haskellPackages.callPackage (import ./pkg.nix { inherit nixpkgs; }) {};
 | 
					  xanthous = (pkgs.haskellPackages
 | 
				
			||||||
 | 
					    .extend (import ./haskell-overlay.nix { inherit nixpkgs; }))
 | 
				
			||||||
 | 
					    .callPackage (import ./pkg.nix { inherit nixpkgs; }) {};
 | 
				
			||||||
in
 | 
					in
 | 
				
			||||||
xanthous // { inherit hie; }
 | 
					xanthous // { inherit hie; }
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										12
									
								
								generic-arbitrary-export-garbitrary.patch
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										12
									
								
								generic-arbitrary-export-garbitrary.patch
									
										
									
									
									
										Normal file
									
								
							| 
						 | 
					@ -0,0 +1,12 @@
 | 
				
			||||||
 | 
					diff --git a/src/Test/QuickCheck/Arbitrary/Generic.hs b/src/Test/QuickCheck/Arbitrary/Generic.hs
 | 
				
			||||||
 | 
					index fed6ab3..91f59f1 100644
 | 
				
			||||||
 | 
					--- a/src/Test/QuickCheck/Arbitrary/Generic.hs
 | 
				
			||||||
 | 
					+++ b/src/Test/QuickCheck/Arbitrary/Generic.hs
 | 
				
			||||||
 | 
					@@ -23,6 +23,7 @@ The generated 'arbitrary' method is equivalent to
 | 
				
			||||||
 | 
					 
 | 
				
			||||||
 | 
					 module Test.QuickCheck.Arbitrary.Generic
 | 
				
			||||||
 | 
					   ( Arbitrary(..)
 | 
				
			||||||
 | 
					+  , GArbitrary
 | 
				
			||||||
 | 
					   , genericArbitrary
 | 
				
			||||||
 | 
					   , genericShrink
 | 
				
			||||||
 | 
					   ) where
 | 
				
			||||||
							
								
								
									
										7
									
								
								haskell-overlay.nix
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										7
									
								
								haskell-overlay.nix
									
										
									
									
									
										Normal file
									
								
							| 
						 | 
					@ -0,0 +1,7 @@
 | 
				
			||||||
 | 
					{ nixpkgs ? import ./nixpkgs.nix {} }:
 | 
				
			||||||
 | 
					let inherit (nixpkgs) pkgs;
 | 
				
			||||||
 | 
					in self: super: rec {
 | 
				
			||||||
 | 
					  generic-arbitrary = pkgs.haskell.lib.appendPatch
 | 
				
			||||||
 | 
					    super.generic-arbitrary
 | 
				
			||||||
 | 
					    [ ./generic-arbitrary-export-garbitrary.patch ];
 | 
				
			||||||
 | 
					}
 | 
				
			||||||
| 
						 | 
					@ -8,7 +8,9 @@ let
 | 
				
			||||||
    if compiler == "default"
 | 
					    if compiler == "default"
 | 
				
			||||||
    then pkgs.haskellPackages
 | 
					    then pkgs.haskellPackages
 | 
				
			||||||
    else pkgs.haskell.packages.${compiler}
 | 
					    else pkgs.haskell.packages.${compiler}
 | 
				
			||||||
  );
 | 
					  ).override {
 | 
				
			||||||
 | 
					    overrides = import ./haskell-overlay.nix { inherit nixpkgs; };
 | 
				
			||||||
 | 
					  };
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  haskellPackages = (
 | 
					  haskellPackages = (
 | 
				
			||||||
    if withHoogle
 | 
					    if withHoogle
 | 
				
			||||||
| 
						 | 
					@ -16,6 +18,10 @@ let
 | 
				
			||||||
      overrides = (self: super: {
 | 
					      overrides = (self: super: {
 | 
				
			||||||
        ghc = super.ghc // { withPackages = super.ghc.withHoogle; };
 | 
					        ghc = super.ghc // { withPackages = super.ghc.withHoogle; };
 | 
				
			||||||
        ghcWithPackages = self.ghc.withPackages;
 | 
					        ghcWithPackages = self.ghc.withPackages;
 | 
				
			||||||
 | 
					        # eww https://github.com/NixOS/nixpkgs/issues/16394
 | 
				
			||||||
 | 
					        generic-arbitrary = pkgs.haskell.lib.appendPatch
 | 
				
			||||||
 | 
					          super.generic-arbitrary
 | 
				
			||||||
 | 
					          [ ./generic-arbitrary-export-garbitrary.patch ];
 | 
				
			||||||
      });
 | 
					      });
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
    else packageSet
 | 
					    else packageSet
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -1,15 +1,21 @@
 | 
				
			||||||
 | 
					{-# LANGUAGE UndecidableInstances #-}
 | 
				
			||||||
module Xanthous.Util.QuickCheck
 | 
					module Xanthous.Util.QuickCheck
 | 
				
			||||||
  ( FunctionShow(..)
 | 
					  ( functionShow
 | 
				
			||||||
 | 
					  , FunctionShow(..)
 | 
				
			||||||
  , functionJSON
 | 
					  , functionJSON
 | 
				
			||||||
  , FunctionJSON(..)
 | 
					  , FunctionJSON(..)
 | 
				
			||||||
 | 
					  , genericArbitrary
 | 
				
			||||||
 | 
					  , GenericArbitrary(..)
 | 
				
			||||||
  ) where
 | 
					  ) where
 | 
				
			||||||
--------------------------------------------------------------------------------
 | 
					--------------------------------------------------------------------------------
 | 
				
			||||||
import Xanthous.Prelude
 | 
					import Xanthous.Prelude
 | 
				
			||||||
import Test.QuickCheck
 | 
					import Test.QuickCheck
 | 
				
			||||||
import Test.QuickCheck.Function
 | 
					import Test.QuickCheck.Function
 | 
				
			||||||
import Test.QuickCheck.Instances.ByteString ()
 | 
					import Test.QuickCheck.Instances.ByteString ()
 | 
				
			||||||
 | 
					import Test.QuickCheck.Arbitrary.Generic
 | 
				
			||||||
import Data.Aeson
 | 
					import Data.Aeson
 | 
				
			||||||
import Data.Coerce
 | 
					import Data.Coerce
 | 
				
			||||||
 | 
					import GHC.Generics (Rep)
 | 
				
			||||||
--------------------------------------------------------------------------------
 | 
					--------------------------------------------------------------------------------
 | 
				
			||||||
 | 
					
 | 
				
			||||||
newtype FunctionShow a = FunctionShow a
 | 
					newtype FunctionShow a = FunctionShow a
 | 
				
			||||||
| 
						 | 
					@ -26,3 +32,12 @@ newtype FunctionJSON a = FunctionJSON a
 | 
				
			||||||
 | 
					
 | 
				
			||||||
instance (ToJSON a, FromJSON a) => Function (FunctionJSON a) where
 | 
					instance (ToJSON a, FromJSON a) => Function (FunctionJSON a) where
 | 
				
			||||||
  function = functionJSON
 | 
					  function = functionJSON
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					--------------------------------------------------------------------------------
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					newtype GenericArbitrary a = GenericArbitrary a
 | 
				
			||||||
 | 
					  deriving newtype Generic
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					instance (Generic a, GArbitrary rep, Rep a ~ rep)
 | 
				
			||||||
 | 
					  => Arbitrary (GenericArbitrary a) where
 | 
				
			||||||
 | 
					  arbitrary = genericArbitrary
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue