put Req in Servant.Utils.Req

servant.cabal

@@ -32,6 +32,7 @@ library
     Servant.Server
     Servant.Utils.BaseUrl
     Servant.Utils.Client
+    Servant.Utils.Req
     Servant.Utils.Text
   build-depends:
       base >=4.7 && <5

src/Servant/API/Capture.hs

@@ -14,6 +14,7 @@ import Servant.API.Sub
 import Servant.Client
 import Servant.Docs
 import Servant.Server
+import Servant.Utils.Req
 import Servant.Utils.Text
 
 -- * Captures

src/Servant/API/QueryParam.hs

@@ -18,6 +18,7 @@ import Servant.API.Sub
 import Servant.Client
 import Servant.Docs
 import Servant.Server
+import Servant.Utils.Req
 import Servant.Utils.Text
 
 -- * Single query string parameter lookup

src/Servant/API/ReqBody.hs

@@ -13,6 +13,7 @@ import Servant.API.Sub
 import Servant.Client
 import Servant.Docs
 import Servant.Server
+import Servant.Utils.Req
 
 -- * Request Body support
 data ReqBody a

src/Servant/API/Sub.hs

@@ -11,6 +11,7 @@ import Network.Wai
 import Servant.Client
 import Servant.Docs
 import Servant.Server
+import Servant.Utils.Req
 
 -- | The contained API (second argument) can be found under @("/" ++ path)@
 -- (path being the first argument).

src/Servant/Client.hs

@@ -2,17 +2,9 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Servant.Client where
 
-import Control.Concurrent
-import Control.Monad.Catch
-import Data.ByteString.Lazy
 import Data.Proxy
-import Data.Text
-import Network.HTTP.Client hiding (Proxy)
-import Network.HTTP.Types
-import Network.URI
-import System.IO.Unsafe
 
-import Servant.Utils.BaseUrl
+import Servant.Utils.Req
 
 -- * Accessing APIs as a Client
 
@@ -23,53 +15,3 @@ client p = clientWithRoute p defReq
 class HasClient layout where
   type Client layout :: *
   clientWithRoute :: Proxy layout -> Req -> Client layout
-
-data Req = Req
-  { reqPath  :: String
-  , qs       :: QueryText
-  , reqBody  :: ByteString
-  }
-
-defReq :: Req
-defReq = Req "" [] ""
-
-appendToPath :: String -> Req -> Req
-appendToPath p req =
-  req { reqPath = reqPath req ++ "/" ++ p }
-
-appendToQueryString :: Text       -- ^ param name
-                    -> Maybe Text -- ^ param value
-                    -> Req
-                    -> Req
-appendToQueryString pname pvalue req =
-  req { qs = qs req ++ [(pname, pvalue)]
-      }
-
-setRQBody :: ByteString -> Req -> Req
-setRQBody b req = req { reqBody = b }
-
-reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request
-reqToRequest req (BaseUrl scheme host port) = fmap (setrqb . setQS ) $ parseUrl url
-
-  where url = show $ nullURI { uriScheme = case scheme of
-                                  Http  -> "http:"
-                                  Https -> "https:"
-                             , uriAuthority = Just $
-                                 URIAuth { uriUserInfo = ""
-                                         , uriRegName = host
-                                         , uriPort = ":" ++ show port
-                                         }
-                             , uriPath = reqPath req
-                             }
-
-        setrqb r = r { requestBody = RequestBodyLBS (reqBody req) }
-        setQS = setQueryString $ queryTextToQuery (qs req)
-
-{-# NOINLINE __manager #-}
-__manager :: MVar Manager
-__manager = unsafePerformIO (newManager defaultManagerSettings >>= newMVar)
-
-__withGlobalManager :: (Manager -> IO a) -> IO a
-__withGlobalManager action = modifyMVar __manager $ \ manager -> do
-  result <- action manager
-  return (manager, result)

src/Servant/Utils/Client.hs

@@ -2,6 +2,7 @@
 module Servant.Utils.Client where
 
 import Control.Applicative
+import Control.Concurrent
 import Control.Exception
 import Control.Monad
 import Control.Monad.IO.Class
@@ -12,12 +13,23 @@ import Data.Aeson.Types
 import Data.Attoparsec.ByteString
 import Data.ByteString.Lazy
 import Data.String.Conversions
+import Network.HTTP.Client
 import Network.HTTP.Types
-import Servant.Client
 import Servant.Utils.BaseUrl
+import Servant.Utils.Req
+import System.IO.Unsafe
 
 import qualified Network.HTTP.Client as Client
 
+{-# NOINLINE __manager #-}
+__manager :: MVar Manager
+__manager = unsafePerformIO (newManager defaultManagerSettings >>= newMVar)
+
+__withGlobalManager :: (Manager -> IO a) -> IO a
+__withGlobalManager action = modifyMVar __manager $ \ manager -> do
+  result <- action manager
+  return (manager, result)
+
 performRequest :: FromJSON result =>
   Method -> Req -> Int -> BaseUrl -> EitherT String IO result
 performRequest method req wantedStatus host = do

src/Servant/Utils/Req.hs

@@ -0,0 +1,52 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Servant.Utils.Req where
+
+import Control.Monad.Catch
+import Data.ByteString.Lazy
+import Data.Text
+import Network.HTTP.Client hiding (Proxy)
+import Network.HTTP.Types
+import Network.URI
+
+import Servant.Utils.BaseUrl
+
+data Req = Req
+  { reqPath  :: String
+  , qs       :: QueryText
+  , reqBody  :: ByteString
+  }
+
+defReq :: Req
+defReq = Req "" [] ""
+
+appendToPath :: String -> Req -> Req
+appendToPath p req =
+  req { reqPath = reqPath req ++ "/" ++ p }
+
+appendToQueryString :: Text       -- ^ param name
+                    -> Maybe Text -- ^ param value
+                    -> Req
+                    -> Req
+appendToQueryString pname pvalue req =
+  req { qs = qs req ++ [(pname, pvalue)]
+      }
+
+setRQBody :: ByteString -> Req -> Req
+setRQBody b req = req { reqBody = b }
+
+reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request
+reqToRequest req (BaseUrl scheme host port) = fmap (setrqb . setQS ) $ parseUrl url
+
+  where url = show $ nullURI { uriScheme = case scheme of
+                                  Http  -> "http:"
+                                  Https -> "https:"
+                             , uriAuthority = Just $
+                                 URIAuth { uriUserInfo = ""
+                                         , uriRegName = host
+                                         , uriPort = ":" ++ show port
+                                         }
+                             , uriPath = reqPath req
+                             }
+
+        setrqb r = r { requestBody = RequestBodyLBS (reqBody req) }
+        setQS = setQueryString $ queryTextToQuery (qs req)