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

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

@ -1,10 +1,11 @@
{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
module Data.Array.Arbitrary (ArbitraryArray(..), get) where module Data.Array.Arbitrary (ArbitraryArray(..), get, liftArbitrary) where
import Test.QuickCheck (Arbitrary (arbitrary), Gen) import Test.QuickCheck (Arbitrary (arbitrary), Gen)
import Data.Array.IArray (listArray, IArray, Ix) import Data.Array.IArray (listArray, IArray, Ix)
import Data.List (genericLength) import Data.List (genericLength)
import qualified Test.QuickCheck as QuickCheck
newtype ArbitraryArray a i e = ArbitraryArray { getArbitraryArray :: a i e } newtype ArbitraryArray a i e = ArbitraryArray { getArbitraryArray :: a i e }
deriving stock (Show) 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 instance (Arbitrary e, Num i, Ix i, IArray a e) => Arbitrary (ArbitraryArray a i e) where
arbitrary :: Gen (ArbitraryArray a i e) arbitrary :: Gen (ArbitraryArray a i e)
arbitrary = do arbitrary = liftArbitrary arbitrary
xs <- arbitrary
pure . ArbitraryArray $ case xs of liftArbitrary :: (IArray a a1, Ix i, Num i) => Gen a1 -> Gen (ArbitraryArray a i a1)
[] -> listArray (1, 0) xs liftArbitrary arbitraryElement = do
_ -> listArray (0, genericLength xs - 1) xs xs <- QuickCheck.liftArbitrary arbitraryElement
pure . ArbitraryArray $ case xs of
[] -> listArray (1, 0) xs
_ -> listArray (0, genericLength xs - 1) xs