on master help sign in
add HasLink instance for UVerb (#1370)
a8f584fIntolerable
servant/src/Servant/Links.hs+6
@@ -178,6 +178,7 @@ import Servant.API.Stream
178import Servant.API.Sub
178import Servant.API.Sub
179 (type (:>))
179 (type (:>))
180import Servant.API.TypeLevel
180import Servant.API.TypeLevel
181+import Servant.API.UVerb
181import Servant.API.Vault
182import Servant.API.Vault
182 (Vault)
183 (Vault)
183import Servant.API.Verbs
184import Servant.API.Verbs
@@ -576,6 +577,11 @@ instance HasLink (Stream m status fr ct a) where
576 type MkLink (Stream m status fr ct a) r = r
577 type MkLink (Stream m status fr ct a) r = r
577 toLink toA _ = toA
578 toLink toA _ = toA
578
579
580+-- UVerb instances
581+instance HasLink (UVerb m ct a) where
582+ type MkLink (UVerb m ct a) r = r
583+ toLink toA _ = toA
584+
579-- AuthProtext instances
585-- AuthProtext instances
580instance HasLink sub => HasLink (AuthProtect tag :> sub) where
586instance HasLink sub => HasLink (AuthProtect tag :> sub) where
581 type MkLink (AuthProtect tag :> sub) a = MkLink sub a
587 type MkLink (AuthProtect tag :> sub) a = MkLink sub a
servant/test/Servant/LinksSpec.hs+7
@@ -29,6 +29,9 @@ type TestApi =
29 -- Fragment
29 -- Fragment
30 :<|> "say" :> Fragment String :> Get '[JSON] NoContent
30 :<|> "say" :> Fragment String :> Get '[JSON] NoContent
31
31
32+ -- UVerb
33+ :<|> "uverb-example" :> UVerb 'GET '[JSON] '[WithStatus 200 NoContent]
34+
32 -- All of the verbs
35 -- All of the verbs
33 :<|> "get" :> Get '[JSON] NoContent
36 :<|> "get" :> Get '[JSON] NoContent
34 :<|> "put" :> Put '[JSON] NoContent
37 :<|> "put" :> Put '[JSON] NoContent
@@ -73,6 +76,10 @@ spec = describe "Servant.Links" $ do
73 ["roads", "lead", "to", "rome"]
76 ["roads", "lead", "to", "rome"]
74 `shouldBeLink` "all/roads/lead/to/rome"
77 `shouldBeLink` "all/roads/lead/to/rome"
75
78
79+ it "generated correct links for UVerbs" $ do
80+ apiLink (Proxy :: Proxy ("uverb-example" :> UVerb 'GET '[JSON] '[WithStatus 200 NoContent]))
81+ `shouldBeLink` "uverb-example"
82+
76 it "generates correct links for query flags" $ do
83 it "generates correct links for query flags" $ do
77 let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy"
84 let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy"
78 :> QueryFlag "fast" :> Delete '[JSON] NoContent)
85 :> QueryFlag "fast" :> Delete '[JSON] NoContent)