Rewrite Utils.Links to export a nicer API.
* Add support for parameters. * Clean up type level magic, invalid links no longer have a type. * Proxies are now used to be consistent with the rest of the servant ecosystem.
This commit is contained in:
Christian Marie
parent
6785717d8c
commit
70ffe01f9a
6 changed files with 338 additions and 132 deletions
|
|
@ -3,6 +3,10 @@ language: haskell
|
|||
ghc:
|
||||
- 7.8
|
||||
|
||||
after_success:
|
||||
- sudo apt-get -y install doctest
|
||||
- ./test-docs.sh
|
||||
|
||||
notifications:
|
||||
irc:
|
||||
channels:
|
||||
|
|
|
|||
|
|
@ -47,6 +47,8 @@ library
|
|||
, template-haskell
|
||||
, parsec >= 3.1
|
||||
, string-conversions >= 0.3
|
||||
, network-uri >= 2.6
|
||||
, safe
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
|
|
@ -60,8 +62,11 @@ test-suite spec
|
|||
main-is: Spec.hs
|
||||
build-depends:
|
||||
base == 4.*
|
||||
, deepseq
|
||||
, hspec == 2.*
|
||||
, QuickCheck
|
||||
, network-uri
|
||||
, parsec
|
||||
, parsec
|
||||
, servant
|
||||
, string-conversions
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@ module Servant.API (
|
|||
-- * Utilities
|
||||
-- | QuasiQuotes for endpoints
|
||||
module Servant.QQ,
|
||||
-- | Type-safe internal URLs
|
||||
-- | Type-safe internal URIs
|
||||
module Servant.Utils.Links,
|
||||
) where
|
||||
|
||||
|
|
@ -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 ( mkLink )
|
||||
import Servant.Utils.Links ( safeLink, URI(..) )
|
||||
|
|
|
|||
|
|
@ -8,76 +8,102 @@
|
|||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
-- | Type safe internal links.
|
||||
-- | Type safe generation of internal links.
|
||||
--
|
||||
-- Provides the function 'mkLink':
|
||||
-- Given an API with a few endpoints:
|
||||
--
|
||||
-- @
|
||||
-- {-# LANGUAGE DataKinds #-}
|
||||
-- {-# LANGUAGE TypeFamilies #-}
|
||||
-- {-# LANGUAGE TypeOperators #-}
|
||||
-- >>> :set -XDataKinds -XTypeFamilies -XTypeOperators
|
||||
-- >>> import Servant.API
|
||||
-- >>> import Servant.Utils.Links
|
||||
-- >>> import Data.Proxy
|
||||
-- >>>
|
||||
-- >>>
|
||||
-- >>>
|
||||
-- >>> type Hello = "hello" :> Get Int
|
||||
-- >>> type Bye = "bye" :> QueryParam "name" String :> Delete
|
||||
-- >>> type API = Hello :<|> Bye
|
||||
-- >>> let api = Proxy :: Proxy API
|
||||
--
|
||||
-- import Servant.API
|
||||
-- import Servant.Utils.Links
|
||||
-- It is possible to generate links that are guaranteed to be within 'API' with
|
||||
-- 'safeLink'.
|
||||
--
|
||||
-- -- You might want to put some custom types in your API
|
||||
-- data Thing = Thing
|
||||
-- The first argument to 'safeLink' is a symbol representing the endpoint you
|
||||
-- would like to point to. This will need to end in a verb like Get, or Post.
|
||||
--
|
||||
-- -- If you want these to form part of a valid URL, just add them to the
|
||||
-- -- open type family IsElem' like so:
|
||||
-- type instance IsElem' e (Thing :> s) = IsElem e s
|
||||
-- You may omit 'QueryParam's and the like should you not want to provide them,
|
||||
-- but certain other types like 'Capture' must be included.
|
||||
--
|
||||
-- type API = "hello" :> Thing :> Get Int
|
||||
-- :<|> "bye" :> QueryParam "name" String :> Post Bool
|
||||
-- The reason you may want to omit 'QueryParam's is that safeLink is a bit
|
||||
-- magical: if parameters are included that could take input it will return a
|
||||
-- function that accepts that input and generates a link.
|
||||
--
|
||||
-- api :: API
|
||||
-- api = undefined
|
||||
-- This is best shown with an example. Here, a link is generated with no
|
||||
-- parameters:
|
||||
--
|
||||
-- link1 :: "hello" :> Get Int
|
||||
-- link1 = undefined
|
||||
-- >>> let hello = Proxy :: Proxy ("hello" :> Get Int)
|
||||
-- >>> print $ safeLink hello api
|
||||
-- hello
|
||||
--
|
||||
-- link2 :: "hello" :> Delete
|
||||
-- link2 = undefined
|
||||
-- If the API has an endpoint with parameters then we can generate links with
|
||||
-- or without those:
|
||||
--
|
||||
-- main :: IO ()
|
||||
-- main =
|
||||
-- -- typechecks, prints "/hello"'
|
||||
-- let Link str = mkLink link1 api
|
||||
-- in putStrLn str
|
||||
-- >>> let with = Proxy :: Proxy ("bye" :> QueryParam "name" String :> Delete)
|
||||
-- >>> print $ safeLink with api "Hubert"
|
||||
-- bye?name=Hubert
|
||||
--
|
||||
-- -- doesn't typecheck
|
||||
-- -- mkLink link2 api
|
||||
-- @
|
||||
-- >>> let without = Proxy :: Proxy ("bye" :> Delete)
|
||||
-- >>> print $ safeLink without api
|
||||
-- bye
|
||||
--
|
||||
-- That is, 'mkLink' takes two arguments, a link and a sitemap, and
|
||||
-- returns a 'Link', but only typechecks if the link proxy is a valid link,
|
||||
-- and part of the sitemap.
|
||||
-- Attempting to construct a link to an endpoint that does not exist in api
|
||||
-- will result in a type error like this:
|
||||
--
|
||||
-- __N.B.:__ 'mkLink' assumes a capture matches any string (without slashes).
|
||||
-- >>> let bad_link = Proxy :: Proxy ("hello" :> Delete)
|
||||
-- >>> safeLink bad_link api
|
||||
-- <BLANKLINE>
|
||||
-- <interactive>:56: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
|
||||
--
|
||||
-- This error is essentially saying that the type family couldn't find
|
||||
-- bad_link under api after trying the open (but empty) type family
|
||||
-- `IsElem'` as a last resort.
|
||||
module Servant.Utils.Links (
|
||||
-- * Link and mkLink
|
||||
-- | The only end-user utilities
|
||||
mkLink
|
||||
, Link, unLink
|
||||
-- * Internal
|
||||
-- | These functions will likely only be of interest if you are writing
|
||||
-- more API combinators and would like to extend the behavior of
|
||||
-- 'mkLink'
|
||||
, ValidLinkIn()
|
||||
, VLinkHelper(..)
|
||||
, IsElem
|
||||
-- * Building and using safe links
|
||||
--
|
||||
-- | Note that 'URI' is Network.URI.URI from the network-uri package.
|
||||
safeLink
|
||||
, URI(..)
|
||||
-- * Adding custom types
|
||||
, HasLink(..)
|
||||
, linkURI
|
||||
, Link
|
||||
, IsElem'
|
||||
, IsLink
|
||||
) where
|
||||
-- * Illustrative exports
|
||||
, IsElem
|
||||
, Or
|
||||
) where
|
||||
|
||||
import Data.List
|
||||
import Data.Proxy ( Proxy(..) )
|
||||
import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )
|
||||
import Data.Text (Text, unpack)
|
||||
import Data.Monoid ( Monoid(..), (<>) )
|
||||
import Network.URI ( URI(..), escapeURIString, isUnreserved )
|
||||
import GHC.TypeLits ( KnownSymbol, symbolVal )
|
||||
import GHC.Exts(Constraint)
|
||||
|
||||
import Servant.Common.Text
|
||||
import Servant.API.Capture ( Capture )
|
||||
import Servant.API.ReqBody ( ReqBody )
|
||||
import Servant.API.QueryParam ( QueryParam, QueryParams, QueryFlag )
|
||||
import Servant.API.MatrixParam ( MatrixParam, MatrixParams, MatrixFlag )
|
||||
import Servant.API.Header ( Header )
|
||||
import Servant.API.Get ( Get )
|
||||
import Servant.API.Post ( Post )
|
||||
import Servant.API.Put ( Put )
|
||||
|
|
@ -86,20 +112,27 @@ import Servant.API.Sub ( type (:>) )
|
|||
import Servant.API.Raw ( Raw )
|
||||
import Servant.API.Alternative ( type (:<|>) )
|
||||
|
||||
|
||||
-- | If either a or b produce an empty constraint, produce an empty constraint.
|
||||
type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
|
||||
Or () b = ()
|
||||
Or a () = ()
|
||||
|
||||
type family And (a :: Constraint) (b :: Constraint) :: Constraint where
|
||||
And () () = ()
|
||||
|
||||
-- | You may use this type family to tell the type checker that your custom type
|
||||
-- is a valid part of a link like so:
|
||||
--
|
||||
-- Not that 'IsElem' is called, which mutually recurses back to `IsElem'`
|
||||
--
|
||||
-- >>> data CustomThing
|
||||
-- >>> type instance IsElem' e (CustomThing :> s) = IsElem e s
|
||||
--
|
||||
-- Now you can add a HasLink instance and you are ready to go.
|
||||
type family IsElem' a s :: Constraint
|
||||
|
||||
type family IsElem a s :: Constraint where
|
||||
-- | Closed type family, check if endpoint is within api
|
||||
type family IsElem endpoint api :: Constraint where
|
||||
IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)
|
||||
IsElem (e :> sa) (e :> sb) = IsElem sa sb
|
||||
IsElem (e :> sa) (Capture x y :> sb) = IsElem sa sb
|
||||
IsElem sa (Header x :> sb) = IsElem sa sb
|
||||
IsElem sa (ReqBody x :> sb) = IsElem sa sb
|
||||
IsElem sa (QueryParam x y :> sb) = IsElem sa sb
|
||||
IsElem sa (QueryParams x y :> sb) = IsElem sa sb
|
||||
|
|
@ -110,45 +143,187 @@ type family IsElem a s :: Constraint where
|
|||
IsElem e e = ()
|
||||
IsElem e a = IsElem' e a
|
||||
|
||||
type family IsLink'' l :: Constraint where
|
||||
IsLink'' (e :> Get x) = IsLink' e
|
||||
IsLink'' (e :> Post x) = IsLink' e
|
||||
IsLink'' (e :> Put x) = IsLink' e
|
||||
IsLink'' (e :> Delete) = IsLink' e
|
||||
IsLink'' (e :> Raw) = IsLink' e
|
||||
|
||||
type family IsLink' e :: Constraint where
|
||||
IsLink' (f :: Symbol) = ()
|
||||
|
||||
type family IsLink e :: Constraint where
|
||||
IsLink (a :> b) = Or (And (IsLink' a) (IsLink'' b))
|
||||
(IsLink'' (a :> b))
|
||||
|
||||
|
||||
-- | The 'ValidLinkIn f s' constraint holds when 's' is an API that
|
||||
-- contains 'f', and 'f' is a link.
|
||||
class ValidLinkIn f s where
|
||||
mkLink :: f -> s -> Link -- ^ This function will only typecheck if `f`
|
||||
-- is an URI within `s`
|
||||
|
||||
instance ( IsElem f s
|
||||
, IsLink f
|
||||
, VLinkHelper f) => ValidLinkIn f s where
|
||||
mkLink _ _ = Link (vlh (Proxy :: Proxy f))
|
||||
|
||||
-- | A safe link datatype.
|
||||
-- The only way of constructing a 'Link' is using 'mkLink', which means any
|
||||
-- The only way of constructing a 'Link' is using 'safeLink', which means any
|
||||
-- 'Link' is guaranteed to be part of the mentioned API.
|
||||
newtype Link = Link { unLink :: String } deriving Show
|
||||
data Link = Link
|
||||
{ _segments :: [String] -- ^ Segments of "foo/bar" would be ["foo", "bar"]
|
||||
, _queryParams :: [Param Query]
|
||||
} deriving Show
|
||||
|
||||
class VLinkHelper f where
|
||||
vlh :: forall proxy. proxy f -> String
|
||||
|
||||
instance (KnownSymbol s, VLinkHelper e) => VLinkHelper (s :> e) where
|
||||
vlh _ = "/" ++ symbolVal (Proxy :: Proxy s) ++ vlh (Proxy :: Proxy e)
|
||||
-- Phantom types for Param
|
||||
data Matrix
|
||||
data Query
|
||||
|
||||
instance VLinkHelper (Get x) where
|
||||
vlh _ = ""
|
||||
-- | Query/Matrix param
|
||||
data Param a
|
||||
= SingleParam String Text
|
||||
| ArrayElemParam String Text
|
||||
| FlagParam String
|
||||
deriving Show
|
||||
|
||||
instance VLinkHelper (Post x) where
|
||||
vlh _ = ""
|
||||
addSegment :: String -> Link -> Link
|
||||
addSegment seg l = l { _segments = _segments l ++ [seg] }
|
||||
|
||||
addQueryParam :: Param Query -> Link -> Link
|
||||
addQueryParam qp l =
|
||||
l { _queryParams = _queryParams l ++ [qp] }
|
||||
|
||||
-- Not particularly efficient for many updates. Something to optimise if it's
|
||||
-- a problem.
|
||||
addMatrixParam :: Param Matrix -> Link -> Link
|
||||
addMatrixParam param l = l { _segments = f (_segments l) }
|
||||
where
|
||||
f [] = []
|
||||
f xs = init xs ++ [g (last xs)]
|
||||
-- Modify the segment at the "top" of the stack
|
||||
g :: String -> String
|
||||
g seg =
|
||||
case param of
|
||||
SingleParam k v -> seg <> ";" <> k <> "=" <> escape (unpack v)
|
||||
ArrayElemParam k v -> seg <> ";" <> k <> "[]=" <> escape (unpack v)
|
||||
FlagParam k -> seg <> ";" <> k
|
||||
|
||||
instance Monoid Link where
|
||||
mempty = Link mempty mempty
|
||||
mappend (Link a1 b1) (Link a2 b2) =
|
||||
Link (a1 <> a2) (b1 <> b2)
|
||||
|
||||
linkURI :: Link -> URI
|
||||
linkURI (Link segments q_params) =
|
||||
URI mempty -- No scheme (relative)
|
||||
Nothing -- Or authority (relative)
|
||||
(intercalate "/" segments)
|
||||
(makeQueries q_params) mempty
|
||||
where
|
||||
makeQueries :: [Param Query] -> String
|
||||
makeQueries [] = ""
|
||||
makeQueries xs =
|
||||
"?" <> intercalate "&" (fmap makeQuery xs)
|
||||
|
||||
makeQuery :: Param Query -> String
|
||||
makeQuery (ArrayElemParam k v) = escape k <> "[]=" <> escape (unpack v)
|
||||
makeQuery (SingleParam k v) = escape k <> "=" <> escape (unpack v)
|
||||
makeQuery (FlagParam k) = escape k
|
||||
|
||||
escape :: String -> String
|
||||
escape = escapeURIString isUnreserved
|
||||
|
||||
-- | Create a valid (by construction) relative URI with query params.
|
||||
--
|
||||
-- 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 you this endpoint is a part of
|
||||
-> MkLink endpoint
|
||||
safeLink endpoint _ = link endpoint mempty
|
||||
|
||||
-- | Construct a link for an endpoint
|
||||
class HasLink endpoint where
|
||||
type MkLink endpoint
|
||||
link :: 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
|
||||
where
|
||||
seg = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
|
||||
-- QueryParam instances
|
||||
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)
|
||||
(addQueryParam (SingleParam k (toText v)) l)
|
||||
where
|
||||
k :: String
|
||||
k = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
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) .
|
||||
foldl' (\l' v -> addQueryParam (ArrayElemParam k (toText v)) l') l
|
||||
where
|
||||
k = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
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
|
||||
where
|
||||
k = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
-- MatrixParam instances
|
||||
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) $
|
||||
addMatrixParam (SingleParam k (toText v)) l
|
||||
where
|
||||
k = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
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) .
|
||||
foldl' (\l' v -> addMatrixParam (ArrayElemParam k (toText v)) l') l
|
||||
where
|
||||
k = symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
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
|
||||
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)
|
||||
|
||||
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) $
|
||||
addSegment (escape . unpack $ toText v) l
|
||||
|
||||
-- Verb (terminal) instances
|
||||
instance HasLink (Get r) where
|
||||
type MkLink (Get r) = URI
|
||||
link _ = linkURI
|
||||
|
||||
instance HasLink (Post r) where
|
||||
type MkLink (Post r) = URI
|
||||
link _ = linkURI
|
||||
|
||||
instance HasLink (Put r) where
|
||||
type MkLink (Put r) = URI
|
||||
link _ = linkURI
|
||||
|
||||
instance HasLink Delete where
|
||||
type MkLink Delete = URI
|
||||
link _ = linkURI
|
||||
|
||||
instance HasLink Raw where
|
||||
type MkLink Raw = URI
|
||||
link _ = linkURI
|
||||
|
|
|
|||
3
test-docs.sh
Executable file
3
test-docs.sh
Executable file
|
|
@ -0,0 +1,3 @@
|
|||
#!/bin/sh
|
||||
|
||||
doctest -isrc -optP-include -optPdist/build/autogen/cabal_macros.h $(find src/ -name '*.hs')
|
||||
|
|
@ -1,59 +1,78 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Servant.Utils.LinksSpec where
|
||||
|
||||
import Test.Hspec ( Spec, it, describe )
|
||||
import Test.Hspec ( Spec, it, describe, shouldBe, Expectation )
|
||||
import Data.Proxy ( Proxy(..) )
|
||||
|
||||
import Servant.API
|
||||
( type (:<|>), ReqBody, QueryParam, MatrixParam, MatrixParams, MatrixFlag, Get, Post, Capture, type (:>) )
|
||||
import Servant.QQSpec ( (~>) )
|
||||
import Servant.Utils.Links ( IsElem, IsLink )
|
||||
|
||||
|
||||
type TestApi =
|
||||
"hello" :> Capture "name" String :> QueryParam "capital" Bool :> Get Bool
|
||||
:<|> "greet" :> ReqBody 'True :> Post Bool
|
||||
:<|> "parent" :> MatrixParams "name" String :> "child" :> MatrixParam "gender" String :> Get String
|
||||
-- Capture and query/matrix params
|
||||
"hello" :> Capture "name" String :> QueryParam "capital" Bool :> Delete
|
||||
|
||||
:<|> "parent" :> MatrixParams "name" String :> "child"
|
||||
:> MatrixParam "gender" String :> Get String
|
||||
|
||||
-- Flags
|
||||
:<|> "ducks" :> MatrixFlag "yellow" :> MatrixFlag "loud" :> Delete
|
||||
:<|> "balls" :> QueryFlag "bouncy" :> QueryFlag "fast" :> Delete
|
||||
|
||||
-- All of the verbs
|
||||
:<|> "get" :> Get ()
|
||||
:<|> "put" :> Put ()
|
||||
:<|> "post" :> ReqBody 'True :> Post ()
|
||||
:<|> "delete" :> Header "ponies" :> Delete
|
||||
:<|> "raw" :> Raw
|
||||
|
||||
type TestLink = "hello" :> "hi" :> Get Bool
|
||||
type TestLink2 = "greet" :> Post Bool
|
||||
type TestLink3 = "parent" :> "child" :> Get String
|
||||
|
||||
type BadTestLink = "hallo" :> "hi" :> Get Bool
|
||||
type BadTestLink2 = "greet" :> Get Bool
|
||||
type BadTestLink3 = "parent" :> "child" :> MatrixFlag "male" :> Get String
|
||||
api :: Proxy TestApi
|
||||
api = Proxy
|
||||
|
||||
type NotALink = "hello" :> Capture "x" Bool :> Get Bool
|
||||
type NotALink2 = "hello" :> ReqBody 'True :> Get Bool
|
||||
|
||||
data Proxy x = Proxy
|
||||
class ReflectT (x::Bool) where { reflected :: Proxy x -> Bool }
|
||||
instance ReflectT 'True where { reflected _ = True }
|
||||
instance ReflectT 'False where { reflected _ = False }
|
||||
-- | Convert a link to a URI and ensure that this maps to the given string
|
||||
-- given string
|
||||
shouldBeURI :: URI -> String -> Expectation
|
||||
shouldBeURI link expected =
|
||||
show link `shouldBe` expected
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Servant.API.Elem" $ do
|
||||
isElem
|
||||
isLink
|
||||
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"
|
||||
|
||||
isElem :: Spec
|
||||
isElem = describe "IsElem" $ do
|
||||
it "is True when the first argument is an url within the second" $ do
|
||||
reflected (Proxy::Proxy (IsElem TestLink TestApi)) ~> True
|
||||
reflected (Proxy::Proxy (IsElem TestLink2 TestApi)) ~> True
|
||||
reflected (Proxy::Proxy (IsElem TestLink3 TestApi)) ~> True
|
||||
it "is False when the first argument is not an url within the second" $ do
|
||||
reflected (Proxy::Proxy (IsElem BadTestLink TestApi)) ~> False
|
||||
reflected (Proxy::Proxy (IsElem BadTestLink2 TestApi)) ~> False
|
||||
reflected (Proxy::Proxy (IsElem BadTestLink3 TestApi)) ~> False
|
||||
let l2 = Proxy :: Proxy ("hello" :> Capture "name" String
|
||||
:> QueryParam "capital" Bool
|
||||
:> Delete)
|
||||
safeLink l2 api "bye" True `shouldBeURI` "hello/bye?capital=true"
|
||||
|
||||
isLink :: Spec
|
||||
isLink = describe "IsLink" $ do
|
||||
it "is True when all Subs are paths and the last is a method" $ do
|
||||
reflected (Proxy::Proxy (IsLink TestLink)) ~> True
|
||||
reflected (Proxy::Proxy (IsLink TestLink2)) ~> True
|
||||
reflected (Proxy::Proxy (IsLink TestLink3)) ~> True
|
||||
it "is False of anything with captures" $ do
|
||||
reflected (Proxy::Proxy (IsLink NotALink)) ~> False
|
||||
reflected (Proxy::Proxy (IsLink NotALink2)) ~> False
|
||||
let l3 = Proxy :: Proxy ("parent" :> MatrixParams "name" String
|
||||
:> "child"
|
||||
:> MatrixParam "gender" String
|
||||
:> Get String)
|
||||
safeLink l3 api ["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"
|
||||
|
||||
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"
|
||||
|
||||
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"
|
||||
|
|
|
|||
Loading…
Reference in a new issue