servant-swagger 1.0.2 → 1.0.3

raw patch · 3 files changed

+39/−27 lines, 3 files

Files

• CHANGELOG.md +6/−0
• servant-swagger.cabal +1/−1
• src/Servant/Swagger/Internal/TypeLevel/API.hs +32/−26

@@ -1,3 +1,9 @@+1.0.3+---++* Fixes:+    * Improve compile-time performance of `BodyTypes` even further (see [18e0d95](https://github.com/haskell-servant/servant-swagger/commit/18e0d95ef6fe9076dd9621cb515d8d1a189f71d3))!+ 1.0.2 --- 

@@ -1,5 +1,5 @@ name:                servant-swagger-version:             1.0.2+version:             1.0.3 synopsis:            Generate Swagger specification for your servant API. description:         Please see README.md homepage:            https://github.com/haskell-servant/servant-swagger

@@ -52,33 +52,39 @@   Elem x (x ': xs) = 'True   Elem x (y ': xs) = Elem x xs --- | @'AddBodyType' c cs a as@ adds type @a@ to the list @as@--- only if @c@ is in @cs@ and @a@ is not in @as@.--- This allows to build a list of unique body types.-type AddBodyType c cs a as = If (Elem c cs) (Insert a as) as---- | Insert type @x@ into a type list @xs@ only if it is not already there.-type Insert x xs = If (Elem x xs) xs (x ': xs)+-- | Remove duplicates from a type-level list.+type family Nub xs where+  Nub '[] = '[]+  Nub (x ': xs) = x ': Nub (Remove x xs) --- | 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 = If (Elem x ys) (Merge xs ys) (x ': (Merge xs ys))+-- | Remove element from a type-level list.+type family Remove x xs where+  Remove x '[]       = '[]+  Remove x (x ': ys) =      Remove x ys+  Remove x (y ': ys) = y ': Remove x ys  -- | Extract a list of unique "body" types for a specific content-type from a servant API.-type family BodyTypes c api :: [*] where-  BodyTypes c (Delete  cs (Headers hdrs a)) = AddBodyType c cs a '[]-  BodyTypes c (Get     cs (Headers hdrs a)) = AddBodyType c cs a '[]-  BodyTypes c (Patch   cs (Headers hdrs a)) = AddBodyType c cs a '[]-  BodyTypes c (Post    cs (Headers hdrs a)) = AddBodyType c cs a '[]-  BodyTypes c (Put     cs (Headers hdrs a)) = AddBodyType c cs a '[]-  BodyTypes c (Delete  cs a) = AddBodyType c cs a '[]-  BodyTypes c (Get     cs a) = AddBodyType c cs a '[]-  BodyTypes c (Patch   cs a) = AddBodyType c cs a '[]-  BodyTypes c (Post    cs a) = AddBodyType c cs a '[]-  BodyTypes c (Put     cs a) = AddBodyType c cs a '[]-  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 = '[]+type BodyTypes c api = Nub (BodyTypes' c api)++-- | @'AddBodyType' c cs a as@ adds type @a@ to the list @as@+-- only if @c@ is in @cs@.+type AddBodyType c cs a as = If (Elem c cs) (a ': as) as++-- | Extract a list of "body" types for a specific content-type from a servant API.+-- To extract unique types see @'BodyTypes'@.+type family BodyTypes' c api :: [*] where+  BodyTypes' c (Delete  cs (Headers hdrs a)) = AddBodyType c cs a '[]+  BodyTypes' c (Get     cs (Headers hdrs a)) = AddBodyType c cs a '[]+  BodyTypes' c (Patch   cs (Headers hdrs a)) = AddBodyType c cs a '[]+  BodyTypes' c (Post    cs (Headers hdrs a)) = AddBodyType c cs a '[]+  BodyTypes' c (Put     cs (Headers hdrs a)) = AddBodyType c cs a '[]+  BodyTypes' c (Delete  cs a) = AddBodyType c cs a '[]+  BodyTypes' c (Get     cs a) = AddBodyType c cs a '[]+  BodyTypes' c (Patch   cs a) = AddBodyType c cs a '[]+  BodyTypes' c (Post    cs a) = AddBodyType c cs a '[]+  BodyTypes' c (Put     cs a) = AddBodyType c cs a '[]+  BodyTypes' c (ReqBody cs a :> api) = AddBodyType c cs a (BodyTypes' c api)+  BodyTypes' c (e :> api) = BodyTypes' c api+  BodyTypes' c (a :<|> b) = AppendList (BodyTypes' c a) (BodyTypes' c b)+  BodyTypes' c api = '[]