From 97cb4e757a181bfc492f81966f01667955c3b091 Mon Sep 17 00:00:00 2001
From: VegOwOtenks <vegowotenks@jossco.de>
Date: Fri, 22 Aug 2025 11:15:49 +0200
Subject: [PATCH] feat[ArbitraryArray]: lift element samplers

---
 src/Data/Array/Arbitrary.hs | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

diff --git a/src/Data/Array/Arbitrary.hs b/src/Data/Array/Arbitrary.hs
index d1a052a..44a2924 100644
--- a/src/Data/Array/Arbitrary.hs
+++ b/src/Data/Array/Arbitrary.hs
@@ -1,10 +1,11 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE FlexibleContexts #-}
-module Data.Array.Arbitrary (ArbitraryArray(..), get) where
+module Data.Array.Arbitrary (ArbitraryArray(..), get, liftArbitrary) where
 import Test.QuickCheck (Arbitrary (arbitrary), Gen)
 import Data.Array.IArray (listArray, IArray, Ix)
 import Data.List (genericLength)
+import qualified Test.QuickCheck as QuickCheck
 
 newtype ArbitraryArray a i e = ArbitraryArray { getArbitraryArray :: a i e }
   deriving stock (Show)
@@ -14,9 +15,12 @@ get = getArbitraryArray
 
 instance (Arbitrary e, Num i, Ix i, IArray a e) => Arbitrary (ArbitraryArray a i e) where
   arbitrary :: Gen (ArbitraryArray a i e)
-  arbitrary = do
-    xs <- arbitrary
-    pure . ArbitraryArray $ case xs of
-      [] -> listArray (1, 0) xs
-      _  -> listArray (0, genericLength xs - 1) xs
+  arbitrary = liftArbitrary arbitrary
+
+liftArbitrary :: (IArray a a1, Ix i, Num i) => Gen a1 -> Gen (ArbitraryArray a i a1)
+liftArbitrary arbitraryElement = do
+  xs <- QuickCheck.liftArbitrary arbitraryElement
+  pure . ArbitraryArray $ case xs of
+    [] -> listArray (1, 0) xs
+    _  -> listArray (0, genericLength xs - 1) xs