7410b4f · typeable/servant

git.iko.soy/typeable/servant

Links: add allLinks function and MkLink instance for (:<|>)

This lets you generate all links at once, which is useful in conjunction with servant-generic.

commit7410b4faa8120c440ac66b2c7b993dc22258536c authorRobert Hensing <robert@roberthensing.nl> dateMon 6 Nov 2017, 14:42 (9 years ago) parenta4b69d4

2 files changed+30

compare with master

unifiedsplit

servant/src/Servant/Utils/Links.hs+17 servant/test/Servant/Utils/LinksSpec.hs+13

servant/src/Servant/Utils/Links.hs+17

@@ -84,6 +84,7 @@ module Servant.Utils.Links (

8484 --

8585 -- | Note that 'URI' is from the "Network.URI" module in the @network-uri@ package.

8686 safeLink

87+ , allLinks

8788 , URI(..)

8889 -- * Adding custom types

8990 , HasLink(..)

@@ -108,6 +109,7 @@ import Prelude ()

108109import Prelude.Compat

109110

110111import Web.HttpApiData

112+import Servant.API.Alternative ( (:<|>)((:<|>)) )

111113import Servant.API.BasicAuth ( BasicAuth )

112114import Servant.API.Capture ( Capture, CaptureAll )

113115import Servant.API.ReqBody ( ReqBody )

@@ -220,6 +222,16 @@ safeLink

220222 -> MkLink endpoint

221223safeLink _ endpoint = toLink endpoint (Link mempty mempty)

222224

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+

223235-- | Construct a toLink for an endpoint.

224236class HasLink endpoint where

225237 type MkLink endpoint

@@ -266,6 +278,11 @@ instance (KnownSymbol sym, HasLink sub)

266278 where

267279 k = symbolVal (Proxy :: Proxy sym)

268280

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+

269286-- Misc instances

270287instance HasLink sub => HasLink (ReqBody ct a :> sub) where

271288 type MkLink (ReqBody ct a :> sub) = MkLink sub

servant/test/Servant/Utils/LinksSpec.hs+13

@@ -2,6 +2,7 @@

22{-# LANGUAGE DataKinds #-}

33{-# LANGUAGE PolyKinds #-}

44{-# LANGUAGE TypeOperators #-}

5+{-# LANGUAGE ScopedTypeVariables #-}

56module Servant.Utils.LinksSpec where

78import Data.Proxy (Proxy (..))

@@ -10,6 +11,7 @@ import Test.Hspec (Expectation, Spec, describe, it,

1011import Data.String (fromString)

1112

1213import Servant.API

14+import Servant.Utils.Links (allLinks)

1315

1416type TestApi =

1517 -- Capture and query params

@@ -27,6 +29,10 @@ type TestApi =

2729 :<|> "raw" :> Raw

2830 :<|> NoEndpoint

2931

32+type LinkableApi =

33+ "all" :> CaptureAll "names" String :> Get '[JSON] NoContent

34+ :<|> "get" :> Get '[JSON] NoContent

35+

3036

3137apiLink :: (IsElem endpoint TestApi, HasLink endpoint)

3238 => Proxy endpoint -> MkLink endpoint

@@ -67,6 +73,13 @@ spec = describe "Servant.Utils.Links" $ do

6773 apiLink (Proxy :: Proxy ("delete" :> Delete '[JSON] NoContent)) `shouldBeLink` "delete"

6874 apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeLink` "raw"

6975

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+

7083

7184-- |

7285-- Before https://github.com/CRogers/should-not-typecheck/issues/5 is fixed,