vegowotenks/hon
1
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

feat[ArbitraryArray]: lift element samplers

Browse source
This commit is contained in:
vegowotenks 2025-08-22 11:15:49 +02:00
parent 786ded3e43
commit 97cb4e757a
1 changed files with 10 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

10
src/Data/Array/Arbitrary.hs
View file

@ -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,8 +15,11 @@ 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
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