From 520519bca9a61e4a0b9a4ffdf90610dcb523090c Mon Sep 17 00:00:00 2001
From: Pierre Radermecker <pierrer@pi3r.be>
Date: Wed, 27 May 2015 15:29:56 +0200
Subject: [PATCH] Remove deps on HttpException from http-client

---
 servant-client/src/Servant/Common/BaseUrl.hs | 18 ++++++++++++++----
 1 file changed, 14 insertions(+), 4 deletions(-)

diff --git a/servant-client/src/Servant/Common/BaseUrl.hs b/servant-client/src/Servant/Common/BaseUrl.hs
index 211c414c..3862821d 100644
--- a/servant-client/src/Servant/Common/BaseUrl.hs
+++ b/servant-client/src/Servant/Common/BaseUrl.hs
@@ -1,11 +1,18 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE ViewPatterns #-}
-module Servant.Common.BaseUrl where
+module Servant.Common.BaseUrl (
+  -- * types
+    BaseUrl (..)
+  , InvalidBaseUrlException
+  , Scheme (..)
+  -- * functions
+  , parseBaseUrl
+  , showBaseUrl
+) where
 
-import Control.Monad.Catch (MonadThrow, throwM)
+import Control.Monad.Catch (MonadThrow, throwM, Exception)
 import Data.List
 import GHC.Generics
-import Network.HTTP.Client (HttpException(InvalidUrlException))
 import Network.URI
 import Safe
 import Text.Read
@@ -36,6 +43,9 @@ showBaseUrl (BaseUrl urlscheme host port) =
         (Https, 443) -> ""
         _ -> ":" ++ show port
 
+newtype InvalidBaseUrlException = InvalidBaseUrlException { _getInvalidUrlException :: String } deriving Show
+instance Exception InvalidBaseUrlException
+
 parseBaseUrl :: MonadThrow m => String -> m BaseUrl
 parseBaseUrl s = case parseURI (removeTrailingSlash s) of
   -- This is a rather hacky implementation and should be replaced with something
@@ -49,7 +59,7 @@ parseBaseUrl s = case parseURI (removeTrailingSlash s) of
   Just (URI "https:" (Just (URIAuth "" host "")) "" "" "") ->
     return (BaseUrl Https host 443)
   _ -> if "://" `isInfixOf` s
-    then throwM (InvalidUrlException s "Invalid base URL")
+    then throwM (InvalidBaseUrlException $ "Invalid base URL: " ++ s)
     else parseBaseUrl ("http://" ++ s)
  where
   removeTrailingSlash str = case lastMay str of