Move swagger2 helper function upstream.

Author: fisx

servant-swagger.cabal

@@ -79,11 +79,12 @@ library
                      , base-compat               >=0.10.5   && <0.11
                      , bytestring                >=0.10.8.1 && <0.11
                      , http-media                >=0.7.1.3  && <0.9
-                     , insert-ordered-containers >=0.2.1.0  && <0.3
+                     , insert-ordered-containers >=0.2.2    && <0.3
                      , lens                      >=4.17     && <4.18
                      , servant                   >=0.15     && <0.17
                      , singleton-bool            >=0.1.4    && <0.2
-                     , swagger2                  >=2.3.0.1  && <2.5
+                     , swagger2                  >=2.4.1    && <2.5
+                       -- needs https://github.com/GetShopTV/swagger2/pull/195
                      , text                      >=1.2.3.0  && <1.3
                      , unordered-containers      >=0.2.9.0  && <0.3
 

src/Servant/Swagger/Internal/Test.hs

@@ -82,7 +82,7 @@ validateEveryToJSON :: forall proxy api. TMap (Every [Typeable, Show, Arbitrary,
   -> Spec
 validateEveryToJSON _ = props
   (Proxy :: Proxy [ToJSON, ToSchema])
-  (maybeCounterExample . prettyValidateWith validateToJSON)
+  (maybeCounterExample . renderValidationErrors validateToJSON)
   (Proxy :: Proxy (BodyTypes JSON api))
 
 -- | Verify that every type used with @'JSON'@ content type in a servant API
@@ -95,7 +95,7 @@ validateEveryToJSONWithPatternChecker :: forall proxy api. TMap (Every [Typeable
   -> Spec
 validateEveryToJSONWithPatternChecker checker _ = props
   (Proxy :: Proxy [ToJSON, ToSchema])
-  (maybeCounterExample . prettyValidateWith (validateToJSONWithPatternChecker checker))
+  (maybeCounterExample . renderValidationErrors (validateToJSONWithPatternChecker checker))
   (Proxy :: Proxy (BodyTypes JSON api))
 
 -- * QuickCheck-related stuff
@@ -134,65 +134,6 @@ props _ f px = sequence_ specs
     aprop :: forall p' a. (EveryTF cs a, Typeable a, Show a, Arbitrary a) => p' a -> Spec
     aprop _ = prop (show (typeOf (undefined :: a))) (f :: a -> Property)
 
--- | Pretty print validation errors
--- together with actual JSON and Swagger Schema
--- (using 'encodePretty').
---
--- >>> import Data.Aeson
--- >>> import Data.Foldable (traverse_)
--- >>> data Person = Person { name :: String, phone :: Integer } deriving (Generic)
--- >>> instance ToJSON Person where toJSON p = object [ "name" .= name p ]
--- >>> instance ToSchema Person
--- >>> let person = Person { name = "John", phone = 123456 }
--- >>> traverse_ putStrLn $ prettyValidateWith validateToJSON person
--- Validation against the schema fails:
---   * property "phone" is required, but not found in "{\"name\":\"John\"}"
--- <BLANKLINE>
--- JSON value:
--- {
---     "name": "John"
--- }
--- <BLANKLINE>
--- Swagger Schema:
--- {
---     "required": [
---         "name",
---         "phone"
---     ],
---     "type": "object",
---     "properties": {
---         "phone": {
---             "type": "integer"
---         },
---         "name": {
---             "type": "string"
---         }
---     }
--- }
--- <BLANKLINE>
---
--- FIXME: this belongs in "Data.Swagger.Schema.Validation" (in @swagger2@).
-prettyValidateWith
-  :: forall a. (ToJSON a, ToSchema a)
-  => (a -> [ValidationError]) -> a -> Maybe String
-prettyValidateWith f x =
-  case f x of
-    []      -> Nothing
-    errors  -> Just $ unlines
-      [ "Validation against the schema fails:"
-      , unlines (map ("  * " ++) errors)
-      , "JSON value:"
-      , ppJSONString json
-      , ""
-      , "Swagger Schema:"
-      , ppJSONString (toJSON schema)
-      ]
-  where
-    ppJSONString = TL.unpack . TL.decodeUtf8 . encodePretty
-
-    json   = toJSON x
-    schema = toSchema (Proxy :: Proxy a)
-
 -- | Provide a counterexample if there is any.
 maybeCounterExample :: Maybe String -> Property
 maybeCounterExample Nothing  = property True

stack.yaml

@@ -1,4 +1,12 @@
-resolver: lts-11.7
+resolver: lts-13.23
 packages:
 - '.'
 - example/
+
+extra-deps:
+- git: https://github.com/wireapp/swagger2  # see https://github.com/GetShopTV/swagger2/pull/195
+  commit: 7ef5bfc60028d71a33db75a2da93676d336a93e1
+- aeson-1.4.2.0
+- base-compat-batteries-0.10.4
+- contravariant-1.5
+- insert-ordered-containers-0.2.2