Move swagger2 helper function upstream.

haskell-servant · Jul 31, 2020 · ccb9daa · ccb9daa
1 parent 0b828aa
commit ccb9daa
Show file tree

Hide file tree

Showing 3 changed files with 13 additions and 68 deletions.
diff --git a/servant-swagger.cabal b/servant-swagger.cabal
@@ -2,10 +2,10 @@ name:                servant-swagger
 version:             1.1.9
 synopsis:            Generate a Swagger/OpenAPI/OAS 2.0 specification for your servant API.
 description:
-  Swagger is a project used to describe and document RESTful APIs. The core of the 
-  project is the [OpenAPI Specification (OAS)](https://swagger.io/docs/specification/about/). 
-  This library implements v2.0 of the spec. Unlike Servant it is language-agnostic and thus is 
-  quite popular among developers in different languages. It has also existed for a longer time 
+  Swagger is a project used to describe and document RESTful APIs. The core of the
+  project is the [OpenAPI Specification (OAS)](https://swagger.io/docs/specification/about/).
+  This library implements v2.0 of the spec. Unlike Servant it is language-agnostic and thus is
+  quite popular among developers in different languages. It has also existed for a longer time
   and has more helpful tooling.
   .
   This package provides means to generate a Swagger/OAS specification for a Servant API
@@ -80,11 +80,11 @@ library
                      , base-compat               >=0.10.5   && <0.12
                      , 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.20
                      , servant                   >=0.17     && <0.18
                      , singleton-bool            >=0.1.4    && <0.2
-                     , swagger2                  >=2.3.0.1  && <2.7
+                     , swagger2                  >=2.4.1    && <2.7
                      , text                      >=1.2.3.0  && <1.3
                      , unordered-containers      >=0.2.9.0  && <0.3
 

diff --git a/src/Servant/Swagger/Internal/Test.hs b/src/Servant/Swagger/Internal/Test.hs
@@ -85,7 +85,7 @@ validateEveryToJSON
   -> 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
@@ -98,7 +98,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
@@ -137,65 +137,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

diff --git a/stack.yaml b/stack.yaml
@@ -1,4 +1,8 @@
-resolver: lts-13.25
+resolver: lts-16.7
 packages:
 - '.'
 - example/
+
+extra-deps:
+- servant-0.17
+- servant-server-0.17