@@ -19,8 +19,6 @@
1919-- >>> import Servant.Utils.Links
2020-- >>> import Data.Proxy
2121-- >>>
22−-- >>>
23−-- >>>
2422-- >>> type Hello = "hello" :> Get '[JSON] Int
2523-- >>> type Bye = "bye" :> QueryParam "name" String :> Delete '[JSON] NoContent
2624-- >>> type API = Hello :<|> Bye
@@ -63,10 +61,24 @@
6361-- >>> :set -XConstraintKinds
6462-- >>> :{
6563-- >>> let apiLink :: (IsElem endpoint API, HasLink endpoint)
66−-- >>> => Proxy endpoint -> MkLink endpoint
64+-- >>> => Proxy endpoint -> MkLink endpoint Link
6765-- >>> apiLink = safeLink api
6866-- >>> :}
6967--
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+--
7082-- Attempting to construct a link to an endpoint that does not exist in api
7183-- will result in a type error like this:
7284--
@@ -86,7 +98,9 @@ module Servant.Utils.Links (
8698 --
8799 -- | Note that 'URI' is from the "Network.URI" module in the @network-uri@ package.
88100 safeLink
101+ , safeLink'
89102 , allLinks
103+ , allLinks'
90104 , URI(..)
91105 -- * Adding custom types
92106 , HasLink(..)
@@ -109,8 +123,6 @@ import Data.Singletons.Bool
109123 (SBool (..), SBoolI (..))
110124import qualified Data.Text as Text
111125import qualified Data.Text.Encoding as TE
112−import Data.Type.Bool
113− (If)
114126import Data.Type.Bool
115127 (If)
116128import GHC.TypeLits
@@ -278,8 +290,18 @@ safeLink
278290 :: forall endpoint api. (IsElem endpoint api, HasLink endpoint)
279291 => Proxy api -- ^ The whole API that this endpoint is a part of
280292 -> Proxy endpoint -- ^ The API endpoint you would like to point to
281− -> MkLink endpoint
282−safeLink _ endpoint = toLink endpoint (Link mempty mempty)
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
304+safeLink' toA _ endpoint = toLink toA endpoint (Link mempty mempty)
283305
284306-- | Create all links in an API.
285307--
@@ -295,37 +317,47 @@ safeLink _ endpoint = toLink endpoint (Link mempty mempty)
295317--
296318-- Note: nested APIs don't work well with this approach
297319--
298−-- >>> :kind! MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double))
299−-- 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
321+-- MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double)) Link :: *
300322-- = Char -> (Int -> Link) :<|> (Double -> Link)
301−--
302323allLinks
303324 :: forall api. HasLink api
304325 => Proxy api
305− -> MkLink api
306−allLinks api = toLink api (Link mempty mempty)
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
335+allLinks' toA api = toLink toA api (Link mempty mempty)
307336
308337-- | Construct a toLink for an endpoint.
309338class HasLink endpoint where
310− type MkLink endpoint
311− toLink :: Proxy endpoint -- ^ The API endpoint you would like to point to
312− -> Link
313− -> MkLink endpoint
339+ type MkLink endpoint (a :: *)
340+ toLink
341+ :: (Link -> a)
342+ -> Proxy endpoint -- ^ The API endpoint you would like to point to
343+ -> Link
344+ -> MkLink endpoint a
314345
315346-- Naked symbol instance
316347instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
317− type MkLink (sym :> sub) = MkLink sub
318− toLink _ =
319− toLink (Proxy :: Proxy sub) . addSegment (escaped seg)
348+ type MkLink (sym :> sub) a = MkLink sub a
349+ toLink toA _ =
350+ toLink toA (Proxy :: Proxy sub) . addSegment (escaped seg)
320351 where
321352 seg = symbolVal (Proxy :: Proxy sym)
322353
323354-- QueryParam instances
324355instance (KnownSymbol sym, ToHttpApiData v, HasLink sub, SBoolI (FoldRequired mods))
325− => HasLink (QueryParam' mods sym v :> sub) where
326− type MkLink (QueryParam' mods sym v :> sub) = If (FoldRequired mods) v (Maybe v) -> MkLink sub
327− toLink _ l mv =
328− toLink (Proxy :: Proxy sub) $
356+ => HasLink (QueryParam' mods sym v :> sub)
357+ where
358+ type MkLink (QueryParam' mods sym v :> sub) a = If (FoldRequired mods) v (Maybe v) -> MkLink sub a
359+ toLink toA _ l mv =
360+ toLink toA (Proxy :: Proxy sub) $
329361 case sbool :: SBool (FoldRequired mods) of
330362 STrue -> (addQueryParam . SingleParam k . toQueryParam) mv l
331363 SFalse -> maybe id (addQueryParam . SingleParam k . toQueryParam) mv l
@@ -334,105 +366,121 @@ instance (KnownSymbol sym, ToHttpApiData v, HasLink sub, SBoolI (FoldRequired mo
334366 k = symbolVal (Proxy :: Proxy sym)
335367
336368instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)
337− => HasLink (QueryParams sym v :> sub) where
338− type MkLink (QueryParams sym v :> sub) = [v] -> MkLink sub
339− toLink _ l =
340− toLink (Proxy :: Proxy sub) .
369+ => HasLink (QueryParams sym v :> sub)
370+ where
371+ type MkLink (QueryParams sym v :> sub) a = [v] -> MkLink sub a
372+ toLink toA _ l =
373+ toLink toA (Proxy :: Proxy sub) .
341374 foldl' (\l' v -> addQueryParam (ArrayElemParam k (toQueryParam v)) l') l
342375 where
343376 k = symbolVal (Proxy :: Proxy sym)
344377
345378instance (KnownSymbol sym, HasLink sub)
346− => HasLink (QueryFlag sym :> sub) where
347− type MkLink (QueryFlag sym :> sub) = Bool -> MkLink sub
348− toLink _ l False =
349− toLink (Proxy :: Proxy sub) l
350− toLink _ l True =
351− toLink (Proxy :: Proxy sub) $ addQueryParam (FlagParam k) l
379+ => HasLink (QueryFlag sym :> sub)
380+ where
381+ type MkLink (QueryFlag sym :> sub) a = Bool -> MkLink sub a
382+ toLink toA _ l False =
383+ toLink toA (Proxy :: Proxy sub) l
384+ toLink toA _ l True =
385+ toLink toA (Proxy :: Proxy sub) $ addQueryParam (FlagParam k) l
352386 where
353387 k = symbolVal (Proxy :: Proxy sym)
354388
355389-- :<|> instance - Generate all links at once
356390instance (HasLink a, HasLink b) => HasLink (a :<|> b) where
357− type MkLink (a :<|> b) = MkLink a :<|> MkLink b
358− toLink _ l = toLink (Proxy :: Proxy a) l :<|> toLink (Proxy :: Proxy b) l
391+ type MkLink (a :<|> b) r = MkLink a r :<|> MkLink b r
392+ toLink toA _ l = toLink toA (Proxy :: Proxy a) l :<|> toLink toA (Proxy :: Proxy b) l
359393
360394-- Misc instances
361395instance HasLink sub => HasLink (ReqBody' mods ct a :> sub) where
362− type MkLink (ReqBody' mods ct a :> sub) = MkLink sub
363− toLink _ = toLink (Proxy :: Proxy sub)
396+ type MkLink (ReqBody' mods ct a :> sub) r = MkLink sub r
397+ toLink toA _ = toLink toA (Proxy :: Proxy sub)
364398
365399instance (ToHttpApiData v, HasLink sub)
366− => HasLink (Capture' mods sym v :> sub) where
367− type MkLink (Capture' mods sym v :> sub) = v -> MkLink sub
368− toLink _ l v =
369− toLink (Proxy :: Proxy sub) $
400+ => HasLink (Capture' mods sym v :> sub)
401+ where
402+ type MkLink (Capture' mods sym v :> sub) a = v -> MkLink sub a
403+ toLink toA _ l v =
404+ toLink toA (Proxy :: Proxy sub) $
370405 addSegment (escaped . Text.unpack $ toUrlPiece v) l
371406
372407instance (ToHttpApiData v, HasLink sub)
373− => HasLink (CaptureAll sym v :> sub) where
374− type MkLink (CaptureAll sym v :> sub) = [v] -> MkLink sub
375− toLink _ l vs =
376− toLink (Proxy :: Proxy sub) $
377− foldl' (flip $ addSegment . escaped . Text.unpack . toUrlPiece) l vs
408+ => HasLink (CaptureAll sym v :> sub)
409+ where
410+ type MkLink (CaptureAll sym v :> sub) a = [v] -> MkLink sub a
411+ toLink toA _ l vs = toLink toA (Proxy :: Proxy sub) $
412+ foldl' (flip $ addSegment . escaped . Text.unpack . toUrlPiece) l vs
378413
379−instance HasLink sub => HasLink (Header' mods sym a :> sub) where
380− type MkLink (Header' mods sym a :> sub) = MkLink sub
381− toLink _ = toLink (Proxy :: Proxy sub)
414+instance HasLink sub => HasLink (Header' mods sym (a :: *) :> sub) where
415+ type MkLink (Header' mods sym a :> sub) r = MkLink sub r
416+ toLink = simpleToLink (Proxy :: Proxy sub)
382417
383418instance HasLink sub => HasLink (Vault :> sub) where
384− type MkLink (Vault :> sub) = MkLink sub
385− toLink _ = toLink (Proxy :: Proxy sub)
419+ type MkLink (Vault :> sub) a = MkLink sub a
420+ toLink = simpleToLink (Proxy :: Proxy sub)
386421
387422instance HasLink sub => HasLink (Description s :> sub) where
388− type MkLink (Description s :> sub) = MkLink sub
389− toLink _ = toLink (Proxy :: Proxy sub)
423+ type MkLink (Description s :> sub) a = MkLink sub a
424+ toLink = simpleToLink (Proxy :: Proxy sub)
390425
391426instance HasLink sub => HasLink (Summary s :> sub) where
392− type MkLink (Summary s :> sub) = MkLink sub
393− toLink _ = toLink (Proxy :: Proxy sub)
427+ type MkLink (Summary s :> sub) a = MkLink sub a
428+ toLink = simpleToLink (Proxy :: Proxy sub)
394429
395430instance HasLink sub => HasLink (HttpVersion :> sub) where
396− type MkLink (HttpVersion:> sub) = MkLink sub
397− toLink _ = toLink (Proxy :: Proxy sub)
431+ type MkLink (HttpVersion:> sub) a = MkLink sub a
432+ toLink = simpleToLink (Proxy :: Proxy sub)
398433
399434instance HasLink sub => HasLink (IsSecure :> sub) where
400− type MkLink (IsSecure :> sub) = MkLink sub
401− toLink _ = toLink (Proxy :: Proxy sub)
435+ type MkLink (IsSecure :> sub) a = MkLink sub a
436+ toLink = simpleToLink (Proxy :: Proxy sub)
402437
403438instance HasLink sub => HasLink (WithNamedContext name context sub) where
404− type MkLink (WithNamedContext name context sub) = MkLink sub
405− toLink _ = toLink (Proxy :: Proxy sub)
439+ type MkLink (WithNamedContext name context sub) a = MkLink sub a
440+ toLink toA _ = toLink toA (Proxy :: Proxy sub)
406441
407442instance HasLink sub => HasLink (RemoteHost :> sub) where
408− type MkLink (RemoteHost :> sub) = MkLink sub
409− toLink _ = toLink (Proxy :: Proxy sub)
443+ type MkLink (RemoteHost :> sub) a = MkLink sub a
444+ toLink = simpleToLink (Proxy :: Proxy sub)
410445
411446instance HasLink sub => HasLink (BasicAuth realm a :> sub) where
412− type MkLink (BasicAuth realm a :> sub) = MkLink sub
413− toLink _ = toLink (Proxy :: Proxy sub)
447+ type MkLink (BasicAuth realm a :> sub) r = MkLink sub r
448+ toLink = simpleToLink (Proxy :: Proxy sub)
414449
415450instance HasLink EmptyAPI where
416− type MkLink EmptyAPI = EmptyAPI
417− toLink _ _ = EmptyAPI
451+ type MkLink EmptyAPI a = EmptyAPI
452+ toLink _ _ _ = EmptyAPI
418453
419454-- Verb (terminal) instances
420455instance HasLink (Verb m s ct a) where
421− type MkLink (Verb m s ct a) = Link
422− toLink _ = id
456+ type MkLink (Verb m s ct a) r = r
457+ toLink toA _ = toA
423458
424459instance HasLink Raw where
425− type MkLink Raw = Link
426− toLink _ = id
460+ type MkLink Raw a = a
461+ toLink toA _ = toA
427462
428463instance HasLink (Stream m fr ct a) where
429− type MkLink (Stream m fr ct a) = Link
430− toLink _ = id
464+ type MkLink (Stream m fr ct a) r = r
465+ toLink toA _ = toA
431466
432467-- AuthProtext instances
433468instance HasLink sub => HasLink (AuthProtect tag :> sub) where
434− type MkLink (AuthProtect tag :> sub) = MkLink sub
435− toLink _ = toLink (Proxy :: Proxy 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
482+simpleToLink _ toA _ = toLink toA (Proxy :: Proxy sub)
483+
436484
437485-- $setup
438486-- >>> import Servant.API