From d03788ee21c6294fc5a9947ec5c7085fb21c76a9 Mon Sep 17 00:00:00 2001 From: Christian Marie Date: Fri, 30 Jan 2015 11:03:48 +1100 Subject: [PATCH] Flip safeLink and rename link to toLink --- src/Servant/API.hs | 2 +- src/Servant/Utils/Links.hs | 99 ++++++++++++++++++--------------- test/Servant/Utils/LinksSpec.hs | 30 +++++----- 3 files changed, 72 insertions(+), 59 deletions(-) diff --git a/src/Servant/API.hs b/src/Servant/API.hs index 7891444b..27ef7f93 100644 --- a/src/Servant/API.hs +++ b/src/Servant/API.hs @@ -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(..) ) diff --git a/src/Servant/Utils/Links.hs b/src/Servant/Utils/Links.hs index 31c54cde..d49fd599 100644 --- a/src/Servant/Utils/Links.hs +++ b/src/Servant/Utils/Links.hs @@ -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 -- --- :56:1: +-- :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 diff --git a/test/Servant/Utils/LinksSpec.hs b/test/Servant/Utils/LinksSpec.hs index 60a02c50..c5eee2ad 100644 --- a/test/Servant/Utils/LinksSpec.hs +++ b/test/Servant/Utils/LinksSpec.hs @@ -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"