From 7c24c2a5a3c32bba28a7332984790d5306b05238 Mon Sep 17 00:00:00 2001 From: Brandon Martin Date: Fri, 8 May 2015 12:47:19 -0600 Subject: [PATCH] remove unsed type and clean up merge master and fix conflicts --- servant-client/src/Servant/Client.hs | 42 +++++++++++------------ servant-client/test/Servant/ClientSpec.hs | 6 +--- servant-docs/example/greet.hs | 1 - servant-docs/src/Servant/Docs/Internal.hs | 26 +------------- servant-examples/hackage/hackage.hs | 19 +++++----- 5 files changed, 30 insertions(+), 64 deletions(-) diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index 4b302df8..a3252255 100644 --- a/servant-client/src/Servant/Client.hs +++ b/servant-client/src/Servant/Client.hs @@ -36,8 +36,6 @@ import Network.HTTP.Media import qualified Network.HTTP.Types as H import qualified Network.HTTP.Types.Header as HTTP import Servant.API -import Servant.API.ResponseHeaders -import Servant.API.ContentTypes import Servant.Common.BaseUrl import Servant.Common.Req @@ -54,15 +52,15 @@ import Servant.Common.Req -- > getAllBooks :: BaseUrl -> EitherT String IO [Book] -- > postNewBook :: Book -> BaseUrl -> EitherT String IO Book -- > (getAllBooks :<|> postNewBook) = client myApi -client :: HasClient layout => Proxy layout -> Client layout -client p = clientWithRoute p defReq +client :: HasClient layout => Proxy layout -> BaseUrl -> Client layout +client p baseurl = clientWithRoute p defReq baseurl -- | This class lets us define how each API combinator -- influences the creation of an HTTP request. It's mostly -- an internal class, you can just use 'client'. class HasClient layout where type Client' layout :: * - clientWithRoute :: Proxy layout -> Req -> Client layout + clientWithRoute :: Proxy layout -> Req -> BaseUrl -> Client' layout type Client layout = Client' layout @@ -80,10 +78,10 @@ type Client layout = Client' layout -- > postNewBook :: Book -> BaseUrl -> EitherT String IO Book -- > (getAllBooks :<|> postNewBook) = client myApi instance (HasClient a, HasClient b) => HasClient (a :<|> b) where - type Client (a :<|> b) = Client a :<|> Client b - clientWithRoute Proxy req = - clientWithRoute (Proxy :: Proxy a) req :<|> - clientWithRoute (Proxy :: Proxy b) req + type Client' (a :<|> b) = Client' a :<|> Client' b + clientWithRoute Proxy req baseurl = + clientWithRoute (Proxy :: Proxy a) req baseurl :<|> + clientWithRoute (Proxy :: Proxy b) req baseurl -- | If you use a 'Capture' in one of your endpoints in your API, -- the corresponding querying function will automatically take @@ -126,7 +124,7 @@ instance {-# OVERLAPPABLE #-} #endif (MimeUnrender ct a) => HasClient (Delete (ct ': cts) a) where - type Client (Delete (ct ': cts) a) = EitherT ServantError IO a + type Client' (Delete (ct ': cts) a) = EitherT ServantError IO a clientWithRoute Proxy req baseurl = snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl @@ -137,7 +135,7 @@ instance {-# OVERLAPPING #-} #endif HasClient (Delete (ct ': cts) ()) where - type Client (Delete (ct ': cts) ()) = EitherT ServantError IO () + type Client' (Delete (ct ': cts) ()) = EitherT ServantError IO () clientWithRoute Proxy req baseurl = void $ performRequestNoBody H.methodDelete req [204] baseurl @@ -149,7 +147,7 @@ instance #endif ( MimeUnrender ct a, BuildHeadersTo ls ) => HasClient (Delete (ct ': cts) (Headers ls a)) where - type Client (Delete (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a) + type Client' (Delete (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a) clientWithRoute Proxy req baseurl = do (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl return $ Headers { getResponse = resp @@ -165,7 +163,7 @@ instance {-# OVERLAPPABLE #-} #endif (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where - type Client (Get (ct ': cts) result) = EitherT ServantError IO result + type Client' (Get (ct ': cts) result) = EitherT ServantError IO result clientWithRoute Proxy req baseurl = snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] baseurl @@ -176,7 +174,7 @@ instance {-# OVERLAPPING #-} #endif HasClient (Get (ct ': cts) ()) where - type Client (Get (ct ': cts) ()) = EitherT ServantError IO () + type Client' (Get (ct ': cts) ()) = EitherT ServantError IO () clientWithRoute Proxy req baseurl = performRequestNoBody H.methodGet req [204] baseurl @@ -245,7 +243,7 @@ instance {-# OVERLAPPABLE #-} #endif (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where - type Client (Post (ct ': cts) a) = EitherT ServantError IO a + type Client' (Post (ct ': cts) a) = EitherT ServantError IO a clientWithRoute Proxy req baseurl = snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req [200,201] baseurl @@ -256,7 +254,7 @@ instance {-# OVERLAPPING #-} #endif HasClient (Post (ct ': cts) ()) where - type Client (Post (ct ': cts) ()) = EitherT ServantError IO () + type Client' (Post (ct ': cts) ()) = EitherT ServantError IO () clientWithRoute Proxy req baseurl = void $ performRequestNoBody H.methodPost req [204] baseurl @@ -284,7 +282,7 @@ instance {-# OVERLAPPABLE #-} #endif (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where - type Client (Put (ct ': cts) a) = EitherT ServantError IO a + type Client' (Put (ct ': cts) a) = EitherT ServantError IO a clientWithRoute Proxy req baseurl = snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req [200,201] baseurl @@ -295,7 +293,7 @@ instance {-# OVERLAPPING #-} #endif HasClient (Put (ct ': cts) ()) where - type Client (Put (ct ': cts) ()) = EitherT ServantError IO () + type Client' (Put (ct ': cts) ()) = EitherT ServantError IO () clientWithRoute Proxy req baseurl = void $ performRequestNoBody H.methodPut req [204] baseurl @@ -323,7 +321,7 @@ instance {-# OVERLAPPABLE #-} #endif (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where - type Client (Patch (ct ': cts) a) = EitherT ServantError IO a + type Client' (Patch (ct ': cts) a) = EitherT ServantError IO a clientWithRoute Proxy req baseurl = snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200,201] baseurl @@ -334,7 +332,7 @@ instance {-# OVERLAPPING #-} #endif HasClient (Patch (ct ': cts) ()) where - type Client (Patch (ct ': cts) ()) = EitherT ServantError IO () + type Client' (Patch (ct ': cts) ()) = EitherT ServantError IO () clientWithRoute Proxy req baseurl = void $ performRequestNoBody H.methodPatch req [204] baseurl @@ -609,8 +607,8 @@ instance (KnownSymbol sym, HasClient sublayout) instance HasClient Raw where type Client' Raw = H.Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString) - clientWithRoute :: Proxy Raw -> Req -> Client Raw - clientWithRoute Proxy req httpMethod baseurl = do + clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Client' Raw + clientWithRoute Proxy req baseurl httpMethod = do performRequest httpMethod req (const True) baseurl -- | If you use a 'ReqBody' in one of your endpoints in your API, diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index 5c92813f..35e219e4 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/servant-client/test/Servant/ClientSpec.hs @@ -81,7 +81,6 @@ type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String] type Api = "get" :> Get '[JSON] Person :<|> "delete" :> Delete '[JSON] () - :<|> "deleteString" :> Delete '[JSON] String :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person @@ -106,7 +105,6 @@ server :: Application server = serve api ( return alice :<|> return () - :<|> return "ok" :<|> (\ name -> return $ Person name 0) :<|> return :<|> (\ name -> case name of @@ -267,14 +265,12 @@ spec = withServer $ \ baseUrl -> do Left FailureResponse{..} <- runEitherT getResponse responseStatus `shouldBe` (Status 500 "error message") mapM_ test $ - (WrappedApi (Proxy :: Proxy Delete), "Delete") : + (WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") : (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") : (WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Post") : (WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Put") : [] -type RawRight = (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString) - failSpec :: IO () failSpec = withFailServer $ \ baseUrl -> do let getGet :: EitherT ServantError IO Person diff --git a/servant-docs/example/greet.hs b/servant-docs/example/greet.hs index 1e517080..1835b290 100644 --- a/servant-docs/example/greet.hs +++ b/servant-docs/example/greet.hs @@ -8,7 +8,6 @@ import Control.Lens import Data.Aeson import Data.Proxy -import Data.ByteString.Conversion import Data.String.Conversions import Data.Text (Text) import GHC.Generics diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index f02b8bc4..f0e18456 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -40,7 +40,6 @@ import GHC.Generics import GHC.TypeLits import Servant.API import Servant.API.ContentTypes -import Servant.API.ResponseHeaders import Servant.Utils.Links import qualified Data.HashMap.Strict as HM @@ -396,6 +395,7 @@ instance ToSample a b => ToSample (Headers ls a) b where toSample _ = toSample (Proxy :: Proxy a) toSamples _ = toSamples (Proxy :: Proxy a) + class AllHeaderSamples ls where allHeaderToSample :: Proxy ls -> [HTTP.Header] @@ -684,15 +684,11 @@ instance t = Proxy :: Proxy cts p = Proxy :: Proxy a -<<<<<<< HEAD instance #if MIN_VERSION_base(4,8,0) {-# OVERLAPPABLe #-} #endif (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) -======= -instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) ->>>>>>> Headers for all => HasDocs (Get cts a) where docsFor Proxy (endpoint, action) = single endpoint' action' @@ -703,15 +699,11 @@ instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) t = Proxy :: Proxy cts p = Proxy :: Proxy a -<<<<<<< HEAD instance #if MIN_VERSION_base(4,8,0) {-# OVERLAPPING #-} #endif (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts -======= -instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts ->>>>>>> Headers for all , AllHeaderSamples ls , GetHeaders (HList ls) ) => HasDocs (Get cts (Headers ls a)) where docsFor Proxy (endpoint, action) = @@ -734,15 +726,11 @@ instance (KnownSymbol sym, HasDocs sublayout) action' = over headers (|> headername) action headername = pack $ symbolVal (Proxy :: Proxy sym) -<<<<<<< HEAD instance #if MIN_VERSION_base(4,8,0) {-# OVERLAPPABLE #-} #endif (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) -======= -instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) ->>>>>>> Headers for all => HasDocs (Post cts a) where docsFor Proxy (endpoint, action) = single endpoint' action' @@ -754,15 +742,11 @@ instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) t = Proxy :: Proxy cts p = Proxy :: Proxy a -<<<<<<< HEAD instance #if MIN_VERSION_base(4,8,0) {-# OVERLAPPING #-} #endif (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts -======= -instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts ->>>>>>> Headers for all , AllHeaderSamples ls , GetHeaders (HList ls) ) => HasDocs (Post cts (Headers ls a)) where docsFor Proxy (endpoint, action) = @@ -777,15 +761,11 @@ instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts t = Proxy :: Proxy cts p = Proxy :: Proxy a -<<<<<<< HEAD instance #if MIN_VERSION_base(4,8,0) {-# OVERLAPPABLE #-} #endif (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) -======= -instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) ->>>>>>> Headers for all => HasDocs (Put cts a) where docsFor Proxy (endpoint, action) = single endpoint' action' @@ -797,15 +777,11 @@ instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) t = Proxy :: Proxy cts p = Proxy :: Proxy a -<<<<<<< HEAD instance #if MIN_VERSION_base(4,8,0) {-# OVERLAPPING #-} #endif (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts -======= -instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts ->>>>>>> Headers for all , AllHeaderSamples ls , GetHeaders (HList ls) ) => HasDocs (Put cts (Headers ls a)) where docsFor Proxy (endpoint, action) = diff --git a/servant-examples/hackage/hackage.hs b/servant-examples/hackage/hackage.hs index 4df8052b..e205fc12 100644 --- a/servant-examples/hackage/hackage.hs +++ b/servant-examples/hackage/hackage.hs @@ -54,29 +54,26 @@ instance FromJSON Package hackageAPI :: Proxy HackageAPI hackageAPI = Proxy -getUsers :: BaseUrl -> EitherT ServantError IO [UserSummary] -getUser :: Username -> BaseUrl -> EitherT ServantError IO UserDetailed -getPackages :: BaseUrl -> EitherT ServantError IO [Package] -getUsers :<|> getUser :<|> getPackages = client hackageAPI - -run :: (BaseUrl -> r) -> r -run f = f (BaseUrl Http "hackage.haskell.org" 80) +getUsers :: EitherT ServantError IO [UserSummary] +getUser :: Username -> EitherT ServantError IO UserDetailed +getPackages :: EitherT ServantError IO [Package] +getUsers :<|> getUser :<|> getPackages = client hackageAPI $ BaseUrl Http "hackage.haskell.org" 80 main :: IO () main = print =<< uselessNumbers uselessNumbers :: IO (Either ServantError ()) uselessNumbers = runEitherT $ do - users <- run getUsers + users <- getUsers liftIO . putStrLn $ show (length users) ++ " users" user <- liftIO $ do putStrLn "Enter a valid hackage username" T.getLine - userDetailed <- run (getUser user) + userDetailed <- (getUser user) liftIO . T.putStrLn $ user <> " maintains " <> T.pack (show (length $ groups userDetailed)) <> " packages" - - packages <- run getPackages + + packages <- getPackages let monadPackages = filter (isMonadPackage . packageName) packages liftIO . putStrLn $ show (length monadPackages) ++ " monad packages"