@@ -85,7 +85,7 @@ validateEveryToJSON
8585 -> Spec
8686validateEveryToJSON _ = props
8787 (Proxy :: Proxy [ToJSON , ToSchema ])
88- (maybeCounterExample . prettyValidateWith validateToJSON)
88+ (maybeCounterExample . renderValidationErrors validateToJSON)
8989 (Proxy :: Proxy (BodyTypes JSON api ))
9090
9191-- | Verify that every type used with @'JSON'@ content type in a servant API
@@ -98,7 +98,7 @@ validateEveryToJSONWithPatternChecker :: forall proxy api. TMap (Every [Typeable
9898 -> Spec
9999validateEveryToJSONWithPatternChecker checker _ = props
100100 (Proxy :: Proxy [ToJSON , ToSchema ])
101- (maybeCounterExample . prettyValidateWith (validateToJSONWithPatternChecker checker))
101+ (maybeCounterExample . renderValidationErrors (validateToJSONWithPatternChecker checker))
102102 (Proxy :: Proxy (BodyTypes JSON api ))
103103
104104-- * QuickCheck-related stuff
@@ -137,65 +137,6 @@ props _ f px = sequence_ specs
137137 aprop :: forall p' a . (EveryTF cs a , Typeable a , Show a , Arbitrary a ) => p' a -> Spec
138138 aprop _ = prop (show (typeOf (undefined :: a ))) (f :: a -> Property )
139139
140- -- | Pretty print validation errors
141- -- together with actual JSON and Swagger Schema
142- -- (using 'encodePretty').
143- --
144- -- >>> import Data.Aeson
145- -- >>> import Data.Foldable (traverse_)
146- -- >>> data Person = Person { name :: String, phone :: Integer } deriving (Generic)
147- -- >>> instance ToJSON Person where toJSON p = object [ "name" .= name p ]
148- -- >>> instance ToSchema Person
149- -- >>> let person = Person { name = "John", phone = 123456 }
150- -- >>> traverse_ putStrLn $ prettyValidateWith validateToJSON person
151- -- Validation against the schema fails:
152- -- * property "phone" is required, but not found in "{\"name\":\"John\"}"
153- -- <BLANKLINE>
154- -- JSON value:
155- -- {
156- -- "name": "John"
157- -- }
158- -- <BLANKLINE>
159- -- Swagger Schema:
160- -- {
161- -- "required": [
162- -- "name",
163- -- "phone"
164- -- ],
165- -- "type": "object",
166- -- "properties": {
167- -- "phone": {
168- -- "type": "integer"
169- -- },
170- -- "name": {
171- -- "type": "string"
172- -- }
173- -- }
174- -- }
175- -- <BLANKLINE>
176- --
177- -- FIXME: this belongs in "Data.Swagger.Schema.Validation" (in @swagger2@).
178- prettyValidateWith
179- :: forall a . (ToJSON a , ToSchema a )
180- => (a -> [ValidationError ]) -> a -> Maybe String
181- prettyValidateWith f x =
182- case f x of
183- [] -> Nothing
184- errors -> Just $ unlines
185- [ " Validation against the schema fails:"
186- , unlines (map (" * " ++ ) errors)
187- , " JSON value:"
188- , ppJSONString json
189- , " "
190- , " Swagger Schema:"
191- , ppJSONString (toJSON schema)
192- ]
193- where
194- ppJSONString = TL. unpack . TL. decodeUtf8 . encodePretty
195-
196- json = toJSON x
197- schema = toSchema (Proxy :: Proxy a )
198-
199140-- | Provide a counterexample if there is any.
200141maybeCounterExample :: Maybe String -> Property
201142maybeCounterExample Nothing = property True
0 commit comments