diff --git a/servant/src/Servant/Links.hs b/servant/src/Servant/Links.hs index cdafb310..bfd47206 100644 --- a/servant/src/Servant/Links.hs +++ b/servant/src/Servant/Links.hs @@ -178,6 +178,7 @@ import Servant.API.Stream import Servant.API.Sub (type (:>)) import Servant.API.TypeLevel +import Servant.API.UVerb import Servant.API.Vault (Vault) import Servant.API.Verbs @@ -576,6 +577,11 @@ instance HasLink (Stream m status fr ct a) where type MkLink (Stream m status fr ct a) r = r toLink toA _ = toA +-- UVerb instances +instance HasLink (UVerb m ct a) where + type MkLink (UVerb m ct a) r = r + toLink toA _ = toA + -- AuthProtext instances instance HasLink sub => HasLink (AuthProtect tag :> sub) where type MkLink (AuthProtect tag :> sub) a = MkLink sub a diff --git a/servant/test/Servant/LinksSpec.hs b/servant/test/Servant/LinksSpec.hs index 9d45e4a9..55c68228 100644 --- a/servant/test/Servant/LinksSpec.hs +++ b/servant/test/Servant/LinksSpec.hs @@ -29,6 +29,9 @@ type TestApi = -- Fragment :<|> "say" :> Fragment String :> Get '[JSON] NoContent + -- UVerb + :<|> "uverb-example" :> UVerb 'GET '[JSON] '[WithStatus 200 NoContent] + -- All of the verbs :<|> "get" :> Get '[JSON] NoContent :<|> "put" :> Put '[JSON] NoContent @@ -73,6 +76,10 @@ spec = describe "Servant.Links" $ do ["roads", "lead", "to", "rome"] `shouldBeLink` "all/roads/lead/to/rome" + it "generated correct links for UVerbs" $ do + apiLink (Proxy :: Proxy ("uverb-example" :> UVerb 'GET '[JSON] '[WithStatus 200 NoContent])) + `shouldBeLink` "uverb-example" + it "generates correct links for query flags" $ do let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy" :> QueryFlag "fast" :> Delete '[JSON] NoContent)