c5d3460 · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

Merge pull request #854 from phadej/pull-851

c5d3460Oleg Grenrus9 years ago

servant/CHANGELOG.md+2

compare with master

unifiedsplit

@@ -30,6 +30,8 @@

30 [#767](https://github.com/haskell-servant/servant/pull/767)

31 [#790](https://github.com/haskell-servant/servant/pull/790)

32 [#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))

33- Allow newest dependencies

35- Allow newest dependencies

34 ([#772](https://github.com/haskell-servant/servant/pull/772)

36 ([#772](https://github.com/haskell-servant/servant/pull/772)

35 [#842](https://github.com/haskell-servant/servant/pull/842))

37 [#842](https://github.com/haskell-servant/servant/pull/842))

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

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

84 --

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

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,30 @@ 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+--

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+

223-- | Construct a toLink for an endpoint.

249-- | Construct a toLink for an endpoint.

224class HasLink endpoint where

250class HasLink endpoint where

225 type MkLink endpoint

251 type MkLink endpoint

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

266 where

292 where

267 k = symbolVal (Proxy :: Proxy sym)

293 k = symbolVal (Proxy :: Proxy sym)

268

294

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+

269-- Misc instances

300-- Misc instances

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

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

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

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

@@ -313,3 +344,4 @@ instance HasLink sub => HasLink (AuthProtect tag :> sub) where

313

344

314-- $setup

345-- $setup

315-- >>> import Servant.API

346-- >>> import Servant.API

347+-- >>> import Data.Text (Text)

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

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

2{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE PolyKinds #-}

4{-# LANGUAGE TypeOperators #-}

5+{-# LANGUAGE ScopedTypeVariables #-}

5module Servant.Utils.LinksSpec where

6module Servant.Utils.LinksSpec where

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)

12import Servant.API

13import Servant.API

14+import Servant.Utils.Links (allLinks)

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

32+type LinkableApi =

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

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

35+

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"

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+

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,