Add run*Client functions to provide a way to run requests without Servant types

This commit is contained in:
Andrew Gibiansky 2016-04-05 12:54:04 -07:00
parent 18de12516d
commit b8d723b7ae

View File

@ -7,7 +7,9 @@ module {{title}}.API (
{{title}}Backend,
create{{title}}Client,
run{{title}}Server,
Client(..),
run{{title}}Client,
run{{title}}ClientWithManager,
{{title}}Client,
-- ** Servant
{{title}}API,
) where
@ -23,7 +25,7 @@ import qualified Network.Wai.Handler.Warp as Warp
import qualified Data.Text as T
import Data.Text (Text)
import Servant.Common.BaseUrl(BaseUrl(..))
import Servant.Client (ServantError, client, Scheme(..))
import Servant.Client (ServantError, client, Scheme(Http))
import Data.Proxy (Proxy(..))
import Control.Monad.IO.Class
import Data.Function ((&))
@ -33,7 +35,7 @@ import GHC.Generics (Generic)
import Data.Monoid ((<>))
import Servant.API.Verbs (Verb, StdMethod(HEAD))
import Control.Monad.Except (ExceptT)
import Network.HTTP.Client (Manager)
import Network.HTTP.Client (Manager, newManager, defaultManagerSettings)
-- | HEAD with 200 status code.
@ -131,20 +133,41 @@ data {{title}}Backend m = {{title}}Backend {
{{/hasMore}}{{/operation}}{{/operations}}{{#hasMore}},
{{/hasMore}}{{/apis}}
}
newtype {{title}}Client a = {{title}}Client { runClient :: Manager -> BaseUrl -> ExceptT ServantError IO a }
deriving Functor
instance Applicative {{title}}Client where
pure x = {{title}}Client (\_ _ -> pure x)
({{title}}Client f) <*> ({{title}}Client x) = {{title}}Client (\manager url -> f manager url <*> x manager url)
instance Monad {{title}}Client where
({{title}}Client a) >>= f = {{title}}Client (\manager url -> do
value <- a manager url
runClient (f value) manager url)
instance MonadIO {{title}}Client where
liftIO io = {{title}}Client (\_ _ -> liftIO io)
{{/apiInfo}}
newtype Client a = Client { runClient :: Manager -> BaseUrl -> ExceptT ServantError IO a }
{{#apiInfo}}
create{{title}}Client :: ServerConfig -> {{title}}Backend Client
create{{title}}Client clientConfig = {{title}}Backend{..}
create{{title}}Client :: {{title}}Backend {{title}}Client
create{{title}}Client = {{title}}Backend{..}
where
-- Use a strange variable name to avoid conflicts in autogenerated code... (no hygienic templates)
servantBaseUrlForClient3928 = BaseUrl Http (configHost clientConfig) (configPort clientConfig)
({{#apis}}{{#operations}}{{#operation}}(coerce -> {{operationId}}){{#hasMore}} :<|>
{{/hasMore}}{{/operation}}{{/operations}}{{#hasMore}} :<|>
{{/hasMore}}{{/apis}}) = client (Proxy :: Proxy {{title}}API)
-- | Run requests in the {{title}}Client monad.
run{{title}}Client :: ServerConfig -> {{title}}Client a -> ExceptT ServantError IO a
run{{title}}Client clientConfig cl = do
manager <- liftIO $ newManager defaultManagerSettings
run{{title}}ClientWithManager manager clientConfig cl
-- | Run requests in the {{title}}Client monad using a custom manager.
run{{title}}ClientWithManager :: Manager -> ServerConfig -> {{title}}Client a -> ExceptT ServantError IO a
run{{title}}ClientWithManager manager clientConfig cl =
runClient cl manager $ BaseUrl Http (configHost clientConfig) (configPort clientConfig) ""
{{/apiInfo}}
{{#apiInfo}}