@@ -47,19 +47,35 @@ import Data.Swagger.Lens
47-- This can be used with QuickCheck to ensure those instances are coherent:
47-- This can be used with QuickCheck to ensure those instances are coherent:
49-- prop> validateToJSON (x :: Int) == []
49-- prop> validateToJSON (x :: Int) == []
51+-- /NOTE:/ @'validateToJSON'@ does not perform string pattern validation.
52+-- See @'validateToJSONWithPatternChecker'@.
50−validateToJSON :: forall a. (ToJSON a, ToSchema a) => a -> [String]
53+validateToJSON :: forall a. (ToJSON a, ToSchema a) => a -> [ValidationError]
54+validateToJSON = validateToJSONWithPatternChecker (\_pattern _str -> True)
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.
59+-- For validation without patterns see @'validateToJSON'@.
60+validateToJSONWithPatternChecker :: forall a. (ToJSON a, ToSchema a) =>
61+ (Pattern -> Text -> Bool) -> a -> [ValidationError]
51−validateToJSON x = case runValidation (validateWithSchema js) cfg schema of
62+validateToJSONWithPatternChecker checker x = case runValidation (validateWithSchema js) cfg schema of
52 Failed xs -> xs
63 Failed xs -> xs
53 Passed _ -> mempty
64 Passed _ -> mempty
56− cfg = defaultConfig { configDefinitions = defs }
57 (defs, schema) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty
66 (defs, schema) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty
69+ { configPatternChecker = checker
70+ , configDefinitions = defs }
72+-- | Validation error message.
73+type ValidationError = String
59-- | Validation result type.
75-- | Validation result type.
60data Result a
76data Result a
61− = Failed [String] -- ^ Validation failed with a list of error messages.
77+ = Failed [ValidationError] -- ^ Validation failed with a list of error messages.
62− | Passed a -- ^ Validation passed.
78+ | Passed a -- ^ Validation passed.
63 deriving (Eq, Show, Functor)
79 deriving (Eq, Show, Functor)
65instance Applicative Result where
81instance Applicative Result where