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

fix[Type]: Empty Unions are disallowed

Browse source
This commit is contained in:
vegowotenks 2025-08-22 11:29:50 +02:00
parent 987a849682
commit 59ba6e2af5
1 changed files with 4 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

7
src/Language/Json/Type.hs
View file

@ -24,7 +24,7 @@ import qualified Data.Array.IArray as Array
import qualified Data.List as List import qualified Data.List as List
import Control.Arrow ((>>>)) import Control.Arrow ((>>>))
import GHC.Records (HasField (getField)) import GHC.Records (HasField (getField))
import Test.QuickCheck (Gen, Arbitrary (arbitrary), UnicodeString (getUnicodeString)) import Test.QuickCheck (Gen, Arbitrary (arbitrary), UnicodeString (getUnicodeString), NonEmptyList (getNonEmpty))
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.Array.Arbitrary as ArbitraryArray import qualified Data.Array.Arbitrary as ArbitraryArray
import qualified Data.Traversable as Traversable import qualified Data.Traversable as Traversable
@ -48,6 +48,7 @@ pattern Union set <- Union' set where
Union set = let Union set = let
merged = mergeUnionObjects set merged = mergeUnionObjects set
in case Set.toList merged of in case Set.toList merged of
[] -> Null
[t] -> t [t] -> t
_ -> Union' merged _ -> Union' merged
@ -82,8 +83,8 @@ instance Arbitrary Type where
, pure Number , pure Number
, pure String , pure String
, pure Boolean , pure Boolean
, Array <$> arbitrary , Array <$> Gen.scale (`div` 2) arbitrary
, Union <$> Gen.scale (`div` 2) arbitrary , Union . Set.fromList . getNonEmpty <$> Gen.scale (`div` 2) arbitrary
, Object . Map.mapKeys (Text.pack . getUnicodeString) <$> Gen.scale (`div` 2) arbitrary , Object . Map.mapKeys (Text.pack . getUnicodeString) <$> Gen.scale (`div` 2) arbitrary
] ]