@@ -1,14 +1,14 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE PolyKinds #-}
3−{-# LANGUAGE TypeOperators #-}
41{-# LANGUAGE ConstraintKinds #-}
5−
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE PolyKinds #-}
4+{-# LANGUAGE TypeOperators #-}
65module Servant.Utils.LinksSpec where
76
8−import Test.Hspec ( Spec, it, describe, shouldBe, Expectation )
9−import Data.Proxy ( Proxy(..) )
7+import Data.Proxy (Proxy (..))
8+import Test.Hspec (Expectation, Spec, describe, it,
9+ shouldBe)
1010
11−import Servant.API
11+import Servant.API
1212
1313type TestApi =
1414 -- Capture and query params
@@ -24,18 +24,6 @@ type TestApi =
2424 :<|> "delete" :> Header "ponies" String :> Delete '[JSON] ()
2525 :<|> "raw" :> Raw
2626
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
3927
4028apiLink :: (IsElem endpoint TestApi, HasLink endpoint)
4129 => Proxy endpoint -> MkLink endpoint
@@ -49,7 +37,7 @@ shouldBeURI link expected =
4937
5038spec :: Spec
5139spec = 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
5341 let l1 = Proxy :: Proxy ("hello" :> Capture "name" String :> Delete '[JSON] ())
5442 apiLink l1 "hi" `shouldBeURI` "hello/hi"
5543
@@ -59,15 +47,55 @@ spec = describe "Servant.Utils.Links" $ do
5947 apiLink l2 "bye" (Just True) `shouldBeURI` "hello/bye?capital=true"
6048
6149
62− it "Generates correct links for query flags" $ do
50+ it "generates correct links for query flags" $ do
6351 let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy"
6452 :> QueryFlag "fast" :> Delete '[JSON] ())
6553 apiLink l1 True True `shouldBeURI` "balls?bouncy&fast"
6654 apiLink l1 False True `shouldBeURI` "balls?fast"
6755
68− it "Generates correct links for all of the verbs" $ do
56+ it "generates correct links for all of the verbs" $ do
6957 apiLink (Proxy :: Proxy ("get" :> Get '[JSON] ())) `shouldBeURI` "get"
7058 apiLink (Proxy :: Proxy ("put" :> Put '[JSON] ())) `shouldBeURI` "put"
7159 apiLink (Proxy :: Proxy ("post" :> Post '[JSON] ())) `shouldBeURI` "post"
7260 apiLink (Proxy :: Proxy ("delete" :> Delete '[JSON] ())) `shouldBeURI` "delete"
7361 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] ()