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

test[Type]: Sampling is always conforming

Browse source
This commit is contained in:
vegowotenks 2025-08-22 11:25:33 +02:00
parent 3fd043b9c5
commit 987a849682
2 changed files with 32 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

19
test/Test/Language/Json/Type.hs
View file

@ -1,14 +1,31 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE DerivingVia #-}
module Test.Language.Json.Type (testGroup) where
import qualified Language.Json.Type as Type
import qualified Language.Json as Json
import Test.QuickCheck (allProperties, Property)
import Test.QuickCheck (allProperties, Property, Arbitrary (arbitrary), Gen)
import qualified Test.Tasty.QuickCheck as Tasty.QuickCheck
import Test.Tasty (TestTree)
import Language.Json.Type (Type)
prop_inferredTypeConformsSourceValue :: Json.PrintableValue -> Bool
prop_inferredTypeConformsSourceValue (Json.PrintableValue value) = null (Type.conforms (Type.infer value) value)
newtype TypeWithSampledValue = TypeWithSampledValue (Type, Json.Value)
deriving stock Show
instance Arbitrary TypeWithSampledValue where
arbitrary :: Gen TypeWithSampledValue
arbitrary = do
layout <- arbitrary
value <- Type.sample layout
pure . TypeWithSampledValue $ (layout, value)
prop_sampledValueConformsToType :: TypeWithSampledValue -> Bool
prop_sampledValueConformsToType (TypeWithSampledValue (layout, value)) = null (Type.conforms layout value)
return [] -- make ghc 'commit' already defined values
properties :: [(String, Property)]
properties = $allProperties