remove unsed type and clean up

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

View File

@ -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,

View File

@ -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

View File

@ -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

View File

@ -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) =

View File

@ -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"