git.iko.soy/typeable/servant
on master help sign in
Merge pull request #854 from phadej/pull-851

Pull 851

commitc5d34607acf9736b98839f5224f8c344abb4f081 authorOleg Grenrus <oleg.grenrus@iki.fi> dateTue 7 Nov 2017, 19:31 (9 years ago) parenta4b69d42779f52
3 files changed+47
compare with master
unifiedsplit
servant/CHANGELOG.md+2 servant/src/Servant/Utils/Links.hs+32 servant/test/Servant/Utils/LinksSpec.hs+13
servant/CHANGELOG.md+2
@@ -30,6 +30,8 @@
3030 [#767](https://github.com/haskell-servant/servant/pull/767)
3131 [#790](https://github.com/haskell-servant/servant/pull/790)
3232 [#788](https://github.com/haskell-servant/servant/pull/788))
33+- Add `addLinks` to generate all links for unnested APIs.
34+ ([#851](https://github.com/haskell-servant/servant/pull/851))
3335- Allow newest dependencies
3436 ([#772](https://github.com/haskell-servant/servant/pull/772)
3537 [#842](https://github.com/haskell-servant/servant/pull/842))
servant/src/Servant/Utils/Links.hs+32
@@ -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,30 @@ 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+--
230+-- >>> type API = "foo" :> Capture "name" Text :> Get '[JSON] Text :<|> "bar" :> Capture "name" Int :> Get '[JSON] Double
231+-- >>> let fooLink :<|> barLink = allLinks (Proxy :: Proxy API)
232+-- >>> :t fooLink
233+-- fooLink :: Text -> Link
234+-- >>> :t barLink
235+-- barLink :: Int -> Link
236+--
237+-- Note: nested APIs don't work well with this approach
238+--
239+-- >>> :kind! MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double))
240+-- MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double)) :: *
241+-- = Char -> (Int -> Link) :<|> (Double -> Link)
242+--
243+allLinks
244+ :: forall api. HasLink api
245+ => Proxy api
246+ -> MkLink api
247+allLinks api = toLink api (Link mempty mempty)
248+
223249-- | Construct a toLink for an endpoint.
224250class HasLink endpoint where
225251 type MkLink endpoint
@@ -266,6 +292,11 @@ instance (KnownSymbol sym, HasLink sub)
266292 where
267293 k = symbolVal (Proxy :: Proxy sym)
268294
295+-- :<|> instance - Generate all links at once
296+instance (HasLink a, HasLink b) => HasLink (a :<|> b) where
297+ type MkLink (a :<|> b) = MkLink a :<|> MkLink b
298+ toLink _ l = toLink (Proxy :: Proxy a) l :<|> toLink (Proxy :: Proxy b) l
299+
269300-- Misc instances
270301instance HasLink sub => HasLink (ReqBody ct a :> sub) where
271302 type MkLink (ReqBody ct a :> sub) = MkLink sub
@@ -313,3 +344,4 @@ instance HasLink sub => HasLink (AuthProtect tag :> sub) where
313344
314345-- $setup
315346-- >>> import Servant.API
347+-- >>> import Data.Text (Text)
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
67
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,