Links: add allLinks function and MkLink instance for (:<|>)
This lets you generate all links at once, which is useful in conjunction with servant-generic.
This commit is contained in:
parent
a4b69d432b
commit
7410b4faa8
2 changed files with 30 additions and 0 deletions
|
@ -84,6 +84,7 @@ module Servant.Utils.Links (
|
||||||
--
|
--
|
||||||
-- | Note that 'URI' is from the "Network.URI" module in the @network-uri@ package.
|
-- | Note that 'URI' is from the "Network.URI" module in the @network-uri@ package.
|
||||||
safeLink
|
safeLink
|
||||||
|
, allLinks
|
||||||
, URI(..)
|
, URI(..)
|
||||||
-- * Adding custom types
|
-- * Adding custom types
|
||||||
, HasLink(..)
|
, HasLink(..)
|
||||||
|
@ -108,6 +109,7 @@ import Prelude ()
|
||||||
import Prelude.Compat
|
import Prelude.Compat
|
||||||
|
|
||||||
import Web.HttpApiData
|
import Web.HttpApiData
|
||||||
|
import Servant.API.Alternative ( (:<|>)((:<|>)) )
|
||||||
import Servant.API.BasicAuth ( BasicAuth )
|
import Servant.API.BasicAuth ( BasicAuth )
|
||||||
import Servant.API.Capture ( Capture, CaptureAll )
|
import Servant.API.Capture ( Capture, CaptureAll )
|
||||||
import Servant.API.ReqBody ( ReqBody )
|
import Servant.API.ReqBody ( ReqBody )
|
||||||
|
@ -220,6 +222,16 @@ safeLink
|
||||||
-> MkLink endpoint
|
-> MkLink endpoint
|
||||||
safeLink _ endpoint = toLink endpoint (Link mempty mempty)
|
safeLink _ endpoint = toLink endpoint (Link mempty mempty)
|
||||||
|
|
||||||
|
-- | Create all links in an API.
|
||||||
|
--
|
||||||
|
-- Note that the @api@ type must be restricted to the endpoints that have
|
||||||
|
-- valid links to them.
|
||||||
|
allLinks
|
||||||
|
:: forall api. HasLink api
|
||||||
|
=> Proxy api
|
||||||
|
-> MkLink api
|
||||||
|
allLinks api = toLink api (Link mempty mempty)
|
||||||
|
|
||||||
-- | Construct a toLink for an endpoint.
|
-- | Construct a toLink for an endpoint.
|
||||||
class HasLink endpoint where
|
class HasLink endpoint where
|
||||||
type MkLink endpoint
|
type MkLink endpoint
|
||||||
|
@ -266,6 +278,11 @@ instance (KnownSymbol sym, HasLink sub)
|
||||||
where
|
where
|
||||||
k = symbolVal (Proxy :: Proxy sym)
|
k = symbolVal (Proxy :: Proxy sym)
|
||||||
|
|
||||||
|
-- :<|> instance - Generate all links at once
|
||||||
|
instance (HasLink a, HasLink b) => HasLink (a :<|> b) where
|
||||||
|
type MkLink (a :<|> b) = MkLink a :<|> MkLink b
|
||||||
|
toLink _ l = toLink (Proxy :: Proxy a) l :<|> toLink (Proxy :: Proxy b) l
|
||||||
|
|
||||||
-- Misc instances
|
-- Misc instances
|
||||||
instance HasLink sub => HasLink (ReqBody ct a :> sub) where
|
instance HasLink sub => HasLink (ReqBody ct a :> sub) where
|
||||||
type MkLink (ReqBody ct a :> sub) = MkLink sub
|
type MkLink (ReqBody ct a :> sub) = MkLink sub
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE PolyKinds #-}
|
{-# LANGUAGE PolyKinds #-}
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
module Servant.Utils.LinksSpec where
|
module Servant.Utils.LinksSpec where
|
||||||
|
|
||||||
import Data.Proxy (Proxy (..))
|
import Data.Proxy (Proxy (..))
|
||||||
|
@ -10,6 +11,7 @@ import Test.Hspec (Expectation, Spec, describe, it,
|
||||||
import Data.String (fromString)
|
import Data.String (fromString)
|
||||||
|
|
||||||
import Servant.API
|
import Servant.API
|
||||||
|
import Servant.Utils.Links (allLinks)
|
||||||
|
|
||||||
type TestApi =
|
type TestApi =
|
||||||
-- Capture and query params
|
-- Capture and query params
|
||||||
|
@ -27,6 +29,10 @@ type TestApi =
|
||||||
:<|> "raw" :> Raw
|
:<|> "raw" :> Raw
|
||||||
:<|> NoEndpoint
|
:<|> NoEndpoint
|
||||||
|
|
||||||
|
type LinkableApi =
|
||||||
|
"all" :> CaptureAll "names" String :> Get '[JSON] NoContent
|
||||||
|
:<|> "get" :> Get '[JSON] NoContent
|
||||||
|
|
||||||
|
|
||||||
apiLink :: (IsElem endpoint TestApi, HasLink endpoint)
|
apiLink :: (IsElem endpoint TestApi, HasLink endpoint)
|
||||||
=> Proxy endpoint -> MkLink endpoint
|
=> Proxy endpoint -> MkLink endpoint
|
||||||
|
@ -67,6 +73,13 @@ spec = describe "Servant.Utils.Links" $ do
|
||||||
apiLink (Proxy :: Proxy ("delete" :> Delete '[JSON] NoContent)) `shouldBeLink` "delete"
|
apiLink (Proxy :: Proxy ("delete" :> Delete '[JSON] NoContent)) `shouldBeLink` "delete"
|
||||||
apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeLink` "raw"
|
apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeLink` "raw"
|
||||||
|
|
||||||
|
it "can generate all links for an API that has only linkable endpoints" $ do
|
||||||
|
let (allNames :<|> simple) = allLinks (Proxy :: Proxy LinkableApi)
|
||||||
|
simple
|
||||||
|
`shouldBeLink` "get"
|
||||||
|
allNames ["Seneca", "Aurelius"]
|
||||||
|
`shouldBeLink` "all/Seneca/Aurelius"
|
||||||
|
|
||||||
|
|
||||||
-- |
|
-- |
|
||||||
-- Before https://github.com/CRogers/should-not-typecheck/issues/5 is fixed,
|
-- Before https://github.com/CRogers/should-not-typecheck/issues/5 is fixed,
|
||||||
|
|
Loading…
Reference in a new issue