servant-swagger 1.0.1 → 1.0.2
raw patch · 11 files changed
+56/−24 lines, 11 filesdep ~aeson-qqdep ~base
Dependency ranges changed: aeson-qq, base
Files
- CHANGELOG.md +9/−0
- example/example.cabal +1/−1
- example/src/Todo.hs +2/−1
- example/test/TodoSpec.hs +1/−0
- servant-swagger.cabal +2/−2
- src/Servant/Swagger.hs +2/−0
- src/Servant/Swagger/Internal.hs +15/−7
- src/Servant/Swagger/Internal/Test.hs +2/−0
- src/Servant/Swagger/Internal/TypeLevel/API.hs +2/−1
- src/Servant/Swagger/Internal/TypeLevel/Every.hs +2/−3
- test/Servant/SwaggerSpec.hs +18/−9
CHANGELOG.md view
@@ -1,3 +1,12 @@+1.0.2+---++* Minor changes:+ * Add GHC 7.8 support (see [#26](https://github.com/haskell-servant/servant-swagger/pull/26)).++* Fixes:+ * Improve compile-time performance of `BodyTypes` (see [#25](https://github.com/haskell-servant/servant-swagger/issues/25)).+ 1.0.1 ---
example/example.cabal view
@@ -48,7 +48,7 @@ TodoSpec Paths_example build-depends: base == 4.*- , aeson+ , aeson >=0.9.0.1 , bytestring , example , hspec
example/src/Todo.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-}@@ -10,7 +11,7 @@ import Data.Proxy import Data.Text (Text) import Data.Time (UTCTime(..), fromGregorian)-import Data.Typeable+import Data.Typeable (Typeable) import Data.Swagger import GHC.Generics import Servant
example/test/TodoSpec.hs view
@@ -1,6 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module TodoSpec where +import Control.Applicative import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as BL8 import Servant.Swagger.Test
servant-swagger.cabal view
@@ -1,5 +1,5 @@ name: servant-swagger-version: 1.0.1+version: 1.0.2 synopsis: Generate Swagger specification for your servant API. description: Please see README.md homepage: https://github.com/haskell-servant/servant-swagger@@ -72,7 +72,7 @@ main-is: Spec.hs build-depends: base == 4.* , aeson- , aeson-qq+ , aeson-qq >=0.8.1 , hspec , QuickCheck , lens
src/Servant/Swagger.hs view
@@ -46,6 +46,7 @@ import Servant.Swagger.Test -- $setup+-- >>> import Control.Applicative -- >>> import Control.Lens -- >>> import Data.Aeson -- >>> import Data.Swagger@@ -55,6 +56,7 @@ -- >>> import Test.Hspec -- >>> import Test.QuickCheck -- >>> :set -XDataKinds+-- >>> :set -XDeriveDataTypeable -- >>> :set -XDeriveGeneric -- >>> :set -XGeneralizedNewtypeDeriving -- >>> :set -XOverloadedStrings
src/Servant/Swagger/Internal.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -6,6 +7,13 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ConstraintKinds #-}+#if __GLASGOW_HASKELL__ >= 710+#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}+#else+{-# LANGUAGE OverlappingInstances #-}+#define OVERLAPPABLE_+#endif module Servant.Swagger.Internal where import Control.Lens@@ -119,7 +127,7 @@ markdownCode s = "`" <> s <> "`" addDefaultResponse404 :: ParamName -> Swagger -> Swagger-addDefaultResponse404 pname = setResponseWith (\old _new -> alter404 old) 404 (pure response404)+addDefaultResponse404 pname = setResponseWith (\old _new -> alter404 old) 404 (return response404) where sname = markdownCode pname description404 = sname <> " not found"@@ -127,7 +135,7 @@ response404 = mempty & description .~ description404 addDefaultResponse400 :: ParamName -> Swagger -> Swagger-addDefaultResponse400 pname = setResponseWith (\old _new -> alter400 old) 400 (pure response400)+addDefaultResponse400 pname = setResponseWith (\old _new -> alter400 old) 400 (return response400) where sname = markdownCode pname description400 = "Invalid " <> sname@@ -138,7 +146,7 @@ -- DELETE -- ----------------------------------------------------------------------- -instance {-# OVERLAPPABLE #-} (ToSchema a, AllAccept cs) => HasSwagger (Delete cs a) where+instance OVERLAPPABLE_ (ToSchema a, AllAccept cs) => HasSwagger (Delete cs a) where toSwagger _ = toSwagger (Proxy :: Proxy (Delete cs (Headers '[] a))) instance (ToSchema a, AllAccept cs, AllToResponseHeader hs) => HasSwagger (Delete cs (Headers hs a)) where@@ -151,7 +159,7 @@ -- GET -- ----------------------------------------------------------------------- -instance {-# OVERLAPPABLE #-} (ToSchema a, AllAccept cs) => HasSwagger (Get cs a) where+instance OVERLAPPABLE_ (ToSchema a, AllAccept cs) => HasSwagger (Get cs a) where toSwagger _ = toSwagger (Proxy :: Proxy (Get cs (Headers '[] a))) instance (ToSchema a, AllAccept cs, AllToResponseHeader hs) => HasSwagger (Get cs (Headers hs a)) where@@ -164,7 +172,7 @@ -- PATCH -- ----------------------------------------------------------------------- -instance {-# OVERLAPPABLE #-} (ToSchema a, AllAccept cs) => HasSwagger (Patch cs a) where+instance OVERLAPPABLE_ (ToSchema a, AllAccept cs) => HasSwagger (Patch cs a) where toSwagger _ = toSwagger (Proxy :: Proxy (Patch cs (Headers '[] a))) instance (ToSchema a, AllAccept cs, AllToResponseHeader hs) => HasSwagger (Patch cs (Headers hs a)) where@@ -177,7 +185,7 @@ -- PUT -- ----------------------------------------------------------------------- -instance {-# OVERLAPPABLE #-} (ToSchema a, AllAccept cs) => HasSwagger (Put cs a) where+instance OVERLAPPABLE_ (ToSchema a, AllAccept cs) => HasSwagger (Put cs a) where toSwagger _ = toSwagger (Proxy :: Proxy (Put cs (Headers '[] a))) instance (ToSchema a, AllAccept cs, AllToResponseHeader hs) => HasSwagger (Put cs (Headers hs a)) where@@ -190,7 +198,7 @@ -- POST -- ----------------------------------------------------------------------- -instance {-# OVERLAPPABLE #-} (ToSchema a, AllAccept cs) => HasSwagger (Post cs a) where+instance OVERLAPPABLE_ (ToSchema a, AllAccept cs) => HasSwagger (Post cs a) where toSwagger _ = toSwagger (Proxy :: Proxy (Post cs (Headers '[] a))) instance (ToSchema a, AllAccept cs, AllToResponseHeader hs) => HasSwagger (Post cs (Headers hs a)) where
src/Servant/Swagger/Internal/Test.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ConstraintKinds #-} module Servant.Swagger.Internal.Test where import Data.Aeson (ToJSON)@@ -17,6 +18,7 @@ import Servant.Swagger.Internal.TypeLevel -- $setup+-- >>> import Control.Applicative -- >>> import GHC.Generics -- >>> import Test.QuickCheck -- >>> :set -XDeriveGeneric
src/Servant/Swagger/Internal/TypeLevel/API.hs view
@@ -63,7 +63,7 @@ -- | Merge two lists, ignoring any type in @xs@ which occurs also in @ys@. type family Merge xs ys where Merge '[] ys = ys- Merge (x ': xs) ys = Insert x (Merge xs ys)+ Merge (x ': xs) ys = If (Elem x ys) (Merge xs ys) (x ': (Merge xs ys)) -- | Extract a list of unique "body" types for a specific content-type from a servant API. type family BodyTypes c api :: [*] where@@ -80,4 +80,5 @@ BodyTypes c (ReqBody cs a :> api) = AddBodyType c cs a (BodyTypes c api) BodyTypes c (e :> api) = BodyTypes c api BodyTypes c (a :<|> b) = Merge (BodyTypes c a) (BodyTypes c b)+ BodyTypes c api = '[]
src/Servant/Swagger/Internal/TypeLevel/Every.hs view
@@ -52,9 +52,8 @@ -- | Like @'tmap'@, but uses @'Every'@ for multiple constraints. -- -- >>> let zero :: forall p a. (Show a, Num a) => p a -> String; zero _ = show (0 :: a)--- >>> tmapEvery (Proxy :: Proxy [Show, Num]) zero (Proxy :: Proxy [Int, Float])+-- >>> tmapEvery (Proxy :: Proxy [Show, Num]) zero (Proxy :: Proxy [Int, Float]) :: [String] -- ["0","0.0"] tmapEvery :: forall a cs p p'' xs. (TMap (Every cs) xs) =>- p cs -> (forall x p'. EveryTF cs x => p' x -> a) -> p'' xs -> [a]+ p cs -> (forall x p'. Every cs x => p' x -> a) -> p'' xs -> [a] tmapEvery _ = tmap (Proxy :: Proxy (Every cs))-
test/Servant/SwaggerSpec.hs view
@@ -1,9 +1,9 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE DeriveDataTypeable #-} module Servant.SwaggerSpec where import Control.Lens@@ -11,6 +11,7 @@ import qualified Data.Aeson.Types as JSON import Data.Aeson.QQ import Data.Char (toLower)+import Data.Int (Int64) import Data.Proxy import Data.Swagger import Data.Text (Text)@@ -43,10 +44,14 @@ { created :: UTCTime , title :: String , summary :: Maybe String- } deriving (Generic, FromJSON, ToSchema)+ } deriving (Generic) -newtype TodoId = TodoId String deriving (Generic, ToParamSchema)+instance ToJSON Todo+instance ToSchema Todo +newtype TodoId = TodoId String deriving (Generic)+instance ToParamSchema TodoId+ type TodoAPI = "todo" :> Capture "id" TodoId :> Get '[JSON] Todo todoAPI :: Value@@ -127,7 +132,7 @@ data UserSummary = UserSummary { summaryUsername :: Username- , summaryUserid :: Int+ , summaryUserid :: Int64 -- Word64 would make sense too } deriving (Eq, Show, Generic) lowerCutPrefix :: String -> String -> String@@ -146,12 +151,14 @@ data UserDetailed = UserDetailed { username :: Username- , userid :: Int+ , userid :: Int64 , groups :: [Group]- } deriving (Eq, Show, Generic, ToSchema)+ } deriving (Eq, Show, Generic)+instance ToSchema UserDetailed newtype Package = Package { packageName :: Text }- deriving (Eq, Show, Generic, ToSchema)+ deriving (Eq, Show, Generic)+instance ToSchema Package hackageSwaggerWithTags :: Swagger hackageSwaggerWithTags = toSwagger (Proxy :: Proxy HackageAPI)@@ -193,7 +200,8 @@ "userid":{ "maximum":9223372036854775807, "minimum":-9223372036854775808,- "type":"integer"+ "type":"integer",+ "format":"int64" } } },@@ -221,7 +229,8 @@ "userid":{ "maximum":9223372036854775807, "minimum":-9223372036854775808,- "type":"integer"+ "type":"integer",+ "format":"int64" } }, "example":{