fix[test]: quickcheck-instances panics when creating empty arrays
This commit is contained in:
parent
c78d261a1b
commit
786ded3e43
3 changed files with 26 additions and 4 deletions
|
@ -19,6 +19,7 @@ extra-source-files:
|
|||
|
||||
library
|
||||
exposed-modules:
|
||||
Data.Array.Arbitrary
|
||||
Language.Json
|
||||
Language.Json.Parser
|
||||
Language.Json.Path
|
||||
|
|
22
src/Data/Array/Arbitrary.hs
Normal file
22
src/Data/Array/Arbitrary.hs
Normal 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
|
||||
|
|
@ -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
|
||||
]
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue