diff options
Diffstat (limited to 'users/grfn/xanthous/src')
-rw-r--r-- | users/grfn/xanthous/src/Xanthous/Data.hs | 13 | ||||
-rw-r--r-- | users/grfn/xanthous/src/Xanthous/Orphans.hs | 5 |
2 files changed, 11 insertions, 7 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Data.hs b/users/grfn/xanthous/src/Xanthous/Data.hs index c11ceb55aa26..1acd14a0640b 100644 --- a/users/grfn/xanthous/src/Xanthous/Data.hs +++ b/users/grfn/xanthous/src/Xanthous/Data.hs @@ -191,7 +191,7 @@ y = lens (\(Position _ yy) -> yy) (\(Position xx _) yy -> Position xx yy) type Position = Position' Int -instance Arbitrary a => Arbitrary (Position' a) where +instance (Arg (Position' a) a, Arbitrary a) => Arbitrary (Position' a) where arbitrary = genericArbitrary shrink (Position px py) = Position <$> shrink px <*> shrink py @@ -313,7 +313,8 @@ data Direction where Here :: Direction deriving stock (Show, Eq, Ord, Generic) deriving anyclass (CoArbitrary, Function, NFData, ToJSON, FromJSON, Hashable) - deriving Arbitrary via GenericArbitrary Direction + +deriving via (GenericArbitrary Direction) instance Arbitrary Direction instance Opposite Direction where opposite Up = Down @@ -432,7 +433,8 @@ data Neighbors a = Neighbors } deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable, Generic) deriving anyclass (NFData, CoArbitrary, Function, MonoFoldable) - deriving Arbitrary via GenericArbitrary (Neighbors a) + +deriving via (GenericArbitrary (Neighbors a)) instance (Arg (Neighbors a) a, Arbitrary a) => Arbitrary (Neighbors a) type instance Element (Neighbors a) = a @@ -768,9 +770,12 @@ data Box a = Box , _dimensions :: V2 a } deriving stock (Show, Eq, Ord, Functor, Generic) - deriving Arbitrary via GenericArbitrary (Box a) makeFieldsNoPrefix ''Box +-- It seems to be necessary to have an `Arg (V2 a) a` constraint, as a is passed +-- to V2 internally, in order to make GHC figure out this deriving via correctly. +deriving via (GenericArbitrary (Box a)) instance (Arg (V2 a) a, Arbitrary a) => Arbitrary (Box a) + bottomRightCorner :: Num a => Box a -> V2 a bottomRightCorner box = V2 (box ^. topLeftCorner . L._x + box ^. dimensions . L._x) diff --git a/users/grfn/xanthous/src/Xanthous/Orphans.hs b/users/grfn/xanthous/src/Xanthous/Orphans.hs index 385873e7b464..b00c803cfe7a 100644 --- a/users/grfn/xanthous/src/Xanthous/Orphans.hs +++ b/users/grfn/xanthous/src/Xanthous/Orphans.hs @@ -22,6 +22,7 @@ import Brick.Widgets.Core (getName) import System.Random.Internal (StdGen (..)) import System.Random.SplitMix (SMGen ()) import Test.QuickCheck +import Test.QuickCheck.Arbitrary.Generic (Arg ()) import "quickcheck-instances" Test.QuickCheck.Instances () import Text.Megaparsec (errorBundlePretty) import Text.Megaparsec.Pos @@ -307,9 +308,7 @@ deriving stock instance Ord a => Ord (MaybeDefault a) deriving stock instance Ord Attr deriving anyclass instance Hashable Graphics.Vty.Input.Events.Key -deriving anyclass instance NFData Graphics.Vty.Input.Events.Key deriving anyclass instance Hashable Graphics.Vty.Input.Events.Modifier -deriving anyclass instance NFData Graphics.Vty.Input.Events.Modifier -------------------------------------------------------------------------------- @@ -374,7 +373,7 @@ deriving newtype instance (Arbitrary s, CoArbitrary (m (a, s))) -------------------------------------------------------------------------------- -deriving via (GenericArbitrary (V2 a)) instance Arbitrary a => Arbitrary (V2 a) +deriving via (GenericArbitrary (V2 a)) instance (Arg (V2 a) a, Arbitrary a) => Arbitrary (V2 a) instance CoArbitrary a => CoArbitrary (V2 a) instance Function a => Function (V2 a) |