git.iko.soy/servant
on master help sign in
Fix path concatenation, Eq instance, for BaseUrl
commit110196e23fbe2acb07d57cc22a2a97b0575d0c32 authorJulian K. Arni <jkarni@gmail.com> dateWed 7 Oct 2015, 21:07 (11 years ago) parent47f4cec
2 files changed+15−6
compare with master
unifiedsplit
servant-client/src/Servant/Common/BaseUrl.hs+9−2 servant-client/test/Servant/Common/BaseUrlSpec.hs+6−4
servant-client/src/Servant/Common/BaseUrl.hs+9−2
@@ -32,12 +32,19 @@ data BaseUrl = BaseUrl
3232 , baseUrlHost :: String -- ^ host (eg "haskell.org")
3333 , baseUrlPort :: Int -- ^ port (eg 80)
3434 , baseUrlPath :: String -- ^ path (eg "/a/b/c")
35− } deriving (Show, Eq, Ord, Generic)
35+ } deriving (Show, Ord, Generic)
36+
37+instance Eq BaseUrl where
38+ BaseUrl a b c path == BaseUrl a' b' c' path'
39+ = a == a' && b == b' && c == c' && s path == s path'
40+ where s ('/':x) = x
41+ s x = x
3642
3743showBaseUrl :: BaseUrl -> String
3844showBaseUrl (BaseUrl urlscheme host port path) =
39− schemeString ++ "//" ++ host ++ portString ++ path
45+ schemeString ++ "//" ++ host ++ (portString </> path)
4046 where
47+ a </> b = if "/" `isPrefixOf` b || null b then a ++ b else a ++ '/':b
4148 schemeString = case urlscheme of
4249 Http -> "http:"
4350 Https -> "https:"
servant-client/test/Servant/Common/BaseUrlSpec.hs+6−4
@@ -22,7 +22,9 @@ spec = do
2222 it "shows the path of a BaseUrl" $ do
2323 showBaseUrl (BaseUrl Http "foo.com" 80 "api") `shouldBe` "http://foo.com/api"
2424 it "shows the path of an https BaseUrl" $ do
25− showBaseUrl (BaseUrl Https "foo.com" 80 "api") `shouldBe` "https://foo.com/api"
25+ showBaseUrl (BaseUrl Https "foo.com" 443 "api") `shouldBe` "https://foo.com/api"
26+ it "handles leading slashes in path" $ do
27+ showBaseUrl (BaseUrl Https "foo.com" 443 "/api") `shouldBe` "https://foo.com/api"
2628
2729 describe "httpBaseUrl" $ do
2830 it "allows to construct default http BaseUrls" $ do
@@ -34,8 +36,8 @@ spec = do
3436 deepseq (fmap show (parse string )) True
3537
3638 it "is the inverse of showBaseUrl" $ do
37− property $ \ baseUrl ->
38− counterexample (showBaseUrl baseUrl) $ parse (showBaseUrl baseUrl) === Just baseUrl
39+ property $ \ baseUrl -> counterexample (showBaseUrl baseUrl) $
40+ parse (showBaseUrl baseUrl) === Just baseUrl
3941
4042 context "trailing slashes" $ do
4143 it "allows trailing slashes" $ do
@@ -55,7 +57,7 @@ spec = do
5557 parse "http://foo.com/api" `shouldBe` Just (BaseUrl Http "foo.com" 80 "api")
5658
5759 it "rejects ftp urls" $ do
58− (parse "ftp://foo.com") `shouldBe` Nothing
60+ parse "ftp://foo.com" `shouldBe` Nothing
5961
6062instance Arbitrary BaseUrl where
6163 arbitrary = BaseUrl <$>