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…
Reference in a new issue