servant-swagger 1.1.2 → 1.1.2.1

raw patch · 7 files changed

+219/−76 lines, 7 filesdep ~aesondep ~doctestdep ~servantsetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson, doctest, servant

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• Setup.lhs +160/−30
• servant-swagger.cabal +19/−7
• src/Servant/Swagger.hs +3/−3
• test/DocTest.hs +0/−30
• test/Servant/SwaggerSpec.hs +6/−6
• test/doctests.hs +25/−0

@@ -1,3 +1,9 @@+1.1.2.1+---++* Notes:+   * `servant-0.10` compatible release+ 1.1.2 --- 

@@ -1,48 +1,178 @@-#!/usr/bin/runhaskell \begin{code}-{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} module Main (main) where -import Data.List ( nub )-import Data.Version ( showVersion )-import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName )-import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+#ifndef MIN_VERSION_cabal_doctest+#define MIN_VERSION_cabal_doctest(x,y,z) 0+#endif+ import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )++#if MIN_VERSION_cabal_doctest(1,0,0)+import Distribution.Extra.Doctest ( generateBuildModule )+#else++-- Otherwise we provide a shim++#ifndef MIN_VERSION_Cabal+#define MIN_VERSION_Cabal(x,y,z) 0+#endif+#ifndef MIN_VERSION_directory+#define MIN_VERSION_directory(x,y,z) 0+#endif+#if MIN_VERSION_Cabal(1,24,0)+#define InstalledPackageId UnitId+#endif++import Control.Monad ( when )+import Data.List ( nub )+import Data.String ( fromString )+import Distribution.Package ( InstalledPackageId )+import Distribution.Package ( PackageId, Package (..), packageVersion )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) , Library (..), BuildInfo (..)) import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose ) import Distribution.Simple.BuildPaths ( autogenModulesDir )-import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag )-import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )-import Distribution.Verbosity ( Verbosity )+import Distribution.Simple.Setup ( BuildFlags(buildDistPref, buildVerbosity), fromFlag)+import Distribution.Simple.LocalBuildInfo ( withPackageDB, withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps), compiler )+import Distribution.Simple.Compiler ( showCompilerId , PackageDB (..))+import Distribution.Text ( display , simpleParse ) import System.FilePath ( (</>) ) -main :: IO ()-main = defaultMainWithHooks simpleUserHooks-  { buildHook = \pkg lbi hooks flags -> do-     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi-     buildHook simpleUserHooks pkg lbi hooks flags-  }+#if MIN_VERSION_Cabal(1,25,0)+import Distribution.Simple.BuildPaths ( autogenComponentModulesDir )+#endif -generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()-generateBuildModule verbosity pkg lbi = do-  let dir = autogenModulesDir lbi-  createDirectoryIfMissingVerbose verbosity True dir-  withLibLBI pkg lbi $ \_ libcfg -> do-    withTestLBI pkg lbi $ \suite suitecfg -> do-      rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines-        [ "module Build_" ++ testName suite ++ " where"+#if MIN_VERSION_directory(1,2,2)+import System.Directory (makeAbsolute)+#else+import System.Directory (getCurrentDirectory)+import System.FilePath (isAbsolute)++makeAbsolute :: FilePath -> IO FilePath+makeAbsolute p | isAbsolute p = return p+               | otherwise    = do+    cwd <- getCurrentDirectory+    return $ cwd </> p+#endif++generateBuildModule :: String -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule testsuiteName flags pkg lbi = do+  let verbosity = fromFlag (buildVerbosity flags)+  let distPref = fromFlag (buildDistPref flags)++  -- Package DBs+  let dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref </> "package.conf.inplace" ]+  let dbFlags = "-hide-all-packages" : packageDbArgs dbStack++  withLibLBI pkg lbi $ \lib libcfg -> do+    let libBI = libBuildInfo lib++    -- modules+    let modules = exposedModules lib ++ otherModules libBI+    -- it seems that doctest is happy to take in module names, not actual files!+    let module_sources = modules++    -- We need the directory with library's cabal_macros.h!+#if MIN_VERSION_Cabal(1,25,0)+    let libAutogenDir = autogenComponentModulesDir lbi libcfg+#else+    let libAutogenDir = autogenModulesDir lbi+#endif++    -- Lib sources and includes+    iArgs <- mapM (fmap ("-i"++) . makeAbsolute) $ libAutogenDir : hsSourceDirs libBI+    includeArgs <- mapM (fmap ("-I"++) . makeAbsolute) $ includeDirs libBI++    -- CPP includes, i.e. include cabal_macros.h+    let cppFlags = map ("-optP"++) $+            [ "-include", libAutogenDir ++ "/cabal_macros.h" ]+            ++ cppOptions libBI++    withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == fromString testsuiteName) $ do++      -- get and create autogen dir+#if MIN_VERSION_Cabal(1,25,0)+      let testAutogenDir = autogenComponentModulesDir lbi suitecfg+#else+      let testAutogenDir = autogenModulesDir lbi+#endif+      createDirectoryIfMissingVerbose verbosity True testAutogenDir++      -- write autogen'd file+      rewriteFile (testAutogenDir </> "Build_doctests.hs") $ unlines+        [ "module Build_doctests where"         , ""-        , "autogen_dir :: String"-        , "autogen_dir = " ++ show dir+        -- -package-id etc. flags+        , "pkgs :: [String]"+        , "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg)         , ""-        , "deps :: [String]"-        , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+        , "flags :: [String]"+        , "flags = " ++ show (iArgs ++ includeArgs ++ dbFlags ++ cppFlags)+        , ""+        , "module_sources :: [String]"+        , "module_sources = " ++ show (map display module_sources)         ]   where-    formatdeps = map (formatone . snd)-    formatone p = case packageName p of-      PackageName n -> n ++ "-" ++ showVersion (packageVersion p)+    -- we do this check in Setup, as then doctests don't need to depend on Cabal+    isOldCompiler = maybe False id $ do+      a <- simpleParse $ showCompilerId $ compiler lbi+      b <- simpleParse "7.5"+      return $ packageVersion (a :: PackageId) < b +    formatDeps = map formatOne+    formatOne (installedPkgId, pkgId)+      -- The problem is how different cabal executables handle package databases+      -- when doctests depend on the library+      | packageId pkg == pkgId = "-package=" ++ display pkgId+      | otherwise              = "-package-id=" ++ display installedPkgId++    -- From Distribution.Simple.Program.GHC+    packageDbArgs :: [PackageDB] -> [String]+    packageDbArgs | isOldCompiler = packageDbArgsConf+                  | otherwise     = packageDbArgsDb++    -- GHC <7.6 uses '-package-conf' instead of '-package-db'.+    packageDbArgsConf :: [PackageDB] -> [String]+    packageDbArgsConf dbstack = case dbstack of+      (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs+      (GlobalPackageDB:dbs)               -> ("-no-user-package-conf")+                                           : concatMap specific dbs+      _ -> ierror+      where+        specific (SpecificPackageDB db) = [ "-package-conf=" ++ db ]+        specific _                      = ierror+        ierror = error $ "internal error: unexpected package db stack: "+                      ++ show dbstack++    -- GHC >= 7.6 uses the '-package-db' flag. See+    -- https://ghc.haskell.org/trac/ghc/ticket/5977.+    packageDbArgsDb :: [PackageDB] -> [String]+    -- special cases to make arguments prettier in common scenarios+    packageDbArgsDb dbstack = case dbstack of+      (GlobalPackageDB:UserPackageDB:dbs)+        | all isSpecific dbs              -> concatMap single dbs+      (GlobalPackageDB:dbs)+        | all isSpecific dbs              -> "-no-user-package-db"+                                           : concatMap single dbs+      dbs                                 -> "-clear-package-db"+                                           : concatMap single dbs+     where+       single (SpecificPackageDB db) = [ "-package-db=" ++ db ]+       single GlobalPackageDB        = [ "-global-package-db" ]+       single UserPackageDB          = [ "-user-package-db" ]+       isSpecific (SpecificPackageDB _) = True+       isSpecific _                     = False+ testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys+#endif++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+  { buildHook = \pkg lbi hooks flags -> do+     generateBuildModule "doctests" flags pkg lbi+     buildHook simpleUserHooks pkg lbi hooks flags+  }  \end{code}

