git.iko.soy/servant
on master help sign in
Fix path concatenation, Eq instance, for BaseUrl
110196eJulian K. Arni
servant-client/src/Servant/Common/BaseUrl.hs+9−2
compare with master
unifiedsplit
@@ -32,12 +32,19 @@ data BaseUrl = BaseUrl
32 , baseUrlHost :: String -- ^ host (eg "haskell.org")
32 , baseUrlHost :: String -- ^ host (eg "haskell.org")
33 , baseUrlPort :: Int -- ^ port (eg 80)
33 , baseUrlPort :: Int -- ^ port (eg 80)
34 , baseUrlPath :: String -- ^ path (eg "/a/b/c")
34 , 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
36
42
37showBaseUrl :: BaseUrl -> String
43showBaseUrl :: BaseUrl -> String
38showBaseUrl (BaseUrl urlscheme host port path) =
44showBaseUrl (BaseUrl urlscheme host port path) =
39− schemeString ++ "//" ++ host ++ portString ++ path
45+ schemeString ++ "//" ++ host ++ (portString </> path)
40 where
46 where
47+ a </> b = if "/" `isPrefixOf` b || null b then a ++ b else a ++ '/':b
41 schemeString = case urlscheme of
48 schemeString = case urlscheme of
42 Http -> "http:"
49 Http -> "http:"
43 Https -> "https:"
50 Https -> "https:"
servant-client/test/Servant/Common/BaseUrlSpec.hs+6−4
@@ -22,7 +22,9 @@ spec = do
22 it "shows the path of a BaseUrl" $ do
22 it "shows the path of a BaseUrl" $ do
23 showBaseUrl (BaseUrl Http "foo.com" 80 "api") `shouldBe` "http://foo.com/api"
23 showBaseUrl (BaseUrl Http "foo.com" 80 "api") `shouldBe` "http://foo.com/api"
24 it "shows the path of an https BaseUrl" $ do
24 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"
26
28
27 describe "httpBaseUrl" $ do
29 describe "httpBaseUrl" $ do
28 it "allows to construct default http BaseUrls" $ do
30 it "allows to construct default http BaseUrls" $ do
@@ -34,8 +36,8 @@ spec = do
34 deepseq (fmap show (parse string )) True
36 deepseq (fmap show (parse string )) True
35
37
36 it "is the inverse of showBaseUrl" $ do
38 it "is the inverse of showBaseUrl" $ do
37− property $ \ baseUrl ->
39+ property $ \ baseUrl -> counterexample (showBaseUrl baseUrl) $
38− counterexample (showBaseUrl baseUrl) $ parse (showBaseUrl baseUrl) === Just baseUrl
40+ parse (showBaseUrl baseUrl) === Just baseUrl
39
41
40 context "trailing slashes" $ do
42 context "trailing slashes" $ do
41 it "allows trailing slashes" $ do
43 it "allows trailing slashes" $ do
@@ -55,7 +57,7 @@ spec = do
55 parse "http://foo.com/api" `shouldBe` Just (BaseUrl Http "foo.com" 80 "api")
57 parse "http://foo.com/api" `shouldBe` Just (BaseUrl Http "foo.com" 80 "api")
56
58
57 it "rejects ftp urls" $ do
59 it "rejects ftp urls" $ do
58− (parse "ftp://foo.com") `shouldBe` Nothing
60+ parse "ftp://foo.com" `shouldBe` Nothing
59
61
60instance Arbitrary BaseUrl where
62instance Arbitrary BaseUrl where
61 arbitrary = BaseUrl <$>
63 arbitrary = BaseUrl <$>