eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Fix path concatenation, Eq instance, for BaseUrl

Browse source
This commit is contained in:
Julian K. Arni 2015-10-07 21:07:07 +02:00
parent 47f4cec53b
commit 110196e23f
2 changed files with 15 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
servant-client/src/Servant/Common/BaseUrl.hs
View file

@ -32,12 +32,19 @@ data BaseUrl = BaseUrl
, baseUrlHost :: String -- ^ host (eg "haskell.org") , baseUrlHost :: String -- ^ host (eg "haskell.org")
, baseUrlPort :: Int -- ^ port (eg 80) , baseUrlPort :: Int -- ^ port (eg 80)
, baseUrlPath :: String -- ^ path (eg "/a/b/c") , baseUrlPath :: String -- ^ path (eg "/a/b/c")
} deriving (Show, Eq, Ord, Generic) } deriving (Show, Ord, Generic)
instance Eq BaseUrl where
BaseUrl a b c path == BaseUrl a' b' c' path'
= a == a' && b == b' && c == c' && s path == s path'
where s ('/':x) = x
s x = x
showBaseUrl :: BaseUrl -> String showBaseUrl :: BaseUrl -> String
showBaseUrl (BaseUrl urlscheme host port path) = showBaseUrl (BaseUrl urlscheme host port path) =
schemeString ++ "//" ++ host ++ portString ++ path schemeString ++ "//" ++ host ++ (portString </> path)
where where
a </> b = if "/" `isPrefixOf` b || null b then a ++ b else a ++ '/':b
schemeString = case urlscheme of schemeString = case urlscheme of
Http -> "http:" Http -> "http:"
Https -> "https:" Https -> "https:"

10
servant-client/test/Servant/Common/BaseUrlSpec.hs
View file

@ -22,7 +22,9 @@ spec = do
it "shows the path of a BaseUrl" $ do it "shows the path of a BaseUrl" $ do
showBaseUrl (BaseUrl Http "foo.com" 80 "api") `shouldBe` "http://foo.com/api" showBaseUrl (BaseUrl Http "foo.com" 80 "api") `shouldBe` "http://foo.com/api"
it "shows the path of an https BaseUrl" $ do it "shows the path of an https BaseUrl" $ do
showBaseUrl (BaseUrl Https "foo.com" 80 "api") `shouldBe` "https://foo.com/api" showBaseUrl (BaseUrl Https "foo.com" 443 "api") `shouldBe` "https://foo.com/api"
it "handles leading slashes in path" $ do
showBaseUrl (BaseUrl Https "foo.com" 443 "/api") `shouldBe` "https://foo.com/api"
describe "httpBaseUrl" $ do describe "httpBaseUrl" $ do
it "allows to construct default http BaseUrls" $ do it "allows to construct default http BaseUrls" $ do
@ -34,8 +36,8 @@ spec = do
deepseq (fmap show (parse string )) True deepseq (fmap show (parse string )) True
it "is the inverse of showBaseUrl" $ do it "is the inverse of showBaseUrl" $ do
property $ \ baseUrl -> property $ \ baseUrl -> counterexample (showBaseUrl baseUrl) $
counterexample (showBaseUrl baseUrl) $ parse (showBaseUrl baseUrl) === Just baseUrl parse (showBaseUrl baseUrl) === Just baseUrl
context "trailing slashes" $ do context "trailing slashes" $ do
it "allows trailing slashes" $ do it "allows trailing slashes" $ do
@ -55,7 +57,7 @@ spec = do
parse "http://foo.com/api" `shouldBe` Just (BaseUrl Http "foo.com" 80 "api") parse "http://foo.com/api" `shouldBe` Just (BaseUrl Http "foo.com" 80 "api")
it "rejects ftp urls" $ do it "rejects ftp urls" $ do
(parse "ftp://foo.com") `shouldBe` Nothing parse "ftp://foo.com" `shouldBe` Nothing
instance Arbitrary BaseUrl where instance Arbitrary BaseUrl where
arbitrary = BaseUrl <$> arbitrary = BaseUrl <$>