eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

remove unsed type and clean up

Browse source 
merge master and fix conflicts
This commit is contained in:
Brandon Martin 2015-05-08 12:47:19 -06:00
parent eba7d654c2
commit 7c24c2a5a3
5 changed files with 30 additions and 64 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
servant-client/src/Servant/Client.hs
View file

@ -36,8 +36,6 @@ import Network.HTTP.Media
import qualified Network.HTTP.Types as H import qualified Network.HTTP.Types as H
import qualified Network.HTTP.Types.Header as HTTP import qualified Network.HTTP.Types.Header as HTTP
import Servant.API import Servant.API
import Servant.API.ResponseHeaders
import Servant.API.ContentTypes
import Servant.Common.BaseUrl import Servant.Common.BaseUrl
import Servant.Common.Req import Servant.Common.Req
@ -54,15 +52,15 @@ import Servant.Common.Req
-- > getAllBooks :: BaseUrl -> EitherT String IO [Book] -- > getAllBooks :: BaseUrl -> EitherT String IO [Book]
-- > postNewBook :: Book -> BaseUrl -> EitherT String IO Book -- > postNewBook :: Book -> BaseUrl -> EitherT String IO Book
-- > (getAllBooks :<|> postNewBook) = client myApi -- > (getAllBooks :<|> postNewBook) = client myApi
client :: HasClient layout => Proxy layout -> Client layout client :: HasClient layout => Proxy layout -> BaseUrl -> Client layout
client p = clientWithRoute p defReq client p baseurl = clientWithRoute p defReq baseurl
-- | This class lets us define how each API combinator -- | This class lets us define how each API combinator
-- influences the creation of an HTTP request. It's mostly -- influences the creation of an HTTP request. It's mostly
-- an internal class, you can just use 'client'. -- an internal class, you can just use 'client'.
class HasClient layout where class HasClient layout where
type Client' layout :: * type Client' layout :: *
clientWithRoute :: Proxy layout -> Req -> Client layout clientWithRoute :: Proxy layout -> Req -> BaseUrl -> Client' layout
type Client layout = Client' layout type Client layout = Client' layout
@ -80,10 +78,10 @@ type Client layout = Client' layout
-- > postNewBook :: Book -> BaseUrl -> EitherT String IO Book -- > postNewBook :: Book -> BaseUrl -> EitherT String IO Book
-- > (getAllBooks :<|> postNewBook) = client myApi -- > (getAllBooks :<|> postNewBook) = client myApi
instance (HasClient a, HasClient b) => HasClient (a :<|> b) where instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
type Client (a :<|> b) = Client a :<|> Client b type Client' (a :<|> b) = Client' a :<|> Client' b
clientWithRoute Proxy req = clientWithRoute Proxy req baseurl =
clientWithRoute (Proxy :: Proxy a) req :<|> clientWithRoute (Proxy :: Proxy a) req baseurl :<|>
clientWithRoute (Proxy :: Proxy b) req clientWithRoute (Proxy :: Proxy b) req baseurl
-- | If you use a 'Capture' in one of your endpoints in your API, -- | If you use a 'Capture' in one of your endpoints in your API,
-- the corresponding querying function will automatically take -- the corresponding querying function will automatically take
@ -126,7 +124,7 @@ instance
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(MimeUnrender ct a) => HasClient (Delete (ct ': cts) a) where (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 = clientWithRoute Proxy req baseurl =
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl
@ -137,7 +135,7 @@ instance
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
HasClient (Delete (ct ': cts) ()) where 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 = clientWithRoute Proxy req baseurl =
void $ performRequestNoBody H.methodDelete req [204] baseurl void $ performRequestNoBody H.methodDelete req [204] baseurl
@ -149,7 +147,7 @@ instance
#endif #endif
( MimeUnrender ct a, BuildHeadersTo ls ( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Delete (ct ': cts) (Headers ls a)) where ) => 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 clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] baseurl
return $ Headers { getResponse = resp return $ Headers { getResponse = resp
@ -165,7 +163,7 @@ instance
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where (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 = clientWithRoute Proxy req baseurl =
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] baseurl snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] baseurl
@ -176,7 +174,7 @@ instance
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
HasClient (Get (ct ': cts) ()) where 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 = clientWithRoute Proxy req baseurl =
performRequestNoBody H.methodGet req [204] baseurl performRequestNoBody H.methodGet req [204] baseurl
@ -245,7 +243,7 @@ instance
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where (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 = clientWithRoute Proxy req baseurl =
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req [200,201] baseurl snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req [200,201] baseurl
@ -256,7 +254,7 @@ instance
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
HasClient (Post (ct ': cts) ()) where 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 = clientWithRoute Proxy req baseurl =
void $ performRequestNoBody H.methodPost req [204] baseurl void $ performRequestNoBody H.methodPost req [204] baseurl
@ -284,7 +282,7 @@ instance
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where (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 = clientWithRoute Proxy req baseurl =
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req [200,201] baseurl snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req [200,201] baseurl
@ -295,7 +293,7 @@ instance
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
HasClient (Put (ct ': cts) ()) where 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 = clientWithRoute Proxy req baseurl =
void $ performRequestNoBody H.methodPut req [204] baseurl void $ performRequestNoBody H.methodPut req [204] baseurl
@ -323,7 +321,7 @@ instance
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where (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 = clientWithRoute Proxy req baseurl =
snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200,201] baseurl snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200,201] baseurl
@ -334,7 +332,7 @@ instance
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
HasClient (Patch (ct ': cts) ()) where 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 = clientWithRoute Proxy req baseurl =
void $ performRequestNoBody H.methodPatch req [204] baseurl void $ performRequestNoBody H.methodPatch req [204] baseurl
@ -609,8 +607,8 @@ instance (KnownSymbol sym, HasClient sublayout)
instance HasClient Raw where instance HasClient Raw where
type Client' Raw = H.Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString) type Client' Raw = H.Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
clientWithRoute :: Proxy Raw -> Req -> Client Raw clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Client' Raw
clientWithRoute Proxy req httpMethod baseurl = do clientWithRoute Proxy req baseurl httpMethod = do
performRequest httpMethod req (const True) baseurl performRequest httpMethod req (const True) baseurl
-- | If you use a 'ReqBody' in one of your endpoints in your API, -- | If you use a 'ReqBody' in one of your endpoints in your API,

6
servant-client/test/Servant/ClientSpec.hs
View file

@ -81,7 +81,6 @@ type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String]
type Api = type Api =
"get" :> Get '[JSON] Person "get" :> Get '[JSON] Person
:<|> "delete" :> Delete '[JSON] () :<|> "delete" :> Delete '[JSON] ()
:<|> "deleteString" :> Delete '[JSON] String
:<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
:<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
:<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
@ -106,7 +105,6 @@ server :: Application
server = serve api ( server = serve api (
return alice return alice
:<|> return () :<|> return ()
:<|> return "ok"
:<|> (\ name -> return $ Person name 0) :<|> (\ name -> return $ Person name 0)
:<|> return :<|> return
:<|> (\ name -> case name of :<|> (\ name -> case name of
@ -267,14 +265,12 @@ spec = withServer $ \ baseUrl -> do
Left FailureResponse{..} <- runEitherT getResponse Left FailureResponse{..} <- runEitherT getResponse
responseStatus `shouldBe` (Status 500 "error message") responseStatus `shouldBe` (Status 500 "error message")
mapM_ test $ mapM_ test $
(WrappedApi (Proxy :: Proxy Delete), "Delete") : (WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") :
(WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") : (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
(WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Post") : (WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Post") :
(WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Put") : (WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Put") :
[] []
type RawRight = (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString)
failSpec :: IO () failSpec :: IO ()
failSpec = withFailServer $ \ baseUrl -> do failSpec = withFailServer $ \ baseUrl -> do
let getGet :: EitherT ServantError IO Person let getGet :: EitherT ServantError IO Person

1
servant-docs/example/greet.hs
View file

@ -8,7 +8,6 @@
import Control.Lens import Control.Lens
import Data.Aeson import Data.Aeson
import Data.Proxy import Data.Proxy
import Data.ByteString.Conversion
import Data.String.Conversions import Data.String.Conversions
import Data.Text (Text) import Data.Text (Text)
import GHC.Generics import GHC.Generics

26
servant-docs/src/Servant/Docs/Internal.hs
View file

@ -40,7 +40,6 @@ import GHC.Generics
import GHC.TypeLits import GHC.TypeLits
import Servant.API import Servant.API
import Servant.API.ContentTypes import Servant.API.ContentTypes
import Servant.API.ResponseHeaders
import Servant.Utils.Links import Servant.Utils.Links
import qualified Data.HashMap.Strict as HM 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) toSample _ = toSample (Proxy :: Proxy a)
toSamples _ = toSamples (Proxy :: Proxy a) toSamples _ = toSamples (Proxy :: Proxy a)
class AllHeaderSamples ls where class AllHeaderSamples ls where
allHeaderToSample :: Proxy ls -> [HTTP.Header] allHeaderToSample :: Proxy ls -> [HTTP.Header]
@ -684,15 +684,11 @@ instance
t = Proxy :: Proxy cts t = Proxy :: Proxy cts
p = Proxy :: Proxy a p = Proxy :: Proxy a
<<<<<<< HEAD
instance instance
#if MIN_VERSION_base(4,8,0) #if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLe #-} {-# OVERLAPPABLe #-}
#endif #endif
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) (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 => HasDocs (Get cts a) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
single endpoint' action' single endpoint' action'
@ -703,15 +699,11 @@ instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)
t = Proxy :: Proxy cts t = Proxy :: Proxy cts
p = Proxy :: Proxy a p = Proxy :: Proxy a
<<<<<<< HEAD
instance instance
#if MIN_VERSION_base(4,8,0) #if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts (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) ) , AllHeaderSamples ls , GetHeaders (HList ls) )
=> HasDocs (Get cts (Headers ls a)) where => HasDocs (Get cts (Headers ls a)) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
@ -734,15 +726,11 @@ instance (KnownSymbol sym, HasDocs sublayout)
action' = over headers (|> headername) action action' = over headers (|> headername) action
headername = pack $ symbolVal (Proxy :: Proxy sym) headername = pack $ symbolVal (Proxy :: Proxy sym)
<<<<<<< HEAD
instance instance
#if MIN_VERSION_base(4,8,0) #if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) (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 => HasDocs (Post cts a) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
single endpoint' action' single endpoint' action'
@ -754,15 +742,11 @@ instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)
t = Proxy :: Proxy cts t = Proxy :: Proxy cts
p = Proxy :: Proxy a p = Proxy :: Proxy a
<<<<<<< HEAD
instance instance
#if MIN_VERSION_base(4,8,0) #if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts (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) ) , AllHeaderSamples ls , GetHeaders (HList ls) )
=> HasDocs (Post cts (Headers ls a)) where => HasDocs (Post cts (Headers ls a)) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
@ -777,15 +761,11 @@ instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts
t = Proxy :: Proxy cts t = Proxy :: Proxy cts
p = Proxy :: Proxy a p = Proxy :: Proxy a
<<<<<<< HEAD
instance instance
#if MIN_VERSION_base(4,8,0) #if MIN_VERSION_base(4,8,0)
{-# OVERLAPPABLE #-} {-# OVERLAPPABLE #-}
#endif #endif
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) (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 => HasDocs (Put cts a) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =
single endpoint' action' single endpoint' action'
@ -797,15 +777,11 @@ instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)
t = Proxy :: Proxy cts t = Proxy :: Proxy cts
p = Proxy :: Proxy a p = Proxy :: Proxy a
<<<<<<< HEAD
instance instance
#if MIN_VERSION_base(4,8,0) #if MIN_VERSION_base(4,8,0)
{-# OVERLAPPING #-} {-# OVERLAPPING #-}
#endif #endif
(ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts (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) ) , AllHeaderSamples ls , GetHeaders (HList ls) )
=> HasDocs (Put cts (Headers ls a)) where => HasDocs (Put cts (Headers ls a)) where
docsFor Proxy (endpoint, action) = docsFor Proxy (endpoint, action) =

17
servant-examples/hackage/hackage.hs
View file

@ -54,29 +54,26 @@ instance FromJSON Package
hackageAPI :: Proxy HackageAPI hackageAPI :: Proxy HackageAPI
hackageAPI = Proxy hackageAPI = Proxy
getUsers :: BaseUrl -> EitherT ServantError IO [UserSummary] getUsers :: EitherT ServantError IO [UserSummary]
getUser :: Username -> BaseUrl -> EitherT ServantError IO UserDetailed getUser :: Username -> EitherT ServantError IO UserDetailed
getPackages :: BaseUrl -> EitherT ServantError IO [Package] getPackages :: EitherT ServantError IO [Package]
getUsers :<|> getUser :<|> getPackages = client hackageAPI getUsers :<|> getUser :<|> getPackages = client hackageAPI $ BaseUrl Http "hackage.haskell.org" 80
run :: (BaseUrl -> r) -> r
run f = f (BaseUrl Http "hackage.haskell.org" 80)
main :: IO () main :: IO ()
main = print =<< uselessNumbers main = print =<< uselessNumbers
uselessNumbers :: IO (Either ServantError ()) uselessNumbers :: IO (Either ServantError ())
uselessNumbers = runEitherT $ do uselessNumbers = runEitherT $ do
users <- run getUsers users <- getUsers
liftIO . putStrLn $ show (length users) ++ " users" liftIO . putStrLn $ show (length users) ++ " users"
user <- liftIO $ do user <- liftIO $ do
putStrLn "Enter a valid hackage username" putStrLn "Enter a valid hackage username"
T.getLine T.getLine
userDetailed <- run (getUser user) userDetailed <- (getUser user)
liftIO . T.putStrLn $ user <> " maintains " <> T.pack (show (length $ groups userDetailed)) <> " packages" liftIO . T.putStrLn $ user <> " maintains " <> T.pack (show (length $ groups userDetailed)) <> " packages"
packages <- run getPackages packages <- getPackages
let monadPackages = filter (isMonadPackage . packageName) packages let monadPackages = filter (isMonadPackage . packageName) packages
liftIO . putStrLn $ show (length monadPackages) ++ " monad packages" liftIO . putStrLn $ show (length monadPackages) ++ " monad packages"