@@ -47,19 +47,35 @@ import Data.Swagger.Lens
4747-- This can be used with QuickCheck to ensure those instances are coherent:
4848--
4949-- prop> validateToJSON (x :: Int) == []
50−validateToJSON :: forall a. (ToJSON a, ToSchema a) => a -> [String]
51−validateToJSON x = case runValidation (validateWithSchema js) cfg schema of
50+--
51+-- /NOTE:/ @'validateToJSON'@ does not perform string pattern validation.
52+-- See @'validateToJSONWithPatternChecker'@.
53+validateToJSON :: forall a. (ToJSON a, ToSchema a) => a -> [ValidationError]
54+validateToJSON = validateToJSONWithPatternChecker (\_pattern _str -> True)
55+
56+-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value and pattern checker.
57+-- This can be used with QuickCheck to ensure those instances are coherent.
58+--
59+-- For validation without patterns see @'validateToJSON'@.
60+validateToJSONWithPatternChecker :: forall a. (ToJSON a, ToSchema a) =>
61+ (Pattern -> Text -> Bool) -> a -> [ValidationError]
62+validateToJSONWithPatternChecker checker x = case runValidation (validateWithSchema js) cfg schema of
5263 Failed xs -> xs
5364 Passed _ -> mempty
5465 where
55− js = toJSON x
56− cfg = defaultConfig { configDefinitions = defs }
5766 (defs, schema) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty
67+ js = toJSON x
68+ cfg = defaultConfig
69+ { configPatternChecker = checker
70+ , configDefinitions = defs }
71+
72+-- | Validation error message.
73+type ValidationError = String
5874
5975-- | Validation result type.
6076data Result a
61− = Failed [String] -- ^ Validation failed with a list of error messages.
62− | Passed a -- ^ Validation passed.
77+ = Failed [ValidationError] -- ^ Validation failed with a list of error messages.
78+ | Passed a -- ^ Validation passed.
6379 deriving (Eq, Show, Functor)
6480
6581instance Applicative Result where