Flip safeLink and rename link to toLink
This commit is contained in:
parent
12cf4e02ab
commit
d03788ee21
3 changed files with 72 additions and 59 deletions
|
@ -52,4 +52,4 @@ import Servant.API.Raw ( Raw )
|
|||
import Servant.API.ReqBody ( ReqBody )
|
||||
import Servant.API.Sub ( (:>)(..) )
|
||||
import Servant.QQ ( sitemap )
|
||||
import Servant.Utils.Links ( safeLink, URI(..) )
|
||||
import Servant.Utils.Links ( safeLink, URI(..), IsElem, IsElem', HasLink(..) )
|
||||
|
|
|
@ -25,12 +25,12 @@
|
|||
-- >>> let api = Proxy :: Proxy API
|
||||
--
|
||||
-- It is possible to generate links that are guaranteed to be within 'API' with
|
||||
-- 'safeLink'. The first argument to 'safeLink' is a type representing the
|
||||
-- endpoint you would like to point to. This will need to end in a verb like
|
||||
-- Get, or Post. The second argument is the API in which you would like to
|
||||
-- ensure the endpoint is within. Further arguments be required depending on
|
||||
-- the type of the endpoint. If everything lines up you will get a 'URI' out
|
||||
-- the other end.
|
||||
-- 'safeLink'. The first argument to 'safeLink' is a type representing the API
|
||||
-- you would like to restrict links to. The second argument is the destination
|
||||
-- endpoint you would like the link to point to, this will need to end with a
|
||||
-- verb like GET or POST. Further arguments may be required depending on the
|
||||
-- type of the endpoint. If everything lines up you will get a 'URI' out the
|
||||
-- other end.
|
||||
--
|
||||
-- You may omit 'QueryParam's and the like should you not want to provide them,
|
||||
-- but types which form part of the URL path like 'Capture' must be included.
|
||||
|
@ -40,35 +40,46 @@
|
|||
-- with an example. Here, a link is generated with no parameters:
|
||||
--
|
||||
-- >>> let hello = Proxy :: Proxy ("hello" :> Get Int)
|
||||
-- >>> print (safeLink hello api :: URI)
|
||||
-- >>> print (safeLink api hello :: URI)
|
||||
-- hello
|
||||
--
|
||||
-- If the API has an endpoint with parameters then we can generate links with
|
||||
-- or without those:
|
||||
--
|
||||
-- >>> let with = Proxy :: Proxy ("bye" :> QueryParam "name" String :> Delete)
|
||||
-- >>> print $ safeLink with api "Hubert"
|
||||
-- >>> print $ safeLink api with "Hubert"
|
||||
-- bye?name=Hubert
|
||||
--
|
||||
-- >>> let without = Proxy :: Proxy ("bye" :> Delete)
|
||||
-- >>> print $ safeLink without api
|
||||
-- >>> print $ safeLink api without
|
||||
-- bye
|
||||
--
|
||||
-- If you would like create a helper for generating links only within that API,
|
||||
-- you can partially apply safeLink if you specify a correct type signature
|
||||
-- like so:
|
||||
--
|
||||
-- >>> :set -XConstraintKinds
|
||||
-- >>> :{
|
||||
-- >>> let apiLink :: (IsElem endpoint API, HasLink endpoint)
|
||||
-- >>> => Proxy endpoint -> MkLink endpoint
|
||||
-- >>> apiLink = safeLink api
|
||||
-- >>> :}
|
||||
--
|
||||
-- Attempting to construct a link to an endpoint that does not exist in api
|
||||
-- will result in a type error like this:
|
||||
--
|
||||
-- >>> let bad_link = Proxy :: Proxy ("hello" :> Delete)
|
||||
-- >>> safeLink bad_link api
|
||||
-- >>> safeLink api bad_link
|
||||
-- <BLANKLINE>
|
||||
-- <interactive>:56:1:
|
||||
-- <interactive>:64:1:
|
||||
-- Could not deduce (Or
|
||||
-- (IsElem' Delete (Get Int))
|
||||
-- (IsElem'
|
||||
-- ("hello" :> Delete)
|
||||
-- ("bye" :> (QueryParam "name" String :> Delete))))
|
||||
-- arising from a use of ‘safeLink’
|
||||
-- In the expression: safeLink bad_link api
|
||||
-- In an equation for ‘it’: it = safeLink bad_link api
|
||||
-- In the expression: safeLink api bad_link
|
||||
-- In an equation for ‘it’: it = safeLink api bad_link
|
||||
--
|
||||
-- This error is essentially saying that the type family couldn't find
|
||||
-- bad_link under api after trying the open (but empty) type family
|
||||
|
@ -213,23 +224,23 @@ escape = escapeURIString isUnreserved
|
|||
-- This function will only typecheck if `endpoint` is part of the API `api`
|
||||
safeLink
|
||||
:: forall endpoint api. (IsElem endpoint api, HasLink endpoint)
|
||||
=> Proxy endpoint -- ^ The API endpoint you would like to point to
|
||||
-> Proxy api -- ^ The whole API that this endpoint is a part of
|
||||
=> Proxy api -- ^ The whole API that this endpoint is a part of
|
||||
-> Proxy endpoint -- ^ The API endpoint you would like to point to
|
||||
-> MkLink endpoint
|
||||
safeLink endpoint _ = link endpoint (Link mempty mempty)
|
||||
safeLink _ endpoint = toLink endpoint (Link mempty mempty)
|
||||
|
||||
-- | Construct a link for an endpoint.
|
||||
-- | Construct a toLink for an endpoint.
|
||||
class HasLink endpoint where
|
||||
type MkLink endpoint
|
||||
link :: Proxy endpoint -- ^ The API endpoint you would like to point to
|
||||
toLink :: Proxy endpoint -- ^ The API endpoint you would like to point to
|
||||
-> Link
|
||||
-> MkLink endpoint
|
||||
|
||||
-- Naked symbol instance
|
||||
instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
|
||||
type MkLink (sym :> sub) = MkLink sub
|
||||
link _ =
|
||||
link (Proxy :: Proxy sub) . addSegment seg
|
||||
toLink _ =
|
||||
toLink (Proxy :: Proxy sub) . addSegment seg
|
||||
where
|
||||
seg = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
|
@ -238,8 +249,8 @@ instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
|
|||
instance (KnownSymbol sym, ToText v, HasLink sub)
|
||||
=> HasLink (QueryParam sym v :> sub) where
|
||||
type MkLink (QueryParam sym v :> sub) = v -> MkLink sub
|
||||
link _ l v =
|
||||
link (Proxy :: Proxy sub)
|
||||
toLink _ l v =
|
||||
toLink (Proxy :: Proxy sub)
|
||||
(addQueryParam (SingleParam k (toText v)) l)
|
||||
where
|
||||
k :: String
|
||||
|
@ -248,8 +259,8 @@ instance (KnownSymbol sym, ToText v, HasLink sub)
|
|||
instance (KnownSymbol sym, ToText v, HasLink sub)
|
||||
=> HasLink (QueryParams sym v :> sub) where
|
||||
type MkLink (QueryParams sym v :> sub) = [v] -> MkLink sub
|
||||
link _ l =
|
||||
link (Proxy :: Proxy sub) .
|
||||
toLink _ l =
|
||||
toLink (Proxy :: Proxy sub) .
|
||||
foldl' (\l' v -> addQueryParam (ArrayElemParam k (toText v)) l') l
|
||||
where
|
||||
k = symbolVal (Proxy :: Proxy sym)
|
||||
|
@ -257,10 +268,10 @@ instance (KnownSymbol sym, ToText v, HasLink sub)
|
|||
instance (KnownSymbol sym, HasLink sub)
|
||||
=> HasLink (QueryFlag sym :> sub) where
|
||||
type MkLink (QueryFlag sym :> sub) = Bool -> MkLink sub
|
||||
link _ l False =
|
||||
link (Proxy :: Proxy sub) l
|
||||
link _ l True =
|
||||
link (Proxy :: Proxy sub) $ addQueryParam (FlagParam k) l
|
||||
toLink _ l False =
|
||||
toLink (Proxy :: Proxy sub) l
|
||||
toLink _ l True =
|
||||
toLink (Proxy :: Proxy sub) $ addQueryParam (FlagParam k) l
|
||||
where
|
||||
k = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
|
@ -268,8 +279,8 @@ instance (KnownSymbol sym, HasLink sub)
|
|||
instance (KnownSymbol sym, ToText v, HasLink sub)
|
||||
=> HasLink (MatrixParam sym v :> sub) where
|
||||
type MkLink (MatrixParam sym v :> sub) = v -> MkLink sub
|
||||
link _ l v =
|
||||
link (Proxy :: Proxy sub) $
|
||||
toLink _ l v =
|
||||
toLink (Proxy :: Proxy sub) $
|
||||
addMatrixParam (SingleParam k (toText v)) l
|
||||
where
|
||||
k = symbolVal (Proxy :: Proxy sym)
|
||||
|
@ -277,8 +288,8 @@ instance (KnownSymbol sym, ToText v, HasLink sub)
|
|||
instance (KnownSymbol sym, ToText v, HasLink sub)
|
||||
=> HasLink (MatrixParams sym v :> sub) where
|
||||
type MkLink (MatrixParams sym v :> sub) = [v] -> MkLink sub
|
||||
link _ l =
|
||||
link (Proxy :: Proxy sub) .
|
||||
toLink _ l =
|
||||
toLink (Proxy :: Proxy sub) .
|
||||
foldl' (\l' v -> addMatrixParam (ArrayElemParam k (toText v)) l') l
|
||||
where
|
||||
k = symbolVal (Proxy :: Proxy sym)
|
||||
|
@ -286,42 +297,42 @@ instance (KnownSymbol sym, ToText v, HasLink sub)
|
|||
instance (KnownSymbol sym, HasLink sub)
|
||||
=> HasLink (MatrixFlag sym :> sub) where
|
||||
type MkLink (MatrixFlag sym :> sub) = Bool -> MkLink sub
|
||||
link _ l False =
|
||||
link (Proxy :: Proxy sub) l
|
||||
link _ l True =
|
||||
link (Proxy :: Proxy sub) $ addMatrixParam (FlagParam k) l
|
||||
toLink _ l False =
|
||||
toLink (Proxy :: Proxy sub) l
|
||||
toLink _ l True =
|
||||
toLink (Proxy :: Proxy sub) $ addMatrixParam (FlagParam k) l
|
||||
where
|
||||
k = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
-- Misc instances
|
||||
instance HasLink sub => HasLink (ReqBody a :> sub) where
|
||||
type MkLink (ReqBody a :> sub) = MkLink sub
|
||||
link _ = link (Proxy :: Proxy sub)
|
||||
toLink _ = toLink (Proxy :: Proxy sub)
|
||||
|
||||
instance (ToText v, HasLink sub)
|
||||
=> HasLink (Capture sym v :> sub) where
|
||||
type MkLink (Capture sym v :> sub) = v -> MkLink sub
|
||||
link _ l v =
|
||||
link (Proxy :: Proxy sub) $
|
||||
toLink _ l v =
|
||||
toLink (Proxy :: Proxy sub) $
|
||||
addSegment (escape . unpack $ toText v) l
|
||||
|
||||
-- Verb (terminal) instances
|
||||
instance HasLink (Get r) where
|
||||
type MkLink (Get r) = URI
|
||||
link _ = linkURI
|
||||
toLink _ = linkURI
|
||||
|
||||
instance HasLink (Post r) where
|
||||
type MkLink (Post r) = URI
|
||||
link _ = linkURI
|
||||
toLink _ = linkURI
|
||||
|
||||
instance HasLink (Put r) where
|
||||
type MkLink (Put r) = URI
|
||||
link _ = linkURI
|
||||
toLink _ = linkURI
|
||||
|
||||
instance HasLink Delete where
|
||||
type MkLink Delete = URI
|
||||
link _ = linkURI
|
||||
toLink _ = linkURI
|
||||
|
||||
instance HasLink Raw where
|
||||
type MkLink Raw = URI
|
||||
link _ = linkURI
|
||||
toLink _ = linkURI
|
||||
|
|
|
@ -1,6 +1,7 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
|
||||
module Servant.Utils.LinksSpec where
|
||||
|
||||
|
@ -31,8 +32,9 @@ type TestLink = "hello" :> "hi" :> Get Bool
|
|||
type TestLink2 = "greet" :> Post Bool
|
||||
type TestLink3 = "parent" :> "child" :> Get String
|
||||
|
||||
api :: Proxy TestApi
|
||||
api = Proxy
|
||||
apiLink :: (IsElem endpoint TestApi, HasLink endpoint)
|
||||
=> Proxy endpoint -> MkLink endpoint
|
||||
apiLink = safeLink (Proxy :: Proxy TestApi)
|
||||
|
||||
-- | Convert a link to a URI and ensure that this maps to the given string
|
||||
-- given string
|
||||
|
@ -44,35 +46,35 @@ spec :: Spec
|
|||
spec = describe "Servant.Utils.Links" $ do
|
||||
it "Generates correct links for capture query and matrix params" $ do
|
||||
let l1 = Proxy :: Proxy ("hello" :> Capture "name" String :> Delete)
|
||||
safeLink l1 api "hi" `shouldBeURI` "hello/hi"
|
||||
apiLink l1 "hi" `shouldBeURI` "hello/hi"
|
||||
|
||||
let l2 = Proxy :: Proxy ("hello" :> Capture "name" String
|
||||
:> QueryParam "capital" Bool
|
||||
:> Delete)
|
||||
safeLink l2 api "bye" True `shouldBeURI` "hello/bye?capital=true"
|
||||
apiLink l2 "bye" True `shouldBeURI` "hello/bye?capital=true"
|
||||
|
||||
let l3 = Proxy :: Proxy ("parent" :> MatrixParams "name" String
|
||||
:> "child"
|
||||
:> MatrixParam "gender" String
|
||||
:> Get String)
|
||||
safeLink l3 api ["Hubert?x=;&", "Cumberdale"] "Edward?"
|
||||
apiLink l3 ["Hubert?x=;&", "Cumberdale"] "Edward?"
|
||||
`shouldBeURI` "parent;name[]=Hubert%3Fx%3D%3B%26;\
|
||||
\name[]=Cumberdale/child;gender=Edward%3F"
|
||||
|
||||
it "Generates correct links for query and matrix flags" $ do
|
||||
let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy"
|
||||
:> QueryFlag "fast" :> Delete)
|
||||
safeLink l1 api True True `shouldBeURI` "balls?bouncy&fast"
|
||||
safeLink l1 api False True `shouldBeURI` "balls?fast"
|
||||
apiLink l1 True True `shouldBeURI` "balls?bouncy&fast"
|
||||
apiLink l1 False True `shouldBeURI` "balls?fast"
|
||||
|
||||
let l2 = Proxy :: Proxy ("ducks" :> MatrixFlag "yellow"
|
||||
:> MatrixFlag "loud" :> Delete)
|
||||
safeLink l2 api True True `shouldBeURI` "ducks;yellow;loud"
|
||||
safeLink l2 api False True `shouldBeURI` "ducks;loud"
|
||||
apiLink l2 True True `shouldBeURI` "ducks;yellow;loud"
|
||||
apiLink l2 False True `shouldBeURI` "ducks;loud"
|
||||
|
||||
it "Generates correct links for all of the verbs" $ do
|
||||
safeLink (Proxy :: Proxy ("get" :> Get ())) api `shouldBeURI` "get"
|
||||
safeLink (Proxy :: Proxy ("put" :> Put ())) api `shouldBeURI` "put"
|
||||
safeLink (Proxy :: Proxy ("post" :> Post ())) api `shouldBeURI` "post"
|
||||
safeLink (Proxy :: Proxy ("delete" :> Delete)) api `shouldBeURI` "delete"
|
||||
safeLink (Proxy :: Proxy ("raw" :> Raw)) api `shouldBeURI` "raw"
|
||||
apiLink (Proxy :: Proxy ("get" :> Get ())) `shouldBeURI` "get"
|
||||
apiLink (Proxy :: Proxy ("put" :> Put ())) `shouldBeURI` "put"
|
||||
apiLink (Proxy :: Proxy ("post" :> Post ())) `shouldBeURI` "post"
|
||||
apiLink (Proxy :: Proxy ("delete" :> Delete)) `shouldBeURI` "delete"
|
||||
apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeURI` "raw"
|
||||
|
|
Loading…
Reference in a new issue