@@ -1,5 +1,5 @@ name:                servant-swagger-version:             1.1.2+version:             1.1.2.1 synopsis:            Generate Swagger specification for your servant API. description:         Please see README.md homepage:            https://github.com/haskell-servant/servant-swagger@@ -12,6 +12,10 @@ category:            Web build-type:          Custom cabal-version:       >=1.10+tested-with:+  GHC==7.8.4,+  GHC==7.10.3,+  GHC==8.0.2 extra-source-files:     README.md   , CHANGELOG.md@@ -29,6 +33,12 @@   type:     git   location: https://github.com/haskell-servant/servant-swagger.git +custom-setup+  setup-depends:+    base >=4.7 && <4.10,+    Cabal >= 1.18 && <2.0,+    cabal-doctest >=1 && <1.1+ library   ghc-options:         -Wall   exposed-modules:@@ -44,13 +54,13 @@     Servant.Swagger.Internal.TypeLevel.Every     Servant.Swagger.Internal.TypeLevel.TMap   hs-source-dirs:      src-  build-depends:       aeson                     >=0.11.2.0 && <1.1+  build-depends:       aeson                     >=0.11.2.0 && <1.2                      , base                      >=4.7.0.0  && <4.10                      , bytestring                >=0.10.4.0 && <0.11                      , http-media                >=0.6.3    && <0.7                      , insert-ordered-containers >=0.1.0.0  && <0.3-                     , lens                      >=4.7.0.1  && <4.15-                     , servant                   >=0.5      && <0.9+                     , lens                      >=4.7.0.1  && <4.16+                     , servant                   >=0.5      && <0.11                      , swagger2                  >=2.1      && <2.2                      , text                      >=1.2.0.6  && <1.3                      , unordered-containers      >=0.2.5.1  && <0.3@@ -64,11 +74,13 @@   build-depends:     base,     directory >= 1.0,-    doctest >= 0.11 && <0.12,+    doctest >= 0.11.1 && <0.12,+    servant >= 0.10,+    QuickCheck,     filepath   default-language: Haskell2010   hs-source-dirs:   test-  main-is:          DocTest.hs+  main-is:          doctests.hs   type:             exitcode-stdio-1.0  test-suite spec@@ -82,7 +94,7 @@                   , hspec                   , QuickCheck                   , lens-                  , servant+                  , servant >= 0.10                   , servant-swagger                   , swagger2                   , text

