on master help sign in
Links: add allLinks function and MkLink instance for (:<|>)
7410b4fRobert Hensing
servant/src/Servant/Utils/Links.hs+17
@@ -84,6 +84,7 @@ module Servant.Utils.Links (
84 --
84 --
85 -- | Note that 'URI' is from the "Network.URI" module in the @network-uri@ package.
85 -- | Note that 'URI' is from the "Network.URI" module in the @network-uri@ package.
86 safeLink
86 safeLink
87+ , allLinks
87 , URI(..)
88 , URI(..)
88 -- * Adding custom types
89 -- * Adding custom types
89 , HasLink(..)
90 , HasLink(..)
@@ -108,6 +109,7 @@ import Prelude ()
108import Prelude.Compat
109import Prelude.Compat
109
110
110import Web.HttpApiData
111import Web.HttpApiData
112+import Servant.API.Alternative ( (:<|>)((:<|>)) )
111import Servant.API.BasicAuth ( BasicAuth )
113import Servant.API.BasicAuth ( BasicAuth )
112import Servant.API.Capture ( Capture, CaptureAll )
114import Servant.API.Capture ( Capture, CaptureAll )
113import Servant.API.ReqBody ( ReqBody )
115import Servant.API.ReqBody ( ReqBody )
@@ -220,6 +222,16 @@ safeLink
220 -> MkLink endpoint
222 -> MkLink endpoint
221safeLink _ endpoint = toLink endpoint (Link mempty mempty)
223safeLink _ endpoint = toLink endpoint (Link mempty mempty)
222
224
225+-- | Create all links in an API.
226+--
227+-- Note that the @api@ type must be restricted to the endpoints that have
228+-- valid links to them.
229+allLinks
230+ :: forall api. HasLink api
231+ => Proxy api
232+ -> MkLink api
233+allLinks api = toLink api (Link mempty mempty)
234+
223-- | Construct a toLink for an endpoint.
235-- | Construct a toLink for an endpoint.
224class HasLink endpoint where
236class HasLink endpoint where
225 type MkLink endpoint
237 type MkLink endpoint
@@ -266,6 +278,11 @@ instance (KnownSymbol sym, HasLink sub)
266 where
278 where
267 k = symbolVal (Proxy :: Proxy sym)
279 k = symbolVal (Proxy :: Proxy sym)
268
280
281+-- :<|> instance - Generate all links at once
282+instance (HasLink a, HasLink b) => HasLink (a :<|> b) where
283+ type MkLink (a :<|> b) = MkLink a :<|> MkLink b
284+ toLink _ l = toLink (Proxy :: Proxy a) l :<|> toLink (Proxy :: Proxy b) l
285+
269-- Misc instances
286-- Misc instances
270instance HasLink sub => HasLink (ReqBody ct a :> sub) where
287instance HasLink sub => HasLink (ReqBody ct a :> sub) where
271 type MkLink (ReqBody ct a :> sub) = MkLink sub
288 type MkLink (ReqBody ct a :> sub) = MkLink sub
servant/test/Servant/Utils/LinksSpec.hs+13
@@ -2,6 +2,7 @@
2{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE PolyKinds #-}
3{-# LANGUAGE PolyKinds #-}
4{-# LANGUAGE TypeOperators #-}
4{-# LANGUAGE TypeOperators #-}
5+{-# LANGUAGE ScopedTypeVariables #-}
5module Servant.Utils.LinksSpec where
6module Servant.Utils.LinksSpec where
6
7
7import Data.Proxy (Proxy (..))
8import Data.Proxy (Proxy (..))
@@ -10,6 +11,7 @@ import Test.Hspec (Expectation, Spec, describe, it,
10import Data.String (fromString)
11import Data.String (fromString)
11
12
12import Servant.API
13import Servant.API
14+import Servant.Utils.Links (allLinks)
13
15
14type TestApi =
16type TestApi =
15 -- Capture and query params
17 -- Capture and query params
@@ -27,6 +29,10 @@ type TestApi =
27 :<|> "raw" :> Raw
29 :<|> "raw" :> Raw
28 :<|> NoEndpoint
30 :<|> NoEndpoint
29
31
32+type LinkableApi =
33+ "all" :> CaptureAll "names" String :> Get '[JSON] NoContent
34+ :<|> "get" :> Get '[JSON] NoContent
35+
30
36
31apiLink :: (IsElem endpoint TestApi, HasLink endpoint)
37apiLink :: (IsElem endpoint TestApi, HasLink endpoint)
32 => Proxy endpoint -> MkLink endpoint
38 => Proxy endpoint -> MkLink endpoint
@@ -67,6 +73,13 @@ spec = describe "Servant.Utils.Links" $ do
67 apiLink (Proxy :: Proxy ("delete" :> Delete '[JSON] NoContent)) `shouldBeLink` "delete"
73 apiLink (Proxy :: Proxy ("delete" :> Delete '[JSON] NoContent)) `shouldBeLink` "delete"
68 apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeLink` "raw"
74 apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeLink` "raw"
69
75
76+ it "can generate all links for an API that has only linkable endpoints" $ do
77+ let (allNames :<|> simple) = allLinks (Proxy :: Proxy LinkableApi)
78+ simple
79+ `shouldBeLink` "get"
80+ allNames ["Seneca", "Aurelius"]
81+ `shouldBeLink` "all/Seneca/Aurelius"
82+
70
83
71-- |
84-- |
72-- Before https://github.com/CRogers/should-not-typecheck/issues/5 is fixed,
85-- Before https://github.com/CRogers/should-not-typecheck/issues/5 is fixed,