fix[test]: quickcheck-instances panics when creating empty arrays

This commit is contained in:
vegowotenks 2025-08-22 10:54:10 +02:00
parent c78d261a1b
commit 786ded3e43
3 changed files with 26 additions and 4 deletions

View file

@ -19,6 +19,7 @@ extra-source-files:
library
exposed-modules:
Data.Array.Arbitrary
Language.Json
Language.Json.Parser
Language.Json.Path

View file

@ -0,0 +1,22 @@
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE FlexibleContexts #-}
module Data.Array.Arbitrary (ArbitraryArray(..), get) where
import Test.QuickCheck (Arbitrary (arbitrary), Gen)
import Data.Array.IArray (listArray, IArray, Ix)
import Data.List (genericLength)
newtype ArbitraryArray a i e = ArbitraryArray { getArbitraryArray :: a i e }
deriving stock (Show)
get :: ArbitraryArray a i e -> a i e
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

View file

@ -28,8 +28,7 @@ import GHC.Generics ( Generic, Generically(..) )
import Pretty.Serialize (PrettySerialize)
import Test.QuickCheck (Arbitrary (arbitrary), Gen, UnicodeString (getUnicodeString), PrintableString (getPrintableString))
import qualified Test.QuickCheck.Gen as Gen
import Test.QuickCheck.Instances.Array ()
import Test.QuickCheck.Instances.Natural ()
import Data.Array.Arbitrary (ArbitraryArray(getArbitraryArray))
data Value
@ -50,7 +49,7 @@ instance Arbitrary Value where
, String . Text.pack . getUnicodeString <$> arbitrary
, Boolean <$> arbitrary
, Number <$> arbitrary
, Array <$> Gen.scale (`div` 2) arbitrary
, Array . getArbitraryArray <$> Gen.scale (`div` 2) arbitrary
, Object . Map.mapKeys (Text.pack . getUnicodeString) <$> Gen.scale (`div` 2) arbitrary
]
@ -64,7 +63,7 @@ instance Arbitrary PrintableValue where
, String . Text.pack . getPrintableString <$> arbitrary
, Boolean <$> arbitrary
, Number <$> arbitrary
, Array <$> Gen.scale (`div` 2) arbitrary
, Array . getArbitraryArray <$> Gen.scale (`div` 2) arbitrary
, Object . Map.mapKeys (Text.pack . getPrintableString) <$> Gen.scale (`div` 2) arbitrary
]