@@ -98,7 +98,7 @@ -- In order to generate @'Swagger'@ specification for a servant API, just use @'toSwagger'@: -- -- >>> BSL8.putStrLn $ encode $ toSwagger (Proxy :: Proxy UserAPI)--- {"swagger":"2.0","info":{"version":"","title":""},"paths":{"/":{"get":{"produces":["application/json"],"responses":{"200":{"schema":{"items":{"$ref":"#/definitions/User"},"type":"array"},"description":""}}},"post":{"consumes":["application/json"],"produces":["application/json"],"parameters":[{"required":true,"schema":{"$ref":"#/definitions/User"},"in":"body","name":"body"}],"responses":{"400":{"description":"Invalid `body`"},"200":{"schema":{"$ref":"#/definitions/UserId"},"description":""}}}},"/{user_id}":{"get":{"produces":["application/json"],"parameters":[{"required":true,"in":"path","name":"user_id","type":"integer"}],"responses":{"404":{"description":"`user_id` not found"},"200":{"schema":{"$ref":"#/definitions/User"},"description":""}}}}},"definitions":{"User":{"required":["name","age"],"properties":{"name":{"type":"string"},"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"}},"type":"object"},"UserId":{"type":"integer"}}}+-- {"swagger":"2.0","info":{"version":"","title":""},"paths":{"/":{"get":{"produces":["application/json;charset=utf-8"],"responses":{"200":{"schema":{"items":{"$ref":"#/definitions/User"},"type":"array"},"description":""}}},"post":{"consumes":["application/json;charset=utf-8"],"produces":["application/json;charset=utf-8"],"parameters":[{"required":true,"schema":{"$ref":"#/definitions/User"},"in":"body","name":"body"}],"responses":{"400":{"description":"Invalid `body`"},"200":{"schema":{"$ref":"#/definitions/UserId"},"description":""}}}},"/{user_id}":{"get":{"produces":["application/json;charset=utf-8"],"parameters":[{"required":true,"in":"path","name":"user_id","type":"integer"}],"responses":{"404":{"description":"`user_id` not found"},"200":{"schema":{"$ref":"#/definitions/User"},"description":""}}}}},"definitions":{"User":{"required":["name","age"],"properties":{"name":{"type":"string"},"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"}},"type":"object"},"UserId":{"type":"integer"}}} -- -- By default @'toSwagger'@ will generate specification for all API routes, parameters, headers, responses and data schemas. --@@ -119,7 +119,7 @@ --   & info.license      ?~ "MIT" --   & host              ?~ "example.com" -- :}--- {"swagger":"2.0","info":{"version":"1.0","title":"User API","license":{"name":"MIT"},"description":"This is an API for the Users service"},"host":"example.com","paths":{"/":{"get":{"produces":["application/json"],"responses":{"200":{"schema":{"items":{"$ref":"#/definitions/User"},"type":"array"},"description":""}}},"post":{"consumes":["application/json"],"produces":["application/json"],"parameters":[{"required":true,"schema":{"$ref":"#/definitions/User"},"in":"body","name":"body"}],"responses":{"400":{"description":"Invalid `body`"},"200":{"schema":{"$ref":"#/definitions/UserId"},"description":""}}}},"/{user_id}":{"get":{"produces":["application/json"],"parameters":[{"required":true,"in":"path","name":"user_id","type":"integer"}],"responses":{"404":{"description":"`user_id` not found"},"200":{"schema":{"$ref":"#/definitions/User"},"description":""}}}}},"definitions":{"User":{"required":["name","age"],"properties":{"name":{"type":"string"},"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"}},"type":"object"},"UserId":{"type":"integer"}}}+-- {"swagger":"2.0","info":{"version":"1.0","title":"User API","license":{"name":"MIT"},"description":"This is an API for the Users service"},"host":"example.com","paths":{"/":{"get":{"produces":["application/json;charset=utf-8"],"responses":{"200":{"schema":{"items":{"$ref":"#/definitions/User"},"type":"array"},"description":""}}},"post":{"consumes":["application/json;charset=utf-8"],"produces":["application/json;charset=utf-8"],"parameters":[{"required":true,"schema":{"$ref":"#/definitions/User"},"in":"body","name":"body"}],"responses":{"400":{"description":"Invalid `body`"},"200":{"schema":{"$ref":"#/definitions/UserId"},"description":""}}}},"/{user_id}":{"get":{"produces":["application/json;charset=utf-8"],"parameters":[{"required":true,"in":"path","name":"user_id","type":"integer"}],"responses":{"404":{"description":"`user_id` not found"},"200":{"schema":{"$ref":"#/definitions/User"},"description":""}}}}},"definitions":{"User":{"required":["name","age"],"properties":{"name":{"type":"string"},"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"}},"type":"object"},"UserId":{"type":"integer"}}} -- -- It is also useful to annotate or modify certain endpoints. -- @'subOperations'@ provides a convenient way to zoom into a part of an API.@@ -137,7 +137,7 @@ --   & applyTagsFor getOps  ["get"  & description ?~ "GET operations"] --   & applyTagsFor postOps ["post" & description ?~ "POST operations"] -- :}--- {"swagger":"2.0","info":{"version":"","title":""},"paths":{"/":{"get":{"tags":["get"],"produces":["application/json"],"responses":{"200":{"schema":{"items":{"$ref":"#/definitions/User"},"type":"array"},"description":""}}},"post":{"tags":["post"],"consumes":["application/json"],"produces":["application/json"],"parameters":[{"required":true,"schema":{"$ref":"#/definitions/User"},"in":"body","name":"body"}],"responses":{"400":{"description":"Invalid `body`"},"200":{"schema":{"$ref":"#/definitions/UserId"},"description":""}}}},"/{user_id}":{"get":{"tags":["get"],"produces":["application/json"],"parameters":[{"required":true,"in":"path","name":"user_id","type":"integer"}],"responses":{"404":{"description":"`user_id` not found"},"200":{"schema":{"$ref":"#/definitions/User"},"description":""}}}}},"definitions":{"User":{"required":["name","age"],"properties":{"name":{"type":"string"},"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"}},"type":"object"},"UserId":{"type":"integer"}},"tags":[{"name":"get","description":"GET operations"},{"name":"post","description":"POST operations"}]}+-- {"swagger":"2.0","info":{"version":"","title":""},"paths":{"/":{"get":{"tags":["get"],"produces":["application/json;charset=utf-8"],"responses":{"200":{"schema":{"items":{"$ref":"#/definitions/User"},"type":"array"},"description":""}}},"post":{"tags":["post"],"consumes":["application/json;charset=utf-8"],"produces":["application/json;charset=utf-8"],"parameters":[{"required":true,"schema":{"$ref":"#/definitions/User"},"in":"body","name":"body"}],"responses":{"400":{"description":"Invalid `body`"},"200":{"schema":{"$ref":"#/definitions/UserId"},"description":""}}}},"/{user_id}":{"get":{"tags":["get"],"produces":["application/json;charset=utf-8"],"parameters":[{"required":true,"in":"path","name":"user_id","type":"integer"}],"responses":{"404":{"description":"`user_id` not found"},"200":{"schema":{"$ref":"#/definitions/User"},"description":""}}}}},"definitions":{"User":{"required":["name","age"],"properties":{"name":{"type":"string"},"age":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"}},"type":"object"},"UserId":{"type":"integer"}},"tags":[{"name":"get","description":"GET operations"},{"name":"post","description":"POST operations"}]} -- -- This applies @\"get\"@ tag to the @GET@ endpoints and @\"post\"@ tag to the @POST@ endpoint of the User API. 

@@ -1,30 +0,0 @@-module Main where--import Build_doctests (autogen_dir, deps)-import Control.Applicative-import Control.Monad-import Data.List-import System.Directory-import System.FilePath-import Test.DocTest--main :: IO ()-main = getSources >>= \sources -> doctest $-    "-isrc"-  : ("-i" ++ autogen_dir)-  : "-optP-include"-  : ("-optP" ++ autogen_dir ++ "/cabal_macros.h")-  : "-hide-all-packages"-  : map ("-package="++) deps ++ sources--getSources :: IO [FilePath]-getSources = filter (isSuffixOf ".hs") <$> go "src"-  where-    go dir = do-      (dirs, files) <- getFilesAndDirectories dir-      (files ++) . concat <$> mapM go dirs--getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])-getFilesAndDirectories dir = do-  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir-  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c

@@ -102,7 +102,7 @@                     },                   "404": { "description": "`id` not found" }                 },-              "produces": [ "application/json" ],+              "produces": [ "application/json;charset=utf-8" ],               "parameters":                 [                   {@@ -259,7 +259,7 @@                }             },             "produces":[-               "application/json"+               "application/json;charset=utf-8"             ],             "tags":[                "users"@@ -280,7 +280,7 @@                }             },             "produces":[-               "application/json"+               "application/json;charset=utf-8"             ],             "tags":[                "packages"@@ -301,7 +301,7 @@                }             },             "produces":[-               "application/json"+               "application/json;charset=utf-8"             ],             "parameters":[                {@@ -363,7 +363,7 @@                   "description":""                }             },-            "produces":[ "application/json" ]+            "produces":[ "application/json;charset=utf-8" ]          },          "get":{             "responses":{@@ -374,7 +374,7 @@                   "description":""                }             },-            "produces":[ "application/json" ],+            "produces":[ "application/json;charset=utf-8" ],             "tags":[ "get" ]          }       }

@@ -0,0 +1,25 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Main (doctests)+-- Copyright   :  (C) 2012-14 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- This module provides doctests for a project based on the actual versions+-- of the packages it was built with. It requires a corresponding Setup.lhs+-- to be added to the project+-----------------------------------------------------------------------------+module Main where++import Build_doctests (flags, pkgs, module_sources)+import Data.Foldable (traverse_)+import Test.DocTest++main :: IO ()+main = do+    traverse_ putStrLn args+    doctest args+  where+    args = flags ++ pkgs ++ module_sources