add HasLink instance for UVerb (#1370)

Author: intolerable

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

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)