d33214d · servant-quickcheck

git.iko.soy/servant-quickcheck

on master help sign in

Fix Path delimiting:

d33214dNick B10 years ago

src/Servant/QuickCheck/Internal/HasGenRequest.hs+6−1

compare with master

unifiedsplit

@@ -17,6 +17,7 @@ import Servant.Client (BaseUrl (..), Scheme (..))

17import Test.QuickCheck (Arbitrary (..), Gen, elements, oneof)

19import qualified Data.ByteString as BS

20+import qualified Data.ByteString.Internal as BS (c2w)

22class HasGenRequest a where

23class HasGenRequest a where

@@ -31,7 +32,11 @@ instance (HasGenRequest a, HasGenRequest b) => HasGenRequest (a :<|> b) where

31instance (KnownSymbol path, HasGenRequest b) => HasGenRequest (path :> b) where

32instance (KnownSymbol path, HasGenRequest b) => HasGenRequest (path :> b) where

32 genRequest _ = do

33 genRequest _ = do

33 old' <- old

34 old' <- old

34− return $ \burl -> let r = old' burl in r { path = new <> path r }

35+ return $ \burl -> let r = old' burl

36+ oldPath = path r

37+ oldPath' = BS.dropWhile (== BS.c2w '/') oldPath

38+ paths = filter (not . BS.null) [new, oldPath']

39+ in r { path = "/" <> BS.intercalate "/" paths }

35 where

40 where

36 old = genRequest (Proxy :: Proxy b)

41 old = genRequest (Proxy :: Proxy b)

37 new = cs $ symbolVal (Proxy :: Proxy path)

42 new = cs $ symbolVal (Proxy :: Proxy path)

test/Servant/QuickCheck/InternalSpec.hs+20−2

@@ -13,7 +13,7 @@ import Test.Hspec.Core.Spec (Arg, Example, Result (..),

13 defaultParams, evaluateExample)

14import Test.QuickCheck.Gen (unGen)

15import Test.QuickCheck.Random (mkQCGen)

16−import Network.HTTP.Client (queryString)

16+import Network.HTTP.Client (queryString, path)

18#if MIN_VERSION_servant(0,8,0)

19import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPIWithoutRaw)

@@ -34,6 +34,7 @@ spec = do

34 notLongerThanSpec

35 queryParamsSpec

36 queryFlagsSpec

37+ deepPathSpec

38serversEqualSpec :: Spec

39serversEqualSpec :: Spec

39serversEqualSpec = describe "serversEqual" $ do

40serversEqualSpec = describe "serversEqual" $ do

@@ -52,7 +53,7 @@ serversEqualSpec = describe "serversEqual" $ do

52 evalExample $ serversEqual api2 burl1 burl2 args bodyEquality

53 evalExample $ serversEqual api2 burl1 burl2 args bodyEquality

53 show err `shouldContain` "Body: 1"

54 show err `shouldContain` "Body: 1"

54 show err `shouldContain` "Body: 2"

55 show err `shouldContain` "Body: 2"

55− show err `shouldContain` "Path: failplz/"

56+ show err `shouldContain` "Path: /failplz"

57serverSatisfiesSpec :: Spec

58serverSatisfiesSpec :: Spec

58serverSatisfiesSpec = describe "serverSatisfies" $ do

59serverSatisfiesSpec = describe "serverSatisfies" $ do

@@ -113,6 +114,17 @@ isComprehensiveSpec = describe "HasGenRequest" $ do

113 let _g = genRequest comprehensiveAPIWithoutRaw

114 let _g = genRequest comprehensiveAPIWithoutRaw

114 True `shouldBe` True -- This is a type-level check

115 True `shouldBe` True -- This is a type-level check

115

116

117+deepPathSpec :: Spec

118+deepPathSpec = describe "Path components" $ do

119+

120+ it "are separated by slashes, without a trailing slash" $ do

121+ let rng = mkQCGen 0

122+ burl = BaseUrl Http "localhost" 80 ""

123+ gen = genRequest deepAPI

124+ req = (unGen gen rng 0) burl

125+ path req `shouldBe` ("/one/two/three")

126+

127+

116queryParamsSpec :: Spec

128queryParamsSpec :: Spec

117queryParamsSpec = describe "QueryParams" $ do

129queryParamsSpec = describe "QueryParams" $ do

118

130

@@ -170,6 +182,12 @@ type API2 = "failplz" :> Get '[JSON] Int

170api2 :: Proxy API2

182api2 :: Proxy API2

171api2 = Proxy

183api2 = Proxy

172

184

185+type DeepAPI = "one" :> "two" :> "three":> Get '[JSON] ()

186+

187+deepAPI :: Proxy DeepAPI

188+deepAPI = Proxy

189+

190+

173server2 :: IO (Server API2)

191server2 :: IO (Server API2)

174server2 = return $ return 1

192server2 = return $ return 1

175

193