git.iko.soy/servant
on master help sign in
Add safeLink'
46663f2Oleg Grenrus
servant/src/Servant/Utils/Links.hs+123−75
compare with master
unifiedsplit
@@ -19,8 +19,6 @@
19-- >>> import Servant.Utils.Links
19-- >>> import Servant.Utils.Links
20-- >>> import Data.Proxy
20-- >>> import Data.Proxy
21-- >>>
21-- >>>
22−-- >>>
23−-- >>>
24-- >>> type Hello = "hello" :> Get '[JSON] Int
22-- >>> type Hello = "hello" :> Get '[JSON] Int
25-- >>> type Bye = "bye" :> QueryParam "name" String :> Delete '[JSON] NoContent
23-- >>> type Bye = "bye" :> QueryParam "name" String :> Delete '[JSON] NoContent
26-- >>> type API = Hello :<|> Bye
24-- >>> type API = Hello :<|> Bye
@@ -63,10 +61,24 @@
63-- >>> :set -XConstraintKinds
61-- >>> :set -XConstraintKinds
64-- >>> :{
62-- >>> :{
65-- >>> let apiLink :: (IsElem endpoint API, HasLink endpoint)
63-- >>> let apiLink :: (IsElem endpoint API, HasLink endpoint)
66−-- >>> => Proxy endpoint -> MkLink endpoint
64+-- >>> => Proxy endpoint -> MkLink endpoint Link
67-- >>> apiLink = safeLink api
65-- >>> apiLink = safeLink api
68-- >>> :}
66-- >>> :}
69--
67--
68+-- `safeLink'` allows to make specialise the output:
69+--
70+-- >>> safeLink' toUrlPiece api without
71+-- "bye"
72+--
73+-- >>> :{
74+-- >>> let apiTextLink :: (IsElem endpoint API, HasLink endpoint)
75+-- >>> => Proxy endpoint -> MkLink endpoint Text
76+-- >>> apiTextLink = safeLink' toUrlPiece api
77+-- >>> :}
78+--
79+-- >>> apiTextLink without
80+-- "bye"
81+--
70-- Attempting to construct a link to an endpoint that does not exist in api
82-- Attempting to construct a link to an endpoint that does not exist in api
71-- will result in a type error like this:
83-- will result in a type error like this:
72--
84--
@@ -86,7 +98,9 @@ module Servant.Utils.Links (
86 --
98 --
87 -- | Note that 'URI' is from the "Network.URI" module in the @network-uri@ package.
99 -- | Note that 'URI' is from the "Network.URI" module in the @network-uri@ package.
88 safeLink
100 safeLink
101+ , safeLink'
89 , allLinks
102 , allLinks
103+ , allLinks'
90 , URI(..)
104 , URI(..)
91 -- * Adding custom types
105 -- * Adding custom types
92 , HasLink(..)
106 , HasLink(..)
@@ -109,8 +123,6 @@ import Data.Singletons.Bool
109 (SBool (..), SBoolI (..))
123 (SBool (..), SBoolI (..))
110import qualified Data.Text as Text
124import qualified Data.Text as Text
111import qualified Data.Text.Encoding as TE
125import qualified Data.Text.Encoding as TE
112−import Data.Type.Bool
113− (If)
114import Data.Type.Bool
126import Data.Type.Bool
115 (If)
127 (If)
116import GHC.TypeLits
128import GHC.TypeLits
@@ -278,8 +290,18 @@ safeLink
278 :: forall endpoint api. (IsElem endpoint api, HasLink endpoint)
290 :: forall endpoint api. (IsElem endpoint api, HasLink endpoint)
279 => Proxy api -- ^ The whole API that this endpoint is a part of
291 => Proxy api -- ^ The whole API that this endpoint is a part of
280 -> Proxy endpoint -- ^ The API endpoint you would like to point to
292 -> Proxy endpoint -- ^ The API endpoint you would like to point to
281− -> MkLink endpoint
293+ -> MkLink endpoint Link
294+safeLink = safeLink' id
295+
296+-- | More general 'safeLink'.
297+--
298+safeLink'
299+ :: forall endpoint api a. (IsElem endpoint api, HasLink endpoint)
300+ => (Link -> a)
301+ -> Proxy api -- ^ The whole API that this endpoint is a part of
302+ -> Proxy endpoint -- ^ The API endpoint you would like to point to
303+ -> MkLink endpoint a
282−safeLink _ endpoint = toLink endpoint (Link mempty mempty)
304+safeLink' toA _ endpoint = toLink toA endpoint (Link mempty mempty)
283
305
284-- | Create all links in an API.
306-- | Create all links in an API.
285--
307--
@@ -295,37 +317,47 @@ safeLink _ endpoint = toLink endpoint (Link mempty mempty)
295--
317--
296-- Note: nested APIs don't work well with this approach
318-- Note: nested APIs don't work well with this approach
297--
319--
298−-- >>> :kind! MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double))
320+-- >>> :kind! MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double)) Link
299−-- MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double)) :: *
321+-- MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double)) Link :: *
300-- = Char -> (Int -> Link) :<|> (Double -> Link)
322-- = Char -> (Int -> Link) :<|> (Double -> Link)
301−--
302allLinks
323allLinks
303 :: forall api. HasLink api
324 :: forall api. HasLink api
304 => Proxy api
325 => Proxy api
305− -> MkLink api
326+ -> MkLink api Link
327+allLinks = allLinks' id
328+
329+-- | More general 'allLinks'. See `safeLink'`.
330+allLinks'
331+ :: forall api a. HasLink api
332+ => (Link -> a)
333+ -> Proxy api
334+ -> MkLink api a
306−allLinks api = toLink api (Link mempty mempty)
335+allLinks' toA api = toLink toA api (Link mempty mempty)
307
336
308-- | Construct a toLink for an endpoint.
337-- | Construct a toLink for an endpoint.
309class HasLink endpoint where
338class HasLink endpoint where
310− type MkLink endpoint
339+ type MkLink endpoint (a :: *)
340+ toLink
341+ :: (Link -> a)
311− toLink :: Proxy endpoint -- ^ The API endpoint you would like to point to
342+ -> Proxy endpoint -- ^ The API endpoint you would like to point to
312− -> Link
343+ -> Link
313− -> MkLink endpoint
344+ -> MkLink endpoint a
314
345
315-- Naked symbol instance
346-- Naked symbol instance
316instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
347instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
317− type MkLink (sym :> sub) = MkLink sub
348+ type MkLink (sym :> sub) a = MkLink sub a
318− toLink _ =
349+ toLink toA _ =
319− toLink (Proxy :: Proxy sub) . addSegment (escaped seg)
350+ toLink toA (Proxy :: Proxy sub) . addSegment (escaped seg)
320 where
351 where
321 seg = symbolVal (Proxy :: Proxy sym)
352 seg = symbolVal (Proxy :: Proxy sym)
322
353
323-- QueryParam instances
354-- QueryParam instances
324instance (KnownSymbol sym, ToHttpApiData v, HasLink sub, SBoolI (FoldRequired mods))
355instance (KnownSymbol sym, ToHttpApiData v, HasLink sub, SBoolI (FoldRequired mods))
325− => HasLink (QueryParam' mods sym v :> sub) where
356+ => HasLink (QueryParam' mods sym v :> sub)
357+ where
326− type MkLink (QueryParam' mods sym v :> sub) = If (FoldRequired mods) v (Maybe v) -> MkLink sub
358+ type MkLink (QueryParam' mods sym v :> sub) a = If (FoldRequired mods) v (Maybe v) -> MkLink sub a
327− toLink _ l mv =
359+ toLink toA _ l mv =
328− toLink (Proxy :: Proxy sub) $
360+ toLink toA (Proxy :: Proxy sub) $
329 case sbool :: SBool (FoldRequired mods) of
361 case sbool :: SBool (FoldRequired mods) of
330 STrue -> (addQueryParam . SingleParam k . toQueryParam) mv l
362 STrue -> (addQueryParam . SingleParam k . toQueryParam) mv l
331 SFalse -> maybe id (addQueryParam . SingleParam k . toQueryParam) mv l
363 SFalse -> maybe id (addQueryParam . SingleParam k . toQueryParam) mv l
@@ -334,105 +366,121 @@ instance (KnownSymbol sym, ToHttpApiData v, HasLink sub, SBoolI (FoldRequired mo
334 k = symbolVal (Proxy :: Proxy sym)
366 k = symbolVal (Proxy :: Proxy sym)
335
367
336instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)
368instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)
337− => HasLink (QueryParams sym v :> sub) where
369+ => HasLink (QueryParams sym v :> sub)
370+ where
338− type MkLink (QueryParams sym v :> sub) = [v] -> MkLink sub
371+ type MkLink (QueryParams sym v :> sub) a = [v] -> MkLink sub a
339− toLink _ l =
372+ toLink toA _ l =
340− toLink (Proxy :: Proxy sub) .
373+ toLink toA (Proxy :: Proxy sub) .
341 foldl' (\l' v -> addQueryParam (ArrayElemParam k (toQueryParam v)) l') l
374 foldl' (\l' v -> addQueryParam (ArrayElemParam k (toQueryParam v)) l') l
342 where
375 where
343 k = symbolVal (Proxy :: Proxy sym)
376 k = symbolVal (Proxy :: Proxy sym)
344
377
345instance (KnownSymbol sym, HasLink sub)
378instance (KnownSymbol sym, HasLink sub)
346− => HasLink (QueryFlag sym :> sub) where
379+ => HasLink (QueryFlag sym :> sub)
380+ where
347− type MkLink (QueryFlag sym :> sub) = Bool -> MkLink sub
381+ type MkLink (QueryFlag sym :> sub) a = Bool -> MkLink sub a
348− toLink _ l False =
382+ toLink toA _ l False =
349− toLink (Proxy :: Proxy sub) l
383+ toLink toA (Proxy :: Proxy sub) l
350− toLink _ l True =
384+ toLink toA _ l True =
351− toLink (Proxy :: Proxy sub) $ addQueryParam (FlagParam k) l
385+ toLink toA (Proxy :: Proxy sub) $ addQueryParam (FlagParam k) l
352 where
386 where
353 k = symbolVal (Proxy :: Proxy sym)
387 k = symbolVal (Proxy :: Proxy sym)
354
388
355-- :<|> instance - Generate all links at once
389-- :<|> instance - Generate all links at once
356instance (HasLink a, HasLink b) => HasLink (a :<|> b) where
390instance (HasLink a, HasLink b) => HasLink (a :<|> b) where
357− type MkLink (a :<|> b) = MkLink a :<|> MkLink b
391+ type MkLink (a :<|> b) r = MkLink a r :<|> MkLink b r
358− toLink _ l = toLink (Proxy :: Proxy a) l :<|> toLink (Proxy :: Proxy b) l
392+ toLink toA _ l = toLink toA (Proxy :: Proxy a) l :<|> toLink toA (Proxy :: Proxy b) l
359
393
360-- Misc instances
394-- Misc instances
361instance HasLink sub => HasLink (ReqBody' mods ct a :> sub) where
395instance HasLink sub => HasLink (ReqBody' mods ct a :> sub) where
362− type MkLink (ReqBody' mods ct a :> sub) = MkLink sub
396+ type MkLink (ReqBody' mods ct a :> sub) r = MkLink sub r
363− toLink _ = toLink (Proxy :: Proxy sub)
397+ toLink toA _ = toLink toA (Proxy :: Proxy sub)
364
398
365instance (ToHttpApiData v, HasLink sub)
399instance (ToHttpApiData v, HasLink sub)
366− => HasLink (Capture' mods sym v :> sub) where
400+ => HasLink (Capture' mods sym v :> sub)
401+ where
367− type MkLink (Capture' mods sym v :> sub) = v -> MkLink sub
402+ type MkLink (Capture' mods sym v :> sub) a = v -> MkLink sub a
368− toLink _ l v =
403+ toLink toA _ l v =
369− toLink (Proxy :: Proxy sub) $
404+ toLink toA (Proxy :: Proxy sub) $
370 addSegment (escaped . Text.unpack $ toUrlPiece v) l
405 addSegment (escaped . Text.unpack $ toUrlPiece v) l
371
406
372instance (ToHttpApiData v, HasLink sub)
407instance (ToHttpApiData v, HasLink sub)
373− => HasLink (CaptureAll sym v :> sub) where
408+ => HasLink (CaptureAll sym v :> sub)
409+ where
374− type MkLink (CaptureAll sym v :> sub) = [v] -> MkLink sub
410+ type MkLink (CaptureAll sym v :> sub) a = [v] -> MkLink sub a
375− toLink _ l vs =
411+ toLink toA _ l vs = toLink toA (Proxy :: Proxy sub) $
376− toLink (Proxy :: Proxy sub) $
377− foldl' (flip $ addSegment . escaped . Text.unpack . toUrlPiece) l vs
412+ foldl' (flip $ addSegment . escaped . Text.unpack . toUrlPiece) l vs
378
413
379−instance HasLink sub => HasLink (Header' mods sym a :> sub) where
414+instance HasLink sub => HasLink (Header' mods sym (a :: *) :> sub) where
380− type MkLink (Header' mods sym a :> sub) = MkLink sub
415+ type MkLink (Header' mods sym a :> sub) r = MkLink sub r
381− toLink _ = toLink (Proxy :: Proxy sub)
416+ toLink = simpleToLink (Proxy :: Proxy sub)
382
417
383instance HasLink sub => HasLink (Vault :> sub) where
418instance HasLink sub => HasLink (Vault :> sub) where
384− type MkLink (Vault :> sub) = MkLink sub
419+ type MkLink (Vault :> sub) a = MkLink sub a
385− toLink _ = toLink (Proxy :: Proxy sub)
420+ toLink = simpleToLink (Proxy :: Proxy sub)
386
421
387instance HasLink sub => HasLink (Description s :> sub) where
422instance HasLink sub => HasLink (Description s :> sub) where
388− type MkLink (Description s :> sub) = MkLink sub
423+ type MkLink (Description s :> sub) a = MkLink sub a
389− toLink _ = toLink (Proxy :: Proxy sub)
424+ toLink = simpleToLink (Proxy :: Proxy sub)
390
425
391instance HasLink sub => HasLink (Summary s :> sub) where
426instance HasLink sub => HasLink (Summary s :> sub) where
392− type MkLink (Summary s :> sub) = MkLink sub
427+ type MkLink (Summary s :> sub) a = MkLink sub a
393− toLink _ = toLink (Proxy :: Proxy sub)
428+ toLink = simpleToLink (Proxy :: Proxy sub)
394
429
395instance HasLink sub => HasLink (HttpVersion :> sub) where
430instance HasLink sub => HasLink (HttpVersion :> sub) where
396− type MkLink (HttpVersion:> sub) = MkLink sub
431+ type MkLink (HttpVersion:> sub) a = MkLink sub a
397− toLink _ = toLink (Proxy :: Proxy sub)
432+ toLink = simpleToLink (Proxy :: Proxy sub)
398
433
399instance HasLink sub => HasLink (IsSecure :> sub) where
434instance HasLink sub => HasLink (IsSecure :> sub) where
400− type MkLink (IsSecure :> sub) = MkLink sub
435+ type MkLink (IsSecure :> sub) a = MkLink sub a
401− toLink _ = toLink (Proxy :: Proxy sub)
436+ toLink = simpleToLink (Proxy :: Proxy sub)
402
437
403instance HasLink sub => HasLink (WithNamedContext name context sub) where
438instance HasLink sub => HasLink (WithNamedContext name context sub) where
404− type MkLink (WithNamedContext name context sub) = MkLink sub
439+ type MkLink (WithNamedContext name context sub) a = MkLink sub a
405− toLink _ = toLink (Proxy :: Proxy sub)
440+ toLink toA _ = toLink toA (Proxy :: Proxy sub)
406
441
407instance HasLink sub => HasLink (RemoteHost :> sub) where
442instance HasLink sub => HasLink (RemoteHost :> sub) where
408− type MkLink (RemoteHost :> sub) = MkLink sub
443+ type MkLink (RemoteHost :> sub) a = MkLink sub a
409− toLink _ = toLink (Proxy :: Proxy sub)
444+ toLink = simpleToLink (Proxy :: Proxy sub)
410
445
411instance HasLink sub => HasLink (BasicAuth realm a :> sub) where
446instance HasLink sub => HasLink (BasicAuth realm a :> sub) where
412− type MkLink (BasicAuth realm a :> sub) = MkLink sub
447+ type MkLink (BasicAuth realm a :> sub) r = MkLink sub r
413− toLink _ = toLink (Proxy :: Proxy sub)
448+ toLink = simpleToLink (Proxy :: Proxy sub)
414
449
415instance HasLink EmptyAPI where
450instance HasLink EmptyAPI where
416− type MkLink EmptyAPI = EmptyAPI
451+ type MkLink EmptyAPI a = EmptyAPI
417− toLink _ _ = EmptyAPI
452+ toLink _ _ _ = EmptyAPI
418
453
419-- Verb (terminal) instances
454-- Verb (terminal) instances
420instance HasLink (Verb m s ct a) where
455instance HasLink (Verb m s ct a) where
421− type MkLink (Verb m s ct a) = Link
456+ type MkLink (Verb m s ct a) r = r
422− toLink _ = id
457+ toLink toA _ = toA
423
458
424instance HasLink Raw where
459instance HasLink Raw where
425− type MkLink Raw = Link
460+ type MkLink Raw a = a
426− toLink _ = id
461+ toLink toA _ = toA
427
462
428instance HasLink (Stream m fr ct a) where
463instance HasLink (Stream m fr ct a) where
429− type MkLink (Stream m fr ct a) = Link
464+ type MkLink (Stream m fr ct a) r = r
430− toLink _ = id
465+ toLink toA _ = toA
431
466
432-- AuthProtext instances
467-- AuthProtext instances
433instance HasLink sub => HasLink (AuthProtect tag :> sub) where
468instance HasLink sub => HasLink (AuthProtect tag :> sub) where
434− type MkLink (AuthProtect tag :> sub) = MkLink sub
469+ type MkLink (AuthProtect tag :> sub) a = MkLink sub a
470+ toLink = simpleToLink (Proxy :: Proxy sub)
471+
472+-- | Helper for implemneting 'toLink' for combinators not affecting link
473+-- structure.
474+simpleToLink
475+ :: forall sub a combinator.
476+ (HasLink sub, MkLink sub a ~ MkLink (combinator :> sub) a)
477+ => Proxy sub
478+ -> (Link -> a)
479+ -> Proxy (combinator :> sub)
480+ -> Link
481+ -> MkLink (combinator :> sub) a
435− toLink _ = toLink (Proxy :: Proxy sub)
482+simpleToLink _ toA _ = toLink toA (Proxy :: Proxy sub)
483+
436
484
437-- $setup
485-- $setup
438-- >>> import Servant.API
486-- >>> import Servant.API
servant/test/Servant/Utils/LinksSpec.hs+1−1
@@ -41,7 +41,7 @@ type LinkableApi =
41
41
42
42
43apiLink :: (IsElem endpoint TestApi, HasLink endpoint)
43apiLink :: (IsElem endpoint TestApi, HasLink endpoint)
44− => Proxy endpoint -> MkLink endpoint
44+ => Proxy endpoint -> MkLink endpoint Link
45apiLink = safeLink (Proxy :: Proxy TestApi)
45apiLink = safeLink (Proxy :: Proxy TestApi)
46
46
47-- | Convert a link to a URI and ensure that this maps to the given string
47-- | Convert a link to a URI and ensure that this maps to the given string