@@ -15,14 +15,17 @@ spec :: Spec
1515spec = do
1616 describe "showBaseUrl" $ do
1717 it "shows a BaseUrl" $ do
18− showBaseUrl (BaseUrl Http "foo.com" 80) `shouldBe` "http://foo.com"
19−
18+ showBaseUrl (BaseUrl Http "foo.com" 80 "") `shouldBe` "http://foo.com"
2019 it "shows a https BaseUrl" $ do
21− showBaseUrl (BaseUrl Https "foo.com" 443) `shouldBe` "https://foo.com"
20+ showBaseUrl (BaseUrl Https "foo.com" 443 "") `shouldBe` "https://foo.com"
21+ it "shows the path of a BaseUrl" $ do
22+ showBaseUrl (BaseUrl Http "foo.com" 80 "api") `shouldBe` "http://foo.com/api"
23+ it "shows the path of an https BaseUrl" $ do
24+ showBaseUrl (BaseUrl Https "foo.com" 80 "api") `shouldBe` "https://foo.com/api"
2225
2326 describe "httpBaseUrl" $ do
2427 it "allows to construct default http BaseUrls" $ do
25− BaseUrl Http "bar" 80 `shouldBe` BaseUrl Http "bar" 80
28+ BaseUrl Http "bar" 80 "" `shouldBe` BaseUrl Http "bar" 80 ""
2629
2730 describe "parseBaseUrl" $ do
2831 it "is total" $ do
@@ -35,15 +38,21 @@ spec = do
3538 parseBaseUrl (showBaseUrl baseUrl) ===
3639 Right baseUrl
3740
38− it "allows trailing slashes" $ do
39− parseBaseUrl "foo.com/" `shouldBe` Right (BaseUrl Http "foo.com" 80)
41+ context "trailing slashes" $ do
42+ it "allows trailing slashes" $ do
43+ parseBaseUrl "foo.com/" `shouldBe` Right (BaseUrl Http "foo.com" 80 "")
44+ it "allows trailing slashes in paths" $ do
45+ parseBaseUrl "foo.com/api/" `shouldBe` Right (BaseUrl Http "foo.com" 80 "api")
4046
4147 context "urls without scheme" $ do
4248 it "assumes http" $ do
43− parseBaseUrl "foo.com" `shouldBe` Right (BaseUrl Http "foo.com" 80)
49+ parseBaseUrl "foo.com" `shouldBe` Right (BaseUrl Http "foo.com" 80 "")
4450
4551 it "allows port numbers" $ do
46− parseBaseUrl "foo.com:8080" `shouldBe` Right (BaseUrl Http "foo.com" 8080)
52+ parseBaseUrl "foo.com:8080" `shouldBe` Right (BaseUrl Http "foo.com" 8080 "")
53+
54+ it "can parse paths" $ do
55+ parseBaseUrl "http://foo.com/api" `shouldBe` Right (BaseUrl Http "foo.com" 80 "api")
4756
4857 it "rejects ftp urls" $ do
4958 parseBaseUrl "ftp://foo.com" `shouldSatisfy` isLeft
@@ -52,12 +61,13 @@ instance Arbitrary BaseUrl where
5261 arbitrary = BaseUrl <$>
5362 elements [Http, Https] <*>
5463 hostNameGen <*>
55− portGen
64+ portGen <*>
65+ pathGen
5666 where
67+ letters = ['a' .. 'z'] ++ ['A' .. 'Z']
5768 -- this does not perfectly mirror the url standard, but I hope it's good
5869 -- enough.
5970 hostNameGen = do
60− let letters = ['a' .. 'z'] ++ ['A' .. 'Z']
6171 first <- elements letters
6272 middle <- listOf1 $ elements (letters ++ ['0' .. '9'] ++ ['.', '-'])
6373 last <- elements letters
@@ -67,6 +77,7 @@ instance Arbitrary BaseUrl where
6777 (1, return 443) :
6878 (1, choose (1, 20000)) :
6979 []
80+ pathGen = listOf1 . elements $ letters
7081
7182isLeft :: Either a b -> Bool
7283isLeft = either (const True) (const False)