Allow BaseUrl to specify whether root has slash.

Previously this would cause an error with double slashes.

servant-client/src/Servant/Client/Internal/HttpClient.hs

@@ -25,6 +25,7 @@ import           Control.Monad.Trans.Control (MonadBaseControl (..))
 import           Control.Monad.Trans.Except
 import           Data.ByteString.Builder     (toLazyByteString)
 import qualified Data.ByteString.Lazy        as BSL
+import qualified Data.ByteString.Lazy.Char8  as BSLC
 import           Data.Foldable               (toList, for_)
 import           Data.Functor.Alt            (Alt (..))
 import           Data.Maybe                  (maybeToList)
@@ -166,7 +167,7 @@ requestToClientRequest burl r = Client.defaultRequest
   , Client.port = baseUrlPort burl
   , Client.path = BSL.toStrict
                 $ fromString (baseUrlPath burl)
-               <> toLazyByteString (requestPath r)
+               </> toLazyByteString (requestPath r)
   , Client.queryString = renderQuery True . toList $ requestQueryString r
   , Client.requestHeaders =
     maybeToList acceptHdr ++ maybeToList contentTypeHdr ++ headers
@@ -197,3 +198,13 @@ catchConnectionError :: IO a -> IO (Either ServantError a)
 catchConnectionError action =
   catch (Right <$> action) $ \e ->
     pure . Left . ConnectionError . T.pack $ show (e :: Client.HttpException)
+
+-- Concatenate path components, making sure there's exactly one slash between
+-- them, unless they're both empty.
+(</>) :: BSL.ByteString -> BSL.ByteString -> BSL.ByteString
+a </> b = case (BSLC.unsnoc a, BSLC.uncons b) of
+  (Just (_, '/')     , Just ('/', tailB)) -> a <> tailB
+  (Just (_, '/')     , _                ) -> a <> b
+  (_                 , Just ('/', _    )) -> a <> b
+  (_                 , Nothing          ) -> a
+  (_                 , _                ) -> a <> "/" <> b

servant-client/test/Servant/ClientSpec.hs

@@ -367,6 +367,18 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
         Left e -> assertFailure $ show e
         Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
 
+    describe "baseUrl" $ do
+
+      it "accepts urls with trailing slashes without modifying non-root paths"
+        $ \(_, burl) -> do
+          left show <$> runClient getGet (burl { baseUrlPath = baseUrlPath burl ++ "/"} )
+              `shouldReturn` Right alice
+
+      it "still works with root paths when it has a trailing slash"
+        $ \(_, burl) -> do
+          left show <$> runClient getRoot (burl { baseUrlPath = baseUrlPath burl ++ "/"} )
+              `shouldReturn` Right carol
+
     modifyMaxSuccess (const 20) $ do
       it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->
         property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->