hedgehog-gen-json 0.1.0 → 0.2.0
raw patch · 9 files changed
+138/−123 lines, 9 filesdep +regex-pcredep +timedep +timerepdep −regex-posixPVP ok
version bump matches the API change (PVP)
Dependencies added: regex-pcre, time, timerep, tz
Dependencies removed: regex-posix
API changes (from Hackage documentation)
Files
- README.md +1/−1
- hedgehog-gen-json.cabal +13/−5
- src/Hedgehog/Gen/JSON/Constrained.hs +16/−18
- src/Hedgehog/Gen/JSON/Constrained/Internal.hs +23/−19
- src/Hedgehog/Gen/JSON/JSONSchema.hs +26/−22
- src/Hedgehog/Gen/JSON/Ranges.hs +1/−0
- src/Hedgehog/Gen/JSON/Unconstrained.hs +2/−9
- test/Hedgehog/Gen/JSON/Constrained/Internal/InternalSpec.hs +8/−9
- test/Hedgehog/Gen/JSON/JSONSpec.hs +48/−40
README.md view
@@ -2,4 +2,4 @@ [](https://hackage.haskell.org/package/hedgehog-gen-json) [](https://www.stackage.org/package/hedgehog-gen-json) -JSON generators for [Hedgehog](https://github.com/hedgehogqa).+Generators of arbitrary unconstrained or [JSON Schema](http://json-schema.org/) constrained values for [Hedgehog](https://github.com/hedgehogqa).
hedgehog-gen-json.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 19509d71ae99a04870b3c2924858c720249638f0ff47c4c07a0545c172c51681+-- hash: 86e9c2e335c348239ea9136832f4eab10451f7c07be61e2c2be13c9dfeb081c0 name: hedgehog-gen-json-version: 0.1.0+version: 0.2.0 synopsis: JSON generators for Hedgehog description: Generate JSON values for Hedgehog tests category: Test@@ -24,7 +24,8 @@ library hs-source-dirs: src- ghc-options: -Wall+ default-extensions: OverloadedStrings NoImplicitPrelude+ ghc-options: -Wall -fhide-source-paths build-depends: aeson , base >=4.7 && <5@@ -37,6 +38,9 @@ , regex-genex , scientific , text+ , time+ , timerep+ , tz , unordered-containers , vector exposed-modules:@@ -56,7 +60,8 @@ hs-source-dirs: src test- ghc-options: -Wall+ default-extensions: OverloadedStrings NoImplicitPrelude+ ghc-options: -Wall -fhide-source-paths build-depends: aeson , base >=4.7 && <5@@ -67,11 +72,14 @@ , lens , protolude , regex-genex- , regex-posix+ , regex-pcre , scientific , tasty , tasty-hedgehog , text+ , time+ , timerep+ , tz , unordered-containers , vector other-modules:
src/Hedgehog/Gen/JSON/Constrained.hs view
@@ -10,6 +10,7 @@ import qualified Data.Aeson as Aeson import qualified Data.HashMap.Strict as HashMap import qualified Data.Scientific as Scientific+import Data.Time.RFC3339 import qualified Data.Vector as Vector import Hedgehog import qualified Hedgehog.Gen as Gen@@ -35,15 +36,9 @@ Nothing -> Unconstrained.genValue ranges Just (MultipleTypes (t :| [])) -> genValue ranges (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 (set schemaType (Just $ SingleType t) schema), genValue ranges (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 (set schemaType (Just $ SingleType t) schema), genValue ranges (set schemaType (Just $ MultipleTypes (t' :| ts)) schema)] Just (SingleType NullType) -> genNullValue Just (SingleType BooleanType) -> genBooleanValue Just (SingleType NumberType) -> genNumberValue (ranges ^. numberRange) schema@@ -61,12 +56,7 @@ genNumberValue :: NumberRange -> Schema -> Gen Aeson.Value genNumberValue (NumberRange nr) schema = (Aeson.Number . Scientific.fromFloatDigits) <$>- genBoundedReal- (schema ^. schemaExclusiveMinimum)- (schema ^. schemaMinimum)- (schema ^. schemaExclusiveMaximum)- (schema ^. schemaMaximum)- nr+ genBoundedReal (schema ^. schemaExclusiveMinimum) (schema ^. schemaMinimum) (schema ^. schemaExclusiveMaximum) (schema ^. schemaMaximum) nr genIntegerValue :: IntegerRange -> Schema -> Gen Aeson.Value genIntegerValue (IntegerRange nr) schema =@@ -83,7 +73,16 @@ genStringValue (StringRange sr) schema = case schema ^. schemaPattern of Just (StringConstraintPattern regexp) -> Aeson.String <$> genStringFromRegexp regexp- Nothing -> Aeson.String <$> genBoundedString (schema ^. schemaMinLength) (schema ^. schemaMaxLength) sr+ Nothing ->+ case schema ^. schemaFormat of+ Just (StringConstraintFormat f) -> genWithFormat f+ Nothing -> genUnformatted+ where+ genWithFormat "uuid" = Aeson.String <$> genStringFromRegexp "[a-f0-9]{8}-[a-f0-9]{4}-4[a-f0-9]{3}-[89ab][a-f0-9]{3}-[a-f0-9]{12}"+ genWithFormat "date-time" = (Aeson.String . formatTimeRFC3339) <$> genZonedTime (Range.linearFrac 0 999999999999999999)+ genWithFormat "RFC 3339 date-time" = genWithFormat "date-time"+ 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@@ -110,12 +109,11 @@ if uniqueItems then genUniqueItems else Gen.list- in listMaker (finalRange sz) (Gen.small $ genValue ranges itemSchema)+ in listMaker (finalRange sz) (Gen.small $ genValue ranges itemSchema) Nothing -> Unconstrained.genArray ranges where ar = unArrayRange (ranges ^. arrayRange)- finalRange sz =- Range.linear (fromMaybe (Range.lowerBound sz ar) minItems) (fromMaybe (Range.upperBound sz ar) maxItems)+ finalRange sz = Range.linear (fromMaybe (Range.lowerBound sz ar) minItems) (fromMaybe (Range.upperBound sz ar) maxItems) uniqueItems = maybe False unArrayConstraintUniqueItems (schema ^. schemaUniqueItems) maxItems = unArrayConstraintMaxItems <$> (schema ^. schemaMaxItems) minItems = unArrayConstraintMinItems <$> (schema ^. schemaMinItems)
src/Hedgehog/Gen/JSON/Constrained/Internal.hs view
@@ -6,6 +6,7 @@ , genBoundedReal , genBoundedString , genStringFromRegexp+ , genZonedTime , genUniqueItems , filterAll , filterAllMaybe@@ -15,6 +16,11 @@ import Data.Scientific (Scientific) import qualified Data.Scientific as Scientific import qualified Data.Text as Text+import Data.Time.Clock+import Data.Time.Clock.POSIX+import Data.Time.LocalTime+import Data.Time.Zones+import Data.Time.Zones.All import Hedgehog import qualified Hedgehog.Gen as Gen import Hedgehog.Gen.JSON.JSONSchema@@ -31,8 +37,7 @@ -> Maybe NumberConstraintMultipleOf -> Range Integer -> Gen Integer-genBoundedInteger cminEx cmin cmaxEx cmax cmult range =- Gen.sized $ \sz -> filterAllMaybe filters $ Gen.integral (finalRange sz)+genBoundedInteger cminEx cmin cmaxEx cmax cmult range = Gen.sized $ \sz -> filterAllMaybe filters $ Gen.integral (finalRange sz) where filters = [minExFilter, maxExFilter, minFilter, maxFilter, multipleOfFilter] minExFilter = ((\b -> (> b)) . truncateScientific . unNumberConstraintExclusiveMinimum) <$> cminEx@@ -45,16 +50,12 @@ fromMaybe (Range.lowerBound sz range) ((maximumMay . catMaybes)- [ (truncateScientific . unNumberConstraintMinimum) <$> cmin- , (truncateScientific . unNumberConstraintExclusiveMinimum) <$> cminEx- ])+ [(truncateScientific . unNumberConstraintMinimum) <$> cmin, (truncateScientific . unNumberConstraintExclusiveMinimum) <$> cminEx]) maxB sz = fromMaybe (Range.lowerBound sz range) ((minimumMay . catMaybes)- [ (truncateScientific . unNumberConstraintMaximum) <$> cmax- , (truncateScientific . unNumberConstraintExclusiveMaximum) <$> cmaxEx- ])+ [(truncateScientific . unNumberConstraintMaximum) <$> cmax, (truncateScientific . unNumberConstraintExclusiveMaximum) <$> cmaxEx]) -- | Generates a Double bounded by the given constraints or by the given range. genBoundedReal ::@@ -76,28 +77,21 @@ fromMaybe (Range.lowerBound sz range) ((maximumMay . catMaybes)- [ (Scientific.toRealFloat . unNumberConstraintMinimum) <$> cmin- , (Scientific.toRealFloat . unNumberConstraintExclusiveMinimum) <$> cminEx- ])+ [(Scientific.toRealFloat . unNumberConstraintMinimum) <$> cmin, (Scientific.toRealFloat . unNumberConstraintExclusiveMinimum) <$> cminEx]) maxB sz = fromMaybe (Range.lowerBound sz range) ((minimumMay . catMaybes)- [ (Scientific.toRealFloat . unNumberConstraintMaximum) <$> cmax- , (Scientific.toRealFloat . unNumberConstraintExclusiveMaximum) <$> cmaxEx- ])+ [(Scientific.toRealFloat . unNumberConstraintMaximum) <$> cmax, (Scientific.toRealFloat . unNumberConstraintExclusiveMaximum) <$> cmaxEx]) -- | Generates a Text bounded in size by the given constraints or by the given range. genBoundedString :: Maybe StringConstraintMinLength -> Maybe StringConstraintMaxLength -> Range Int -> Gen Text-genBoundedString minLengthC maxLengthC range =- Gen.sized $ \size -> filterAllMaybe filters $ Gen.text (Range.linear (minB size) (maxB size)) Gen.unicode+genBoundedString minLengthC maxLengthC range = Gen.sized $ \size -> filterAllMaybe filters $ Gen.text (Range.linear (minB size) (maxB size)) Gen.unicode where minB sz = maybe (Range.lowerBound sz range) unStringConstraintMinLength minLengthC maxB sz = maybe (Range.upperBound sz range) unStringConstraintMaxLength maxLengthC filters =- [ ((\b t -> Text.length t >= b) . unStringConstraintMinLength) <$> minLengthC- , ((\b t -> Text.length t <= b) . unStringConstraintMaxLength) <$> maxLengthC- ]+ [((\b t -> Text.length t >= b) . unStringConstraintMinLength) <$> minLengthC, ((\b t -> Text.length t <= b) . unStringConstraintMaxLength) <$> maxLengthC] -- | Generates a Text from a given Regular Expression genStringFromRegexp :: Text -> Gen Text@@ -135,3 +129,13 @@ makeListUnique :: (Eq a, Hashable a) => [a] -> [a] makeListUnique = toList . HashSet.fromList++genZonedTime :: Range POSIXTime -> Gen ZonedTime+genZonedTime r = do+ tz <- tzByLabel <$> Gen.enumBounded+ t <- genUTCTime r+ let timezone = timeZoneForUTCTime tz t+ pure $ utcToZonedTime timezone t++genUTCTime :: Range POSIXTime -> Gen UTCTime+genUTCTime r = posixSecondsToUTCTime <$> Gen.realFrac_ r
src/Hedgehog/Gen/JSON/JSONSchema.hs view
@@ -1,7 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} @@ -83,6 +81,10 @@ { unStringConstraintPattern :: Text } deriving (Generic, Eq, Show, Aeson.FromJSON) +newtype StringConstraintFormat = StringConstraintFormat+ { unStringConstraintFormat :: Text+ } deriving (Generic, Eq, Show, Aeson.FromJSON)+ newtype StringConstraintMaxLength = StringConstraintMaxLength { unStringConstraintMaxLength :: Int } deriving (Generic, Eq, Show, Aeson.FromJSON)@@ -94,13 +96,13 @@ instance Aeson.FromJSON Schema where parseJSON = withObject "Schema" $ \obj ->- Schema <$> obj .:? "type" <*> obj .:? "enum" <*> obj .:? "const" <*> obj .:? "properties" <*> obj .:? "required" <*>- obj .:? "multipleOf" <*>+ Schema <$> obj .:? "type" <*> obj .:? "enum" <*> obj .:? "const" <*> obj .:? "properties" <*> obj .:? "required" <*> obj .:? "multipleOf" <*> obj .:? "maximum" <*> obj .:? "exclusiveMaximum" <*> obj .:? "minimum" <*> obj .:? "exclusiveMinimum" <*> obj .:? "pattern" <*>+ obj .:? "format" <*> obj .:? "maxLength" <*> obj .:? "minLength" <*> obj .:? "items" <*>@@ -144,6 +146,7 @@ , _schemaMinimum :: Maybe NumberConstraintMinimum , _schemaExclusiveMinimum :: Maybe NumberConstraintExclusiveMinimum , _schemaPattern :: Maybe StringConstraintPattern+ , _schemaFormat :: Maybe StringConstraintFormat , _schemaMaxLength :: Maybe StringConstraintMaxLength , _schemaMinLength :: Maybe StringConstraintMinLength , _schemaItems :: Maybe ArrayConstraintItems@@ -155,24 +158,25 @@ emptySchema :: Schema emptySchema = Schema- { _schemaType = Nothing- , _schemaEnum = Nothing- , _schemaConst = Nothing- , _schemaRequired = Nothing- , _schemaProperties = Nothing- , _schemaMultipleOf = Nothing- , _schemaMaximum = Nothing- , _schemaMinimum = Nothing- , _schemaExclusiveMaximum = Nothing- , _schemaExclusiveMinimum = Nothing- , _schemaPattern = Nothing- , _schemaMinLength = Nothing- , _schemaMaxLength = Nothing- , _schemaItems = Nothing- , _schemaMinItems = Nothing- , _schemaMaxItems = Nothing- , _schemaUniqueItems = Nothing- }+ { _schemaType = Nothing+ , _schemaEnum = Nothing+ , _schemaConst = Nothing+ , _schemaRequired = Nothing+ , _schemaProperties = Nothing+ , _schemaMultipleOf = Nothing+ , _schemaMaximum = Nothing+ , _schemaMinimum = Nothing+ , _schemaExclusiveMaximum = Nothing+ , _schemaExclusiveMinimum = Nothing+ , _schemaPattern = Nothing+ , _schemaFormat = Nothing+ , _schemaMinLength = Nothing+ , _schemaMaxLength = Nothing+ , _schemaItems = Nothing+ , _schemaMinItems = Nothing+ , _schemaMaxItems = Nothing+ , _schemaUniqueItems = Nothing+ } makeLenses ''Schema
src/Hedgehog/Gen/JSON/Ranges.hs view
@@ -4,6 +4,7 @@ import Control.Lens import Hedgehog+import Protolude newtype NumberRange = NumberRange { unNumberRange :: Range Double
src/Hedgehog/Gen/JSON/Unconstrained.hs view
@@ -7,6 +7,7 @@ import Hedgehog import qualified Hedgehog.Gen as Gen import Hedgehog.Gen.JSON.Ranges+import Protolude genNull :: Gen A.Value genNull = pure A.Null@@ -36,12 +37,4 @@ (ArrayRange ar) = ranges ^. arrayRange genValue :: Ranges -> Gen A.Value-genValue ranges =- Gen.choice- [ genNull- , genStringValue (ranges ^. stringRange)- , genBool- , genNumber (ranges ^. numberRange)- , genArray ranges- , genObj ranges- ]+genValue ranges = Gen.choice [genNull, genStringValue (ranges ^. stringRange), genBool, genNumber (ranges ^. numberRange), genArray ranges, genObj ranges]
test/Hedgehog/Gen/JSON/Constrained/Internal/InternalSpec.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Hedgehog.Gen.JSON.Constrained.Internal.InternalSpec@@ -17,7 +15,7 @@ import Protolude import Test.Tasty import Test.Tasty.Hedgehog-import Text.Regex.Posix+import Text.Regex.PCRE prop_genBoundedInteger :: Property prop_genBoundedInteger =@@ -84,12 +82,13 @@ assert $ Text.unpack v =~ Text.unpack regexp prop_genUniqueItems :: Property-prop_genUniqueItems = property $ do- let gen = Gen.int (Range.linear 0 1000)- generated <- forAll $ genUniqueItems (Range.linear 10 50) gen- assert $ length generated <= 50- assert $ length generated >= 10- (length . HashSet.fromList) generated === length generated+prop_genUniqueItems =+ property $ do+ let gen = Gen.int (Range.linear 0 1000)+ generated <- forAll $ genUniqueItems (Range.linear 10 50) gen+ assert $ length generated <= 50+ assert $ length generated >= 10+ (length . HashSet.fromList) generated === length generated tests :: TestTree tests =
test/Hedgehog/Gen/JSON/JSONSpec.hs view
@@ -1,28 +1,26 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Hedgehog.Gen.JSON.JSONSpec ( tests ) where -import Control.Lens (over, set)-import qualified Data.Aeson as Aeson-import Data.Fixed (mod')-import qualified Data.HashMap.Strict as H-import qualified Data.HashSet as HS-import qualified Data.Scientific as Scientific-import qualified Data.Text as Text-import Hedgehog-import qualified Hedgehog.Gen as Gen-import Hedgehog.Gen.JSON-import Hedgehog.Gen.JSON.JSONSchema-import qualified Hedgehog.Range as Range-import qualified Prelude as P-import Protolude-import Test.Tasty-import Test.Tasty.Hedgehog-import Text.Regex.Posix+import Control.Lens (over, set)+import qualified Data.Aeson as Aeson+import Data.Fixed (mod')+import qualified Data.HashMap.Strict as H+import qualified Data.HashSet as HS+import qualified Data.Scientific as Scientific+import qualified Data.Text as Text+import Hedgehog+import qualified Hedgehog.Gen as Gen+import Hedgehog.Gen.JSON+import Hedgehog.Gen.JSON.JSONSchema+import qualified Hedgehog.Range as Range+import qualified Prelude as P+import Protolude+import Test.Tasty+import Test.Tasty.Hedgehog+import Text.Regex.PCRE prop_generatedUnconstrainedJSON :: Property prop_generatedUnconstrainedJSON =@@ -56,8 +54,7 @@ let schema = (set schemaMinimum (NumberConstraintMinimum <$> vmin) . set schemaMaximum (NumberConstraintMaximum <$> vmax) .- set schemaExclusiveMinimum (NumberConstraintExclusiveMinimum <$> vminEx) .- set schemaExclusiveMaximum (NumberConstraintExclusiveMaximum <$> vmaxEx))+ set schemaExclusiveMinimum (NumberConstraintExclusiveMinimum <$> vminEx) . set schemaExclusiveMaximum (NumberConstraintExclusiveMaximum <$> vmaxEx)) (singleTypeSchema NumberType) (Aeson.Number v) <- forAll $ genConstrainedJSONValue sensibleRanges schema assert $ maybe True (v >=) vmin@@ -77,8 +74,7 @@ (set schemaMinimum (NumberConstraintMinimum <$> vmin) . set schemaMaximum (NumberConstraintMaximum <$> vmax) . set schemaExclusiveMinimum (NumberConstraintExclusiveMinimum <$> vminEx) .- set schemaExclusiveMaximum (NumberConstraintExclusiveMaximum <$> vmaxEx) .- set schemaMultipleOf (NumberConstraintMultipleOf <$> multipleOf))+ set schemaExclusiveMaximum (NumberConstraintExclusiveMaximum <$> vmaxEx) . set schemaMultipleOf (NumberConstraintMultipleOf <$> multipleOf)) (singleTypeSchema IntegerType) (Aeson.Number v) <- forAll $ genConstrainedJSONValue sensibleRanges schema assert $ maybe True (v >=) vmin@@ -94,26 +90,25 @@ minLength <- forAll $ Gen.maybe $ Gen.integral (Range.linear 0 50) maxLength <- forAll $ Gen.maybe $ Gen.integral (Range.linear 50 100) regexp <- forAll $ Gen.maybe $ Gen.constant "[a-zA-Z0-9]{3,9}" -- Not very arbitrary, I know.+ format <- forAll $ Gen.maybe $ Gen.element ["uuid", "date-time", "RFC 3339 date-time"] let schema = (set schemaPattern (StringConstraintPattern <$> regexp) . set schemaMinLength (StringConstraintMinLength <$> minLength) .- set schemaMaxLength (StringConstraintMaxLength <$> maxLength))+ set schemaMaxLength (StringConstraintMaxLength <$> maxLength) . set schemaFormat (StringConstraintFormat <$> format)) (singleTypeSchema StringType) (Aeson.String v) <- forAll $ genConstrainedJSONValue sensibleRanges schema- assert $- case regexp of- Just p -> Text.unpack v =~ Text.unpack p- Nothing -> Text.length v >= fromMaybe 0 minLength && Text.length v <= fromMaybe 1000 maxLength+ case regexp of+ Just p -> regexMatches p v+ Nothing ->+ case format of+ (Just f) -> hasFormat (StringConstraintFormat f) v+ Nothing -> assert $ Text.length v >= fromMaybe 0 minLength && Text.length v <= fromMaybe 1000 maxLength prop_constrainedObject :: Property prop_constrainedObject = property $ do- nonRequiredFields <-- forAll $- H.fromList <$> (Gen.list (Range.linear 1 10) $ ((,) <$> (Gen.text (Range.linear 1 10) Gen.unicode) <*> genSchema))- requiredFields <-- forAll $- H.fromList <$> (Gen.list (Range.linear 1 10) $ ((,) <$> (Gen.text (Range.linear 1 10) Gen.unicode) <*> genSchema))+ nonRequiredFields <- forAll $ H.fromList <$> (Gen.list (Range.linear 1 10) $ ((,) <$> (Gen.text (Range.linear 1 10) Gen.unicode) <*> genSchema))+ requiredFields <- forAll $ H.fromList <$> (Gen.list (Range.linear 1 10) $ ((,) <$> (Gen.text (Range.linear 1 10) Gen.unicode) <*> genSchema)) let schema = (set schemaProperties (Just $ ObjectConstraintProperties (nonRequiredFields `H.union` requiredFields)) . set schemaRequired (Just $ ObjectConstraintRequired $ H.keys requiredFields))@@ -131,8 +126,7 @@ let schema = (set schemaMinItems (ArrayConstraintMinItems <$> minItems) . set schemaMaxItems (ArrayConstraintMaxItems <$> maxItems) .- set schemaUniqueItems (ArrayConstraintUniqueItems <$> uniqueItems) .- set schemaItems (Just $ ArrayConstraintItems itemSchema))+ set schemaUniqueItems (ArrayConstraintUniqueItems <$> uniqueItems) . set schemaItems (Just $ ArrayConstraintItems itemSchema)) (singleTypeSchema ArrayType) (Aeson.Array v) <- forAll $ genConstrainedJSONValue sensibleRanges schema assert $ maybe True (length v >=) minItems@@ -149,15 +143,13 @@ 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\"]}" 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)])))+ ((Just . ObjectConstraintProperties) (H.fromList [("user_id", singleTypeSchema IntegerType), ("user_domain", singleTypeSchema StringType)]))) (singleTypeSchema ObjectType) genSchema :: Gen Schema@@ -170,6 +162,22 @@ isUnique :: (Hashable a, Eq a, Foldable t) => t a -> Bool isUnique xs = (toList . HS.fromList . toList) xs == toList xs++regexMatches :: (MonadTest m, HasCallStack) => Text -> Text -> m ()+regexMatches regex t = do+ footnoteShow (t <> " does not match the regexp " <> regex)+ assert $ (toS t :: P.String) =~ (toS regex :: P.String)++hasFormat :: (MonadTest m) => StringConstraintFormat -> Text -> m ()+hasFormat (StringConstraintFormat "uuid") t =+ footnoteShow (t <> " does hot have the format of uuid") >> regexMatches "[a-f0-9]{8}-?[a-f0-9]{4}-?4[a-f0-9]{3}-?[89ab][a-f0-9]{3}-?[a-f0-9]{12}" t+hasFormat (StringConstraintFormat "date-time") t =+ footnoteShow (t <> " does hot have the format of date-time") >>+ regexMatches+ "([0-9]+)-(0[1-9]|1[012])-(0[1-9]|[12][0-9]|3[01])[Tt]([01][0-9]|2[0-3]):([0-5][0-9]):([0-5][0-9]|60)(\\.[0-9]+)?(([Zz])|([\\+|\\-]([01][0-9]|2[0-3]):[0-5][0-9]))"+ t+hasFormat (StringConstraintFormat "RFC 3339 date-time") t = hasFormat (StringConstraintFormat "date-time") t+hasFormat _ _ = footnote "Format unsupported" >> failure tests :: TestTree tests =