hedgehog-gen-json 0.3.0 → 0.4.0
raw patch · 5 files changed
+65/−24 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- hedgehog-gen-json.cabal +3/−4
- src/Hedgehog/Gen/JSON.hs +1/−1
- src/Hedgehog/Gen/JSON/Constrained.hs +26/−14
- src/Hedgehog/Gen/JSON/JSONSchema.hs +19/−1
- test/Hedgehog/Gen/JSON/JSONSpec.hs +16/−4
hedgehog-gen-json.cabal view
@@ -1,11 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.20.0.+-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack ----- hash: ddf576825a40f267efcc17461a489d807946f4f07d9029d265c9d07b3a2adf74+-- hash: b22a7b9a7cb95c3f62c4308936bcc599b0cd199d24fa87256faf9f84595dcae6 name: hedgehog-gen-json-version: 0.3.0+version: 0.4.0 synopsis: JSON generators for Hedgehog description: Generate JSON values for Hedgehog tests category: Test@@ -17,7 +17,6 @@ license-file: LICENSE build-type: Simple cabal-version: >= 1.10- extra-source-files: README.md
src/Hedgehog/Gen/JSON.hs view
@@ -57,7 +57,7 @@ -- | Generator for arbitrary JSON values constrained by the given JSON Schema genConstrainedJSONValue :: Ranges -> Schema -> Gen Aeson.Value-genConstrainedJSONValue = Constrained.genValue+genConstrainedJSONValue = Constrained.genToplevelValue -- | Sensible ranges for arbitrary JSON values if you're too lazy to define some sensibleRanges :: Ranges
src/Hedgehog/Gen/JSON/Constrained.hs view
@@ -2,14 +2,17 @@ {-# LANGUAGE ScopedTypeVariables #-} module Hedgehog.Gen.JSON.Constrained- ( genValue+ ( genToplevelValue+ , genValue , Schema ) where import Control.Lens+import Control.Monad import qualified Data.Aeson as Aeson import qualified Data.HashMap.Strict as HashMap import qualified Data.Scientific as Scientific+import qualified Data.Text as Text import Data.Time.RFC3339 import qualified Data.Vector as Vector import Hedgehog@@ -21,8 +24,12 @@ import qualified Hedgehog.Range as Range import Protolude -genValue :: Ranges -> Schema -> Gen Aeson.Value-genValue ranges schema+genToplevelValue :: Ranges -> Schema -> Gen Aeson.Value+genToplevelValue ranges schema = genValue ranges (ToplevelSchema schema) schema++genValue :: Ranges -> ToplevelSchema -> Schema -> Gen Aeson.Value+genValue ranges tschema schema+ | isJust (schema ^. schemaRef) = genReferencedSchema ranges tschema schema | isJust (schema ^. schemaEnum) = case schema ^. schemaEnum of Just (AnyConstraintEnum vs) -> (Gen.element . toList) vs@@ -34,18 +41,18 @@ | otherwise = case schema ^. schemaType of Nothing -> Unconstrained.genValue ranges- Just (MultipleTypes (t :| [])) -> genValue ranges (set schemaType (Just $ SingleType t) schema)+ Just (MultipleTypes (t :| [])) -> genValue ranges tschema (set schemaType (Just $ SingleType t) schema) Just (MultipleTypes (t :| [t'])) ->- Gen.choice [genValue ranges (set schemaType (Just $ SingleType t) schema), genValue ranges (set schemaType (Just $ SingleType t') schema)]+ Gen.choice [genValue ranges tschema (set schemaType (Just $ SingleType t) schema), genValue ranges tschema (set schemaType (Just $ SingleType t') schema)] Just (MultipleTypes (t :| (t':ts))) ->- Gen.choice [genValue ranges (set schemaType (Just $ SingleType t) schema), genValue ranges (set schemaType (Just $ MultipleTypes (t' :| ts)) schema)]+ Gen.choice [genValue ranges tschema (set schemaType (Just $ SingleType t) schema), genValue ranges tschema (set schemaType (Just $ MultipleTypes (t' :| ts)) schema)] Just (SingleType NullType) -> genNullValue Just (SingleType BooleanType) -> genBooleanValue Just (SingleType NumberType) -> genNumberValue (ranges ^. numberRange) schema Just (SingleType IntegerType) -> genIntegerValue (ranges ^. integerRange) schema Just (SingleType StringType) -> genStringValue (ranges ^. stringRange) schema- Just (SingleType ObjectType) -> genObjectValue ranges schema- Just (SingleType ArrayType) -> genArrayValue ranges schema+ Just (SingleType ObjectType) -> genObjectValue ranges tschema schema+ Just (SingleType ArrayType) -> genArrayValue ranges tschema schema genNullValue :: Gen Aeson.Value genNullValue = Gen.constant Aeson.Null@@ -84,8 +91,13 @@ genWithFormat _ = genUnformatted genUnformatted = Aeson.String <$> genBoundedString (schema ^. schemaMinLength) (schema ^. schemaMaxLength) sr -genObjectValue :: Ranges -> Schema -> Gen Aeson.Value-genObjectValue ranges schema = (Aeson.Object . HashMap.fromList . join) <$> generatedFields+genReferencedSchema :: Ranges -> ToplevelSchema -> Schema -> Gen Aeson.Value+genReferencedSchema ranges tschema schema = maybe (fail ("Referenced schema not found for " <> show schema)) (genValue ranges tschema) (ref >>= refSchema)+ where ref = (unAnyConstraintRef <$> (schema ^. schemaRef)) >>= Text.stripPrefix "#/definitions/"+ refSchema r = unAnyConstraintDefinitions <$> (unToplevelSchema tschema) ^. schemaDefinitions >>= HashMap.lookup r++genObjectValue :: Ranges -> ToplevelSchema -> Schema -> Gen Aeson.Value+genObjectValue ranges tschema schema = (Aeson.Object . HashMap.fromList . join) <$> generatedFields where generatedFields = traverse (\(n, gen) -> (\m -> (\v -> (n, v)) <$> (maybeToList m)) <$> gen) generatedFieldsMaybes generatedFieldsMaybes =@@ -94,13 +106,13 @@ , (if n `elem` required then fmap Just else Gen.maybe)- (Gen.small $ genValue ranges s))) <$>+ (Gen.small $ genValue ranges tschema s))) <$> HashMap.toList properties required = maybe [] unObjectConstraintRequired (schema ^. schemaRequired) properties = maybe HashMap.empty unObjectConstraintProperties (schema ^. schemaProperties) -genArrayValue :: Ranges -> Schema -> Gen Aeson.Value-genArrayValue ranges schema =+genArrayValue :: Ranges -> ToplevelSchema -> Schema -> Gen Aeson.Value+genArrayValue ranges tschema schema = case unArrayConstraintItems <$> (schema ^. schemaItems) of Just itemSchema -> Gen.sized $ \sz ->@@ -109,7 +121,7 @@ if uniqueItems then genUniqueItems else Gen.list- in listMaker (finalRange sz) (Gen.small $ genValue ranges itemSchema)+ in listMaker (finalRange sz) (Gen.small $ genValue ranges tschema itemSchema) Nothing -> Unconstrained.genArray ranges where ar = unArrayRange (ranges ^. arrayRange)
src/Hedgehog/Gen/JSON/JSONSchema.hs view
@@ -108,8 +108,14 @@ obj .:? "items" <*> obj .:? "maxItems" <*> obj .:? "minItems" <*>- obj .:? "uniqueItems"+ obj .:? "uniqueItems" <*>+ obj .:? "$ref" <*>+ obj .:? "definitions" +newtype ToplevelSchema = ToplevelSchema {+ unToplevelSchema :: Schema+} deriving (Eq, Show, Generic, Aeson.FromJSON)+ newtype ObjectConstraintProperties = ObjectConstraintProperties { unObjectConstraintProperties :: HM.HashMap Text Schema } deriving (Generic, Eq, Show, Aeson.FromJSON)@@ -118,6 +124,14 @@ { unObjectConstraintRequired :: [Text] } deriving (Generic, Eq, Show, Aeson.FromJSON) +newtype AnyConstraintRef = AnyConstraintRef+ { unAnyConstraintRef :: Text+ } deriving (Generic, Eq, Show, Aeson.FromJSON)++newtype AnyConstraintDefinitions = AnyConstraintDefinitions+ { unAnyConstraintDefinitions :: HM.HashMap Text Schema+ } deriving (Generic, Eq, Show, Aeson.FromJSON)+ newtype ArrayConstraintItems = ArrayConstraintItems { unArrayConstraintItems :: Schema } deriving (Generic, Eq, Show, Aeson.FromJSON)@@ -153,6 +167,8 @@ , _schemaMaxItems :: Maybe ArrayConstraintMaxItems , _schemaMinItems :: Maybe ArrayConstraintMinItems , _schemaUniqueItems :: Maybe ArrayConstraintUniqueItems+ , _schemaRef :: Maybe AnyConstraintRef+ , _schemaDefinitions :: Maybe AnyConstraintDefinitions } deriving (Generic, Eq, Show) emptySchema :: Schema@@ -176,6 +192,8 @@ , _schemaMinItems = Nothing , _schemaMaxItems = Nothing , _schemaUniqueItems = Nothing+ , _schemaRef = Nothing+ , _schemaDefinitions = Nothing } makeLenses ''Schema
test/Hedgehog/Gen/JSON/JSONSpec.hs view
@@ -140,16 +140,27 @@ else True) uniqueItems +prop_constrainedValueFromReferencedSchema :: Property+prop_constrainedValueFromReferencedSchema = + property $ do+ subSchema <- forAll genSchema+ let schema = emptySchema { + _schemaType = Just $ SingleType ArrayType, + _schemaItems = Just $ ArrayConstraintItems $ emptySchema { _schemaRef = Just $ AnyConstraintRef "#/definitions/x" }, + _schemaDefinitions = Just $ AnyConstraintDefinitions $ H.fromList [("x", subSchema)]+ }+ _ <- forAll $ genConstrainedJSONValue sensibleRanges schema+ success+ prop_decodesSchema :: Property prop_decodesSchema = property $ decoded === Right expected where- schemaJson = "{\"type\":\"object\",\"properties\":{\"user_id\":{\"type\":\"integer\"},\"user_domain\":{\"type\":\"string\"}},\"required\":[\"user_id\"]}"+ schemaJson = "{\"type\":\"object\",\"properties\":{\"user_id\":{\"type\":\"integer\"},\"user_domain\":{\"type\":\"string\"}},\"required\":[\"user_id\"], \"definitions\": {\"positiveInteger\": { \"type\": \"integer\", \"exclusiveMinimum\": 0 }}}" decoded :: Either P.String Schema = Aeson.eitherDecode schemaJson expected = (set schemaRequired (Just (ObjectConstraintRequired ["user_id"])) .- set- schemaProperties- ((Just . ObjectConstraintProperties) (H.fromList [("user_id", singleTypeSchema IntegerType), ("user_domain", singleTypeSchema StringType)])))+ set schemaProperties ((Just . ObjectConstraintProperties) (H.fromList [("user_id", singleTypeSchema IntegerType), ("user_domain", singleTypeSchema StringType)])) .+ set schemaDefinitions ((Just . AnyConstraintDefinitions) (H.fromList [("positiveInteger", (singleTypeSchema IntegerType) { _schemaExclusiveMinimum = Just (NumberConstraintExclusiveMinimum 0)})]))) (singleTypeSchema ObjectType) genSchema :: Gen Schema@@ -192,4 +203,5 @@ , testProperty "Generates a constrained string" prop_constrainedString , testProperty "Generates a constrained object" prop_constrainedObject , testProperty "Generates a constrained array" prop_constrainedArray+ , testProperty "Generates a value from a referenced schema" prop_constrainedValueFromReferencedSchema ]