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
|
||||
inherit (nixpkgs) pkgs;
|
||||
all-hies = import (fetchTarball "https://github.com/infinisil/all-hies/tarball/master") {};
|
||||
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
|
||||
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"
|
||||
then pkgs.haskellPackages
|
||||
else pkgs.haskell.packages.${compiler}
|
||||
);
|
||||
).override {
|
||||
overrides = import ./haskell-overlay.nix { inherit nixpkgs; };
|
||||
};
|
||||
|
||||
haskellPackages = (
|
||||
if withHoogle
|
||||
|
@ -16,6 +18,10 @@ let
|
|||
overrides = (self: super: {
|
||||
ghc = super.ghc // { withPackages = super.ghc.withHoogle; };
|
||||
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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue