eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

add HasLink instance for UVerb (#1370)

Browse source
This commit is contained in:
Intolerable 2020-12-06 13:19:35 +00:00 committed by GitHub
parent 08579ca003
commit a8f584f80b
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
2 changed files with 13 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
servant/src/Servant/Links.hs
View file

@ -178,6 +178,7 @@ import Servant.API.Stream
import Servant.API.Sub import Servant.API.Sub
(type (:>)) (type (:>))
import Servant.API.TypeLevel import Servant.API.TypeLevel
import Servant.API.UVerb
import Servant.API.Vault import Servant.API.Vault
(Vault) (Vault)
import Servant.API.Verbs 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 type MkLink (Stream m status fr ct a) r = r
toLink toA _ = toA 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 -- AuthProtext instances
instance HasLink sub => HasLink (AuthProtect tag :> sub) where instance HasLink sub => HasLink (AuthProtect tag :> sub) where
type MkLink (AuthProtect tag :> sub) a = MkLink sub a type MkLink (AuthProtect tag :> sub) a = MkLink sub a

7
servant/test/Servant/LinksSpec.hs
View file

@ -29,6 +29,9 @@ type TestApi =
-- Fragment -- Fragment
:<|> "say" :> Fragment String :> Get '[JSON] NoContent :<|> "say" :> Fragment String :> Get '[JSON] NoContent
-- UVerb
:<|> "uverb-example" :> UVerb 'GET '[JSON] '[WithStatus 200 NoContent]
-- All of the verbs -- All of the verbs
:<|> "get" :> Get '[JSON] NoContent :<|> "get" :> Get '[JSON] NoContent
:<|> "put" :> Put '[JSON] NoContent :<|> "put" :> Put '[JSON] NoContent
@ -73,6 +76,10 @@ spec = describe "Servant.Links" $ do
["roads", "lead", "to", "rome"] ["roads", "lead", "to", "rome"]
`shouldBeLink` "all/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 it "generates correct links for query flags" $ do
let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy" let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy"
:> QueryFlag "fast" :> Delete '[JSON] NoContent) :> QueryFlag "fast" :> Delete '[JSON] NoContent)