git.iko.soy/typeable/servant
on master help sign in
Test cases for bad links.
82deaebJulian K. Arni
servant/servant.cabal−1
compare with master
unifiedsplit
@@ -101,7 +101,6 @@ test-suite spec
101 , hspec == 2.*
101 , hspec == 2.*
102 , QuickCheck
102 , QuickCheck
103 , quickcheck-instances
103 , quickcheck-instances
104− , parsec
105 , servant
104 , servant
106 , string-conversions
105 , string-conversions
107 , text
106 , text
servant/test/Doctests.hs+2−1
@@ -9,13 +9,14 @@ import Test.DocTest
9main :: IO ()
9main :: IO ()
10main = do
10main = do
11 files <- find always (extension ==? ".hs") "src"
11 files <- find always (extension ==? ".hs") "src"
12+ tfiles <- find always (extension ==? ".hs") "test/Servant"
12 mCabalMacrosFile <- getCabalMacrosFile
13 mCabalMacrosFile <- getCabalMacrosFile
13 doctest $ "-isrc" :
14 doctest $ "-isrc" :
14 (maybe [] (\ f -> ["-optP-include", "-optP" ++ f]) mCabalMacrosFile) ++
15 (maybe [] (\ f -> ["-optP-include", "-optP" ++ f]) mCabalMacrosFile) ++
15 "-XOverloadedStrings" :
16 "-XOverloadedStrings" :
16 "-XFlexibleInstances" :
17 "-XFlexibleInstances" :
17 "-XMultiParamTypeClasses" :
18 "-XMultiParamTypeClasses" :
18− files
19+ (files ++ tfiles)
19
20
20getCabalMacrosFile :: IO (Maybe FilePath)
21getCabalMacrosFile :: IO (Maybe FilePath)
21getCabalMacrosFile = do
22getCabalMacrosFile = do
servant/test/Servant/Utils/LinksSpec.hs+50−22
@@ -1,14 +1,14 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE PolyKinds #-}
3−{-# LANGUAGE TypeOperators #-}
4{-# LANGUAGE ConstraintKinds #-}
1{-# LANGUAGE ConstraintKinds #-}
5−
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE PolyKinds #-}
4+{-# LANGUAGE TypeOperators #-}
6module Servant.Utils.LinksSpec where
5module Servant.Utils.LinksSpec where
7
6
8−import Test.Hspec ( Spec, it, describe, shouldBe, Expectation )
7+import Data.Proxy (Proxy (..))
9−import Data.Proxy ( Proxy(..) )
8+import Test.Hspec (Expectation, Spec, describe, it,
9+ shouldBe)
10
10
11−import Servant.API
11+import Servant.API
12
12
13type TestApi =
13type TestApi =
14 -- Capture and query params
14 -- Capture and query params
@@ -24,18 +24,6 @@ type TestApi =
24 :<|> "delete" :> Header "ponies" String :> Delete '[JSON] ()
24 :<|> "delete" :> Header "ponies" String :> Delete '[JSON] ()
25 :<|> "raw" :> Raw
25 :<|> "raw" :> Raw
26
26
27−type TestLink = "hello" :> "hi" :> Get '[JSON] Bool
28−type TestLink2 = "greet" :> ReqBody '[JSON] [Int] :> Post '[PlainText] Bool
29−type TestLink3 = "parent" :> "child" :> Get '[JSON] String
30−
31−type BadTestLink = "hallo" :> "hi" :> Get '[JSON] Bool
32−type BadTestLink2 = "greet" :> Get '[PlainText] Bool
33−
34−type BadTestLink' = "hello" :> "hi" :> Get '[OctetStream] Bool
35−type BadTestLink'2 = "greet" :> Get '[OctetStream] Bool
36−
37−type NotALink = "hello" :> Capture "x" Bool :> Get '[JSON] Bool
38−type NotALink2 = "hello" :> ReqBody '[JSON] 'True :> Get '[JSON] Bool
39
27
40apiLink :: (IsElem endpoint TestApi, HasLink endpoint)
28apiLink :: (IsElem endpoint TestApi, HasLink endpoint)
41 => Proxy endpoint -> MkLink endpoint
29 => Proxy endpoint -> MkLink endpoint
@@ -49,7 +37,7 @@ shouldBeURI link expected =
49
37
50spec :: Spec
38spec :: Spec
51spec = describe "Servant.Utils.Links" $ do
39spec = describe "Servant.Utils.Links" $ do
52− it "Generates correct links for capture query params" $ do
40+ it "generates correct links for capture query params" $ do
53 let l1 = Proxy :: Proxy ("hello" :> Capture "name" String :> Delete '[JSON] ())
41 let l1 = Proxy :: Proxy ("hello" :> Capture "name" String :> Delete '[JSON] ())
54 apiLink l1 "hi" `shouldBeURI` "hello/hi"
42 apiLink l1 "hi" `shouldBeURI` "hello/hi"
55
43
@@ -59,15 +47,55 @@ spec = describe "Servant.Utils.Links" $ do
59 apiLink l2 "bye" (Just True) `shouldBeURI` "hello/bye?capital=true"
47 apiLink l2 "bye" (Just True) `shouldBeURI` "hello/bye?capital=true"
60
48
61
49
62− it "Generates correct links for query flags" $ do
50+ it "generates correct links for query flags" $ do
63 let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy"
51 let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy"
64 :> QueryFlag "fast" :> Delete '[JSON] ())
52 :> QueryFlag "fast" :> Delete '[JSON] ())
65 apiLink l1 True True `shouldBeURI` "balls?bouncy&fast"
53 apiLink l1 True True `shouldBeURI` "balls?bouncy&fast"
66 apiLink l1 False True `shouldBeURI` "balls?fast"
54 apiLink l1 False True `shouldBeURI` "balls?fast"
67
55
68− it "Generates correct links for all of the verbs" $ do
56+ it "generates correct links for all of the verbs" $ do
69 apiLink (Proxy :: Proxy ("get" :> Get '[JSON] ())) `shouldBeURI` "get"
57 apiLink (Proxy :: Proxy ("get" :> Get '[JSON] ())) `shouldBeURI` "get"
70 apiLink (Proxy :: Proxy ("put" :> Put '[JSON] ())) `shouldBeURI` "put"
58 apiLink (Proxy :: Proxy ("put" :> Put '[JSON] ())) `shouldBeURI` "put"
71 apiLink (Proxy :: Proxy ("post" :> Post '[JSON] ())) `shouldBeURI` "post"
59 apiLink (Proxy :: Proxy ("post" :> Post '[JSON] ())) `shouldBeURI` "post"
72 apiLink (Proxy :: Proxy ("delete" :> Delete '[JSON] ())) `shouldBeURI` "delete"
60 apiLink (Proxy :: Proxy ("delete" :> Delete '[JSON] ())) `shouldBeURI` "delete"
73 apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeURI` "raw"
61 apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeURI` "raw"
62+
63+
64+-- |
65+-- Before https://github.com/CRogers/should-not-typecheck/issues/5 is fixed,
66+-- we'll just use doctest
67+--
68+-- >>> apiLink (Proxy :: Proxy WrongPath)
69+-- ...
70+-- Could not deduce ...
71+-- ...
72+--
73+-- >>> apiLink (Proxy :: Proxy WrongReturnType)
74+-- ...
75+-- Could not deduce ...
76+-- ...
77+--
78+-- >>> apiLink (Proxy :: Proxy WrongContentType)
79+-- ...
80+-- Could not deduce ...
81+-- ...
82+--
83+-- >>> apiLink (Proxy :: Proxy WrongMethod)
84+-- ...
85+-- Could not deduce ...
86+-- ...
87+--
88+-- >>> apiLink (Proxy :: Proxy NotALink)
89+-- ...
90+-- Could not deduce ...
91+-- ...
92+--
93+-- sanity check
94+-- >>> apiLink (Proxy :: Proxy AllGood)
95+-- get
96+type WrongPath = "getTypo" :> Get '[JSON] ()
97+type WrongReturnType = "get" :> Get '[JSON] Bool
98+type WrongContentType = "get" :> Get '[OctetStream] ()
99+type WrongMethod = "get" :> Post '[JSON] ()
100+type NotALink = "hello" :> ReqBody '[JSON] 'True :> Get '[JSON] Bool
101+type AllGood = "get" :> Get '[JSON] ()