summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorphadej <>2018-07-05 15:56:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-07-05 15:56:00 (GMT)
commitc146bcacca0e307118a047e19307fadb9b636761 (patch)
treee58f0cbdf56d5fba311efed1f03c62e7bec12811
parent790def66ee34c117306861523b1bf78096a5bf1a (diff)
version 0.14.10.14.1
-rw-r--r--CHANGELOG.md13
-rw-r--r--servant.cabal13
-rw-r--r--src/Servant/API.hs6
-rw-r--r--src/Servant/API/Generic.hs146
-rw-r--r--src/Servant/API/Verbs.hs2
-rw-r--r--src/Servant/Links.hs573
-rw-r--r--src/Servant/Utils/Links.hs489
-rw-r--r--test/Servant/LinksSpec.hs (renamed from test/Servant/Utils/LinksSpec.hs)6
8 files changed, 752 insertions, 496 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 79ceeb9..e7da769 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,18 @@
[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
+0.14.1
+------
+
+- Merge in (and slightly refactor) `servant-generic`
+ (by [Patrick Chilton](https://github.com/chpatrick))
+ into `servant` (`Servant.API.Generic`),
+ `servant-client-code` (`Servant.Client.Generic`)
+ and `servant-server` (`Servant.Server.Generic`).
+
+- Deprecate `Servant.Utils.Links`, use `Servant.Links`.
+
+- *servant-server* Deprecate `Servant.Utils.StaticUtils`, use `Servant.Server.StaticUtils`.
+
0.14
----
diff --git a/servant.cabal b/servant.cabal
index 6cf94bd..17ae209 100644
--- a/servant.cabal
+++ b/servant.cabal
@@ -1,5 +1,5 @@
name: servant
-version: 0.14
+version: 0.14.1
synopsis: A family of combinators for defining webservices APIs
description:
A family of combinators for defining webservices APIs and serving them
@@ -46,6 +46,7 @@ library
Servant.API.Description
Servant.API.Empty
Servant.API.Experimental.Auth
+ Servant.API.Generic
Servant.API.Header
Servant.API.HttpVersion
Servant.API.Internal.Test.ComprehensiveAPI
@@ -62,6 +63,10 @@ library
Servant.API.Vault
Servant.API.Verbs
Servant.API.WithNamedContext
+ Servant.Links
+
+ -- Deprecated modules, to be removed in late 2019
+ exposed-modules:
Servant.Utils.Links
Servant.Utils.Enter
@@ -133,8 +138,8 @@ test-suite spec
other-modules:
Servant.API.ContentTypesSpec
Servant.API.ResponseHeadersSpec
- Servant.Utils.LinksSpec
Servant.Utils.EnterSpec
+ Servant.LinksSpec
-- Dependencies inherited from the library. No need to specify bounds.
build-depends:
@@ -164,7 +169,7 @@ test-suite doctests
build-depends:
base
, servant
- , doctest >= 0.15.0 && <0.16
+ , doctest >= 0.15.0 && <0.17
-- We test Links failure with doctest, so we need extra dependencies
build-depends:
@@ -179,4 +184,4 @@ test-suite doctests
x-doctest-options: -fdiagnostics-color=never
include-dirs: include
x-doctest-source-dirs: test
- x-doctest-modules: Servant.Utils.LinksSpec
+ x-doctest-modules: Servant.LinksSpec
diff --git a/src/Servant/API.hs b/src/Servant/API.hs
index 4ae2b8e..1a85e1a 100644
--- a/src/Servant/API.hs
+++ b/src/Servant/API.hs
@@ -63,8 +63,8 @@ module Servant.API (
module Servant.API.Experimental.Auth,
-- | General Authentication
- -- * Utilities
- module Servant.Utils.Links,
+ -- * Links
+ module Servant.Links,
-- | Type-safe internal URIs
-- * Re-exports
@@ -134,7 +134,7 @@ import Servant.API.Verbs
ReflectMethod (reflectMethod), StdMethod (..), Verb)
import Servant.API.WithNamedContext
(WithNamedContext)
-import Servant.Utils.Links
+import Servant.Links
(HasLink (..), IsElem, IsElem', Link, URI (..), safeLink)
import Web.HttpApiData
(FromHttpApiData (..), ToHttpApiData (..))
diff --git a/src/Servant/API/Generic.hs b/src/Servant/API/Generic.hs
new file mode 100644
index 0000000..b887c09
--- /dev/null
+++ b/src/Servant/API/Generic.hs
@@ -0,0 +1,146 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+-- | Define servant servers from record types. Generics for the win.
+--
+-- The usage is simple, if you only need a collection of routes. First you
+-- define a record with field types prefixed by a parameter `route`:
+--
+-- @
+-- data Routes route = Routes
+-- { _get :: route :- Capture "id" Int :> Get '[JSON] String
+-- , _put :: route :- ReqBody '[JSON] Int :> Put '[JSON] Bool
+-- }
+-- deriving ('Generic')
+-- @
+--
+-- You can get a 'Proxy' of the server using
+--
+-- @
+-- api :: Proxy (ToServantApi Routes)
+-- api = genericApi (Proxy :: Proxy Routes)
+-- @
+--
+-- Using 'genericApi' is better as it checks that instances exists,
+-- i.e. you get better error messages than simply using 'Proxy' value.
+--
+-- __Note:__ in 0.14 series this module isn't re-exported from 'Servant.API'.
+--
+-- "Servant.API.Generic" is based on @servant-generic@ package by
+-- [Patrick Chilton](https://github.com/chpatrick)
+--
+-- @since 0.14.1
+module Servant.API.Generic (
+ GenericMode (..),
+ GenericServant,
+ ToServant,
+ toServant,
+ fromServant,
+ -- * AsApi
+ AsApi,
+ ToServantApi,
+ genericApi,
+ -- * Utility
+ GServantProduct,
+ -- * re-exports
+ Generic (Rep),
+ ) where
+
+-- Based on servant-generic licensed under MIT License
+--
+-- Copyright (c) 2017 Patrick Chilton
+--
+-- Permission is hereby granted, free of charge, to any person obtaining a copy
+-- of this software and associated documentation files (the "Software"), to deal
+-- in the Software without restriction, including without limitation the rights
+-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+-- copies of the Software, and to permit persons to whom the Software is
+-- furnished to do so, subject to the following conditions:
+--
+-- The above copyright notice and this permission notice shall be included in all
+-- copies or substantial portions of the Software.
+--
+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+-- SOFTWARE.
+
+import Data.Proxy
+ (Proxy (..))
+import GHC.Generics
+ ((:*:) (..), Generic (..), K1 (..), M1 (..))
+
+import Servant.API.Alternative
+
+-- | A constraint alias, for work with 'mode' and 'routes'.
+type GenericServant routes mode = (GenericMode mode, Generic (routes mode), GServantProduct (Rep (routes mode)))
+
+-- | A class with a type family that applies an appropriate type family to the @api@
+-- parameter. For example, 'AsApi' will leave @api@ untouched, while
+-- @'AsServerT' m@ will produce @'ServerT' api m@.
+class GenericMode mode where
+ type mode :- api :: *
+
+infixl 0 :-
+
+-- | Turns a generic product type into a tree of `:<|>` combinators.
+type ToServant routes mode = GToServant (Rep (routes mode))
+
+type ToServantApi routes = ToServant routes AsApi
+
+-- | See `ToServant`, but at value-level.
+toServant
+ :: GenericServant routes mode
+ => routes mode -> ToServant routes mode
+toServant = gtoServant . from
+
+-- | Inverse of `toServant`.
+--
+-- This can be used to turn 'generated' values such as client functions into records.
+--
+-- You may need to provide a type signature for the /output/ type (your record type).
+fromServant
+ :: GenericServant routes mode
+ => ToServant routes mode -> routes mode
+fromServant = to . gfromServant
+
+-- | A type that specifies that an API record contains an API definition. Only useful at type-level.
+data AsApi
+instance GenericMode AsApi where
+ type AsApi :- api = api
+
+-- | Get a 'Proxy' of an API type.
+genericApi
+ :: GenericServant routes AsApi
+ => Proxy routes
+ -> Proxy (ToServantApi routes)
+genericApi _ = Proxy
+
+-------------------------------------------------------------------------------
+-- Class
+-------------------------------------------------------------------------------
+
+
+class GServantProduct f where
+ type GToServant f
+ gtoServant :: f p -> GToServant f
+ gfromServant :: GToServant f -> f p
+
+instance GServantProduct f => GServantProduct (M1 i c f) where
+ type GToServant (M1 i c f) = GToServant f
+ gtoServant = gtoServant . unM1
+ gfromServant = M1 . gfromServant
+
+instance (GServantProduct l, GServantProduct r) => GServantProduct (l :*: r) where
+ type GToServant (l :*: r) = GToServant l :<|> GToServant r
+ gtoServant (l :*: r) = gtoServant l :<|> gtoServant r
+ gfromServant (l :<|> r) = gfromServant l :*: gfromServant r
+
+instance GServantProduct (K1 i c) where
+ type GToServant (K1 i c) = c
+ gtoServant = unK1
+ gfromServant = K1
diff --git a/src/Servant/API/Verbs.hs b/src/Servant/API/Verbs.hs
index a82e8a0..f638160 100644
--- a/src/Servant/API/Verbs.hs
+++ b/src/Servant/API/Verbs.hs
@@ -58,7 +58,7 @@ type Patch = Verb 'PATCH 200
--
-- If the resource cannot be created immediately, use 'PostAccepted'.
--
--- Consider using 'Servant.Utils.Links.safeLink' for the @Location@ header
+-- Consider using 'Servant.Links.safeLink' for the @Location@ header
-- field.
-- | 'POST' with 201 status code.
diff --git a/src/Servant/Links.hs b/src/Servant/Links.hs
new file mode 100644
index 0000000..812e22f
--- /dev/null
+++ b/src/Servant/Links.hs
@@ -0,0 +1,573 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_HADDOCK not-home #-}
+
+-- | Type safe generation of internal links.
+--
+-- Given an API with a few endpoints:
+--
+-- >>> :set -XDataKinds -XTypeFamilies -XTypeOperators
+-- >>> import Servant.API
+-- >>> import Servant.Links
+-- >>> import Data.Proxy
+-- >>>
+-- >>> type Hello = "hello" :> Get '[JSON] Int
+-- >>> type Bye = "bye" :> QueryParam "name" String :> Delete '[JSON] NoContent
+-- >>> type API = Hello :<|> Bye
+-- >>> 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 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 'Link' 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.
+-- 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. This is best shown
+-- with an example. Here, a link is generated with no parameters:
+--
+-- >>> let hello = Proxy :: Proxy ("hello" :> Get '[JSON] Int)
+-- >>> toUrlPiece (safeLink api hello :: Link)
+-- "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 '[JSON] NoContent)
+-- >>> toUrlPiece $ safeLink api with (Just "Hubert")
+-- "bye?name=Hubert"
+--
+-- >>> let without = Proxy :: Proxy ("bye" :> Delete '[JSON] NoContent)
+-- >>> toUrlPiece $ 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 Link
+-- >>> apiLink = safeLink api
+-- >>> :}
+--
+-- `safeLink'` allows to make specialise the output:
+--
+-- >>> safeLink' toUrlPiece api without
+-- "bye"
+--
+-- >>> :{
+-- >>> let apiTextLink :: (IsElem endpoint API, HasLink endpoint)
+-- >>> => Proxy endpoint -> MkLink endpoint Text
+-- >>> apiTextLink = safeLink' toUrlPiece api
+-- >>> :}
+--
+-- >>> apiTextLink without
+-- "bye"
+--
+-- 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 '[JSON] NoContent)
+-- >>> safeLink api bad_link
+-- ...
+-- ...Could not deduce...
+-- ...
+--
+-- 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.
+--
+-- @since 0.14.1
+module Servant.Links (
+ module Servant.API.TypeLevel,
+
+ -- * Building and using safe links
+ --
+ -- | Note that 'URI' is from the "Network.URI" module in the @network-uri@ package.
+ safeLink
+ , safeLink'
+ , allLinks
+ , allLinks'
+ , URI(..)
+ -- * Generics
+ , AsLink
+ , fieldLink
+ , fieldLink'
+ , allFieldLinks
+ , allFieldLinks'
+ -- * Adding custom types
+ , HasLink(..)
+ , Link
+ , linkURI
+ , linkURI'
+ , LinkArrayElementStyle (..)
+ -- ** Link accessors
+ , Param (..)
+ , linkSegments
+ , linkQueryParams
+) where
+
+import Data.List
+import Data.Proxy
+ (Proxy (..))
+import Data.Semigroup
+ ((<>))
+import Data.Singletons.Bool
+ (SBool (..), SBoolI (..))
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as TE
+import Data.Type.Bool
+ (If)
+import GHC.TypeLits
+ (KnownSymbol, symbolVal)
+import Network.URI
+ (URI (..), escapeURIString, isUnreserved)
+import Prelude ()
+import Prelude.Compat
+
+import Servant.API.Alternative
+ ((:<|>) ((:<|>)))
+import Servant.API.BasicAuth
+ (BasicAuth)
+import Servant.API.Capture
+ (Capture', CaptureAll)
+import Servant.API.Description
+ (Description, Summary)
+import Servant.API.Empty
+ (EmptyAPI (..))
+import Servant.API.Experimental.Auth
+ (AuthProtect)
+import Servant.API.Generic
+import Servant.API.Header
+ (Header')
+import Servant.API.HttpVersion
+ (HttpVersion)
+import Servant.API.IsSecure
+ (IsSecure)
+import Servant.API.Modifiers
+ (FoldRequired)
+import Servant.API.QueryParam
+ (QueryFlag, QueryParam', QueryParams)
+import Servant.API.Raw
+ (Raw)
+import Servant.API.RemoteHost
+ (RemoteHost)
+import Servant.API.ReqBody
+ (ReqBody')
+import Servant.API.Stream
+ (Stream)
+import Servant.API.Sub
+ (type (:>))
+import Servant.API.TypeLevel
+import Servant.API.Vault
+ (Vault)
+import Servant.API.Verbs
+ (Verb)
+import Servant.API.WithNamedContext
+ (WithNamedContext)
+import Web.HttpApiData
+
+-- | A safe link datatype.
+-- The only way of constructing a 'Link' is using 'safeLink', which means any
+-- 'Link' is guaranteed to be part of the mentioned API.
+data Link = Link
+ { _segments :: [Escaped]
+ , _queryParams :: [Param]
+ } deriving Show
+
+newtype Escaped = Escaped String
+
+escaped :: String -> Escaped
+escaped = Escaped . escapeURIString isUnreserved
+
+getEscaped :: Escaped -> String
+getEscaped (Escaped s) = s
+
+instance Show Escaped where
+ showsPrec d (Escaped s) = showsPrec d s
+ show (Escaped s) = show s
+
+linkSegments :: Link -> [String]
+linkSegments = map getEscaped . _segments
+
+linkQueryParams :: Link -> [Param]
+linkQueryParams = _queryParams
+
+instance ToHttpApiData Link where
+ toHeader = TE.encodeUtf8 . toUrlPiece
+ toUrlPiece l =
+ let uri = linkURI l
+ in Text.pack $ uriPath uri ++ uriQuery uri
+
+-- | Query parameter.
+data Param
+ = SingleParam String Text.Text
+ | ArrayElemParam String Text.Text
+ | FlagParam String
+ deriving Show
+
+addSegment :: Escaped -> Link -> Link
+addSegment seg l = l { _segments = _segments l <> [seg] }
+
+addQueryParam :: Param -> Link -> Link
+addQueryParam qp l =
+ l { _queryParams = _queryParams l <> [qp] }
+
+-- | Transform 'Link' into 'URI'.
+--
+-- >>> type API = "something" :> Get '[JSON] Int
+-- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API)
+-- something
+--
+-- >>> type API = "sum" :> QueryParams "x" Int :> Get '[JSON] Int
+-- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API) [1, 2, 3]
+-- sum?x[]=1&x[]=2&x[]=3
+--
+-- >>> type API = "foo/bar" :> Get '[JSON] Int
+-- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API)
+-- foo%2Fbar
+--
+-- >>> type SomeRoute = "abc" :> Capture "email" String :> Put '[JSON] ()
+-- >>> let someRoute = Proxy :: Proxy SomeRoute
+-- >>> safeLink someRoute someRoute "test@example.com"
+-- Link {_segments = ["abc","test%40example.com"], _queryParams = []}
+--
+-- >>> linkURI $ safeLink someRoute someRoute "test@example.com"
+-- abc/test%40example.com
+--
+linkURI :: Link -> URI
+linkURI = linkURI' LinkArrayElementBracket
+
+-- | How to encode array query elements.
+data LinkArrayElementStyle
+ = LinkArrayElementBracket -- ^ @foo[]=1&foo[]=2@
+ | LinkArrayElementPlain -- ^ @foo=1&foo=2@
+ deriving (Eq, Ord, Show, Enum, Bounded)
+
+-- | Configurable 'linkURI'.
+--
+-- >>> type API = "sum" :> QueryParams "x" Int :> Get '[JSON] Int
+-- >>> linkURI' LinkArrayElementBracket $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API) [1, 2, 3]
+-- sum?x[]=1&x[]=2&x[]=3
+--
+-- >>> linkURI' LinkArrayElementPlain $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API) [1, 2, 3]
+-- sum?x=1&x=2&x=3
+--
+linkURI' :: LinkArrayElementStyle -> Link -> URI
+linkURI' addBrackets (Link segments q_params) =
+ URI mempty -- No scheme (relative)
+ Nothing -- Or authority (relative)
+ (intercalate "/" $ map getEscaped segments)
+ (makeQueries q_params) mempty
+ where
+ makeQueries :: [Param] -> String
+ makeQueries [] = ""
+ makeQueries xs =
+ "?" <> intercalate "&" (fmap makeQuery xs)
+
+ makeQuery :: Param -> String
+ makeQuery (ArrayElemParam k v) = escape k <> style <> escape (Text.unpack v)
+ makeQuery (SingleParam k v) = escape k <> "=" <> escape (Text.unpack v)
+ makeQuery (FlagParam k) = escape k
+
+ style = case addBrackets of
+ LinkArrayElementBracket -> "[]="
+ LinkArrayElementPlain -> "="
+
+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 api -- ^ The whole API that this endpoint is a part of
+ -> Proxy endpoint -- ^ The API endpoint you would like to point to
+ -> MkLink endpoint Link
+safeLink = safeLink' id
+
+-- | More general 'safeLink'.
+--
+safeLink'
+ :: forall endpoint api a. (IsElem endpoint api, HasLink endpoint)
+ => (Link -> a)
+ -> 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 a
+safeLink' toA _ endpoint = toLink toA endpoint (Link mempty mempty)
+
+-- | Create all links in an API.
+--
+-- Note that the @api@ type must be restricted to the endpoints that have
+-- valid links to them.
+--
+-- >>> type API = "foo" :> Capture "name" Text :> Get '[JSON] Text :<|> "bar" :> Capture "name" Int :> Get '[JSON] Double
+-- >>> let fooLink :<|> barLink = allLinks (Proxy :: Proxy API)
+-- >>> :t fooLink
+-- fooLink :: Text -> Link
+-- >>> :t barLink
+-- barLink :: Int -> Link
+--
+-- Note: nested APIs don't work well with this approach
+--
+-- >>> :kind! MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double)) Link
+-- MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double)) Link :: *
+-- = Char -> (Int -> Link) :<|> (Double -> Link)
+allLinks
+ :: forall api. HasLink api
+ => Proxy api
+ -> MkLink api Link
+allLinks = allLinks' id
+
+-- | More general 'allLinks'. See `safeLink'`.
+allLinks'
+ :: forall api a. HasLink api
+ => (Link -> a)
+ -> Proxy api
+ -> MkLink api a
+allLinks' toA api = toLink toA api (Link mempty mempty)
+
+-------------------------------------------------------------------------------
+-- Generics
+-------------------------------------------------------------------------------
+
+-- | Given an API record field, create a link for that route. Only the field's
+-- type is used.
+--
+-- @
+-- data Record route = Record
+-- { _get :: route :- Capture "id" Int :> Get '[JSON] String
+-- , _put :: route :- ReqBody '[JSON] Int :> Put '[JSON] Bool
+-- }
+-- deriving ('Generic')
+--
+-- getLink :: Int -> Link
+-- getLink = 'fieldLink' _get
+-- @
+--
+-- @since 0.14.1
+fieldLink
+ :: ( IsElem endpoint (ToServantApi routes), HasLink endpoint
+ , GenericServant routes AsApi
+ )
+ => (routes AsApi -> endpoint)
+ -> MkLink endpoint Link
+fieldLink = fieldLink' id
+
+-- | More general version of 'fieldLink'
+--
+-- @since 0.14.1
+fieldLink'
+ :: forall routes endpoint a.
+ ( IsElem endpoint (ToServantApi routes), HasLink endpoint
+ , GenericServant routes AsApi
+ )
+ => (Link -> a)
+ -> (routes AsApi -> endpoint)
+ -> MkLink endpoint a
+fieldLink' toA _ = safeLink' toA (genericApi (Proxy :: Proxy routes)) (Proxy :: Proxy endpoint)
+
+-- | A type that specifies that an API record contains a set of links.
+--
+-- @since 0.14.1
+data AsLink (a :: *)
+instance GenericMode (AsLink a) where
+ type (AsLink a) :- api = MkLink api a
+
+-- | Get all links as a record.
+--
+-- @since 0.14.1
+allFieldLinks
+ :: ( HasLink (ToServantApi routes)
+ , GenericServant routes (AsLink Link)
+ , ToServant routes (AsLink Link) ~ MkLink (ToServantApi routes) Link
+ )
+ => routes (AsLink Link)
+allFieldLinks = allFieldLinks' id
+
+-- | More general version of 'allFieldLinks'.
+--
+-- @since 0.14.1
+allFieldLinks'
+ :: forall routes a.
+ ( HasLink (ToServantApi routes)
+ , GenericServant routes (AsLink a)
+ , ToServant routes (AsLink a) ~ MkLink (ToServantApi routes) a
+ )
+ => (Link -> a)
+ -> routes (AsLink a)
+allFieldLinks' toA
+ = fromServant
+ $ allLinks' toA (Proxy :: Proxy (ToServantApi routes))
+
+-------------------------------------------------------------------------------
+-- HasLink
+-------------------------------------------------------------------------------
+
+-- | Construct a toLink for an endpoint.
+class HasLink endpoint where
+ type MkLink endpoint (a :: *)
+ toLink
+ :: (Link -> a)
+ -> Proxy endpoint -- ^ The API endpoint you would like to point to
+ -> Link
+ -> MkLink endpoint a
+
+-- Naked symbol instance
+instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
+ type MkLink (sym :> sub) a = MkLink sub a
+ toLink toA _ =
+ toLink toA (Proxy :: Proxy sub) . addSegment (escaped seg)
+ where
+ seg = symbolVal (Proxy :: Proxy sym)
+
+-- QueryParam instances
+instance (KnownSymbol sym, ToHttpApiData v, HasLink sub, SBoolI (FoldRequired mods))
+ => HasLink (QueryParam' mods sym v :> sub)
+ where
+ type MkLink (QueryParam' mods sym v :> sub) a = If (FoldRequired mods) v (Maybe v) -> MkLink sub a
+ toLink toA _ l mv =
+ toLink toA (Proxy :: Proxy sub) $
+ case sbool :: SBool (FoldRequired mods) of
+ STrue -> (addQueryParam . SingleParam k . toQueryParam) mv l
+ SFalse -> maybe id (addQueryParam . SingleParam k . toQueryParam) mv l
+ where
+ k :: String
+ k = symbolVal (Proxy :: Proxy sym)
+
+instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)
+ => HasLink (QueryParams sym v :> sub)
+ where
+ type MkLink (QueryParams sym v :> sub) a = [v] -> MkLink sub a
+ toLink toA _ l =
+ toLink toA (Proxy :: Proxy sub) .
+ foldl' (\l' v -> addQueryParam (ArrayElemParam k (toQueryParam v)) l') l
+ where
+ k = symbolVal (Proxy :: Proxy sym)
+
+instance (KnownSymbol sym, HasLink sub)
+ => HasLink (QueryFlag sym :> sub)
+ where
+ type MkLink (QueryFlag sym :> sub) a = Bool -> MkLink sub a
+ toLink toA _ l False =
+ toLink toA (Proxy :: Proxy sub) l
+ toLink toA _ l True =
+ toLink toA (Proxy :: Proxy sub) $ addQueryParam (FlagParam k) l
+ where
+ k = symbolVal (Proxy :: Proxy sym)
+
+-- :<|> instance - Generate all links at once
+instance (HasLink a, HasLink b) => HasLink (a :<|> b) where
+ type MkLink (a :<|> b) r = MkLink a r :<|> MkLink b r
+ toLink toA _ l = toLink toA (Proxy :: Proxy a) l :<|> toLink toA (Proxy :: Proxy b) l
+
+-- Misc instances
+instance HasLink sub => HasLink (ReqBody' mods ct a :> sub) where
+ type MkLink (ReqBody' mods ct a :> sub) r = MkLink sub r
+ toLink toA _ = toLink toA (Proxy :: Proxy sub)
+
+instance (ToHttpApiData v, HasLink sub)
+ => HasLink (Capture' mods sym v :> sub)
+ where
+ type MkLink (Capture' mods sym v :> sub) a = v -> MkLink sub a
+ toLink toA _ l v =
+ toLink toA (Proxy :: Proxy sub) $
+ addSegment (escaped . Text.unpack $ toUrlPiece v) l
+
+instance (ToHttpApiData v, HasLink sub)
+ => HasLink (CaptureAll sym v :> sub)
+ where
+ type MkLink (CaptureAll sym v :> sub) a = [v] -> MkLink sub a
+ toLink toA _ l vs = toLink toA (Proxy :: Proxy sub) $
+ foldl' (flip $ addSegment . escaped . Text.unpack . toUrlPiece) l vs
+
+instance HasLink sub => HasLink (Header' mods sym (a :: *) :> sub) where
+ type MkLink (Header' mods sym a :> sub) r = MkLink sub r
+ toLink = simpleToLink (Proxy :: Proxy sub)
+
+instance HasLink sub => HasLink (Vault :> sub) where
+ type MkLink (Vault :> sub) a = MkLink sub a
+ toLink = simpleToLink (Proxy :: Proxy sub)
+
+instance HasLink sub => HasLink (Description s :> sub) where
+ type MkLink (Description s :> sub) a = MkLink sub a
+ toLink = simpleToLink (Proxy :: Proxy sub)
+
+instance HasLink sub => HasLink (Summary s :> sub) where
+ type MkLink (Summary s :> sub) a = MkLink sub a
+ toLink = simpleToLink (Proxy :: Proxy sub)
+
+instance HasLink sub => HasLink (HttpVersion :> sub) where
+ type MkLink (HttpVersion:> sub) a = MkLink sub a
+ toLink = simpleToLink (Proxy :: Proxy sub)
+
+instance HasLink sub => HasLink (IsSecure :> sub) where
+ type MkLink (IsSecure :> sub) a = MkLink sub a
+ toLink = simpleToLink (Proxy :: Proxy sub)
+
+instance HasLink sub => HasLink (WithNamedContext name context sub) where
+ type MkLink (WithNamedContext name context sub) a = MkLink sub a
+ toLink toA _ = toLink toA (Proxy :: Proxy sub)
+
+instance HasLink sub => HasLink (RemoteHost :> sub) where
+ type MkLink (RemoteHost :> sub) a = MkLink sub a
+ toLink = simpleToLink (Proxy :: Proxy sub)
+
+instance HasLink sub => HasLink (BasicAuth realm a :> sub) where
+ type MkLink (BasicAuth realm a :> sub) r = MkLink sub r
+ toLink = simpleToLink (Proxy :: Proxy sub)
+
+instance HasLink EmptyAPI where
+ type MkLink EmptyAPI a = EmptyAPI
+ toLink _ _ _ = EmptyAPI
+
+-- Verb (terminal) instances
+instance HasLink (Verb m s ct a) where
+ type MkLink (Verb m s ct a) r = r
+ toLink toA _ = toA
+
+instance HasLink Raw where
+ type MkLink Raw a = a
+ toLink toA _ = toA
+
+instance HasLink (Stream m status fr ct a) where
+ type MkLink (Stream m status fr ct a) r = r
+ toLink toA _ = toA
+
+-- AuthProtext instances
+instance HasLink sub => HasLink (AuthProtect tag :> sub) where
+ type MkLink (AuthProtect tag :> sub) a = MkLink sub a
+ toLink = simpleToLink (Proxy :: Proxy sub)
+
+-- | Helper for implemneting 'toLink' for combinators not affecting link
+-- structure.
+simpleToLink
+ :: forall sub a combinator.
+ (HasLink sub, MkLink sub a ~ MkLink (combinator :> sub) a)
+ => Proxy sub
+ -> (Link -> a)
+ -> Proxy (combinator :> sub)
+ -> Link
+ -> MkLink (combinator :> sub) a
+simpleToLink _ toA _ = toLink toA (Proxy :: Proxy sub)
+
+
+-- $setup
+-- >>> import Servant.API
+-- >>> import Data.Text (Text)
diff --git a/src/Servant/Utils/Links.hs b/src/Servant/Utils/Links.hs
index 5002bcc..dc6d1b7 100644
--- a/src/Servant/Utils/Links.hs
+++ b/src/Servant/Utils/Links.hs
@@ -1,487 +1,6 @@
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_HADDOCK not-home #-}
-
--- | Type safe generation of internal links.
---
--- Given an API with a few endpoints:
---
--- >>> :set -XDataKinds -XTypeFamilies -XTypeOperators
--- >>> import Servant.API
--- >>> import Servant.Utils.Links
--- >>> import Data.Proxy
--- >>>
--- >>> type Hello = "hello" :> Get '[JSON] Int
--- >>> type Bye = "bye" :> QueryParam "name" String :> Delete '[JSON] NoContent
--- >>> type API = Hello :<|> Bye
--- >>> 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 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 'Link' 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.
--- 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. This is best shown
--- with an example. Here, a link is generated with no parameters:
---
--- >>> let hello = Proxy :: Proxy ("hello" :> Get '[JSON] Int)
--- >>> toUrlPiece (safeLink api hello :: Link)
--- "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 '[JSON] NoContent)
--- >>> toUrlPiece $ safeLink api with (Just "Hubert")
--- "bye?name=Hubert"
---
--- >>> let without = Proxy :: Proxy ("bye" :> Delete '[JSON] NoContent)
--- >>> toUrlPiece $ 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 Link
--- >>> apiLink = safeLink api
--- >>> :}
---
--- `safeLink'` allows to make specialise the output:
---
--- >>> safeLink' toUrlPiece api without
--- "bye"
---
--- >>> :{
--- >>> let apiTextLink :: (IsElem endpoint API, HasLink endpoint)
--- >>> => Proxy endpoint -> MkLink endpoint Text
--- >>> apiTextLink = safeLink' toUrlPiece api
--- >>> :}
---
--- >>> apiTextLink without
--- "bye"
---
--- 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 '[JSON] NoContent)
--- >>> safeLink api bad_link
--- ...
--- ...Could not deduce...
--- ...
---
--- 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 (
- module Servant.API.TypeLevel,
-
- -- * Building and using safe links
- --
- -- | Note that 'URI' is from the "Network.URI" module in the @network-uri@ package.
- safeLink
- , safeLink'
- , allLinks
- , allLinks'
- , URI(..)
- -- * Adding custom types
- , HasLink(..)
- , Link
- , linkURI
- , linkURI'
- , LinkArrayElementStyle (..)
- -- ** Link accessors
- , Param (..)
- , linkSegments
- , linkQueryParams
-) where
-
-import Data.List
-import Data.Proxy
- (Proxy (..))
-import Data.Semigroup
- ((<>))
-import Data.Singletons.Bool
- (SBool (..), SBoolI (..))
-import qualified Data.Text as Text
-import qualified Data.Text.Encoding as TE
-import Data.Type.Bool
- (If)
-import GHC.TypeLits
- (KnownSymbol, symbolVal)
-import Network.URI
- (URI (..), escapeURIString, isUnreserved)
-import Prelude ()
-import Prelude.Compat
-
-import Servant.API.Alternative
- ((:<|>) ((:<|>)))
-import Servant.API.BasicAuth
- (BasicAuth)
-import Servant.API.Capture
- (Capture', CaptureAll)
-import Servant.API.Description
- (Description, Summary)
-import Servant.API.Empty
- (EmptyAPI (..))
-import Servant.API.Experimental.Auth
- (AuthProtect)
-import Servant.API.Header
- (Header')
-import Servant.API.HttpVersion
- (HttpVersion)
-import Servant.API.IsSecure
- (IsSecure)
-import Servant.API.Modifiers
- (FoldRequired)
-import Servant.API.QueryParam
- (QueryFlag, QueryParam', QueryParams)
-import Servant.API.Raw
- (Raw)
-import Servant.API.RemoteHost
- (RemoteHost)
-import Servant.API.ReqBody
- (ReqBody')
-import Servant.API.Stream
- (Stream)
-import Servant.API.Sub
- (type (:>))
-import Servant.API.TypeLevel
-import Servant.API.Vault
- (Vault)
-import Servant.API.Verbs
- (Verb)
-import Servant.API.WithNamedContext
- (WithNamedContext)
-import Web.HttpApiData
-
--- | A safe link datatype.
--- The only way of constructing a 'Link' is using 'safeLink', which means any
--- 'Link' is guaranteed to be part of the mentioned API.
-data Link = Link
- { _segments :: [Escaped]
- , _queryParams :: [Param]
- } deriving Show
-
-newtype Escaped = Escaped String
-
-escaped :: String -> Escaped
-escaped = Escaped . escapeURIString isUnreserved
-
-getEscaped :: Escaped -> String
-getEscaped (Escaped s) = s
-
-instance Show Escaped where
- showsPrec d (Escaped s) = showsPrec d s
- show (Escaped s) = show s
-
-linkSegments :: Link -> [String]
-linkSegments = map getEscaped . _segments
-
-linkQueryParams :: Link -> [Param]
-linkQueryParams = _queryParams
-
-instance ToHttpApiData Link where
- toHeader = TE.encodeUtf8 . toUrlPiece
- toUrlPiece l =
- let uri = linkURI l
- in Text.pack $ uriPath uri ++ uriQuery uri
-
--- | Query parameter.
-data Param
- = SingleParam String Text.Text
- | ArrayElemParam String Text.Text
- | FlagParam String
- deriving Show
-
-addSegment :: Escaped -> Link -> Link
-addSegment seg l = l { _segments = _segments l <> [seg] }
-
-addQueryParam :: Param -> Link -> Link
-addQueryParam qp l =
- l { _queryParams = _queryParams l <> [qp] }
-
--- | Transform 'Link' into 'URI'.
---
--- >>> type API = "something" :> Get '[JSON] Int
--- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API)
--- something
---
--- >>> type API = "sum" :> QueryParams "x" Int :> Get '[JSON] Int
--- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API) [1, 2, 3]
--- sum?x[]=1&x[]=2&x[]=3
---
--- >>> type API = "foo/bar" :> Get '[JSON] Int
--- >>> linkURI $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API)
--- foo%2Fbar
---
--- >>> type SomeRoute = "abc" :> Capture "email" String :> Put '[JSON] ()
--- >>> let someRoute = Proxy :: Proxy SomeRoute
--- >>> safeLink someRoute someRoute "test@example.com"
--- Link {_segments = ["abc","test%40example.com"], _queryParams = []}
---
--- >>> linkURI $ safeLink someRoute someRoute "test@example.com"
--- abc/test%40example.com
---
-linkURI :: Link -> URI
-linkURI = linkURI' LinkArrayElementBracket
-
--- | How to encode array query elements.
-data LinkArrayElementStyle
- = LinkArrayElementBracket -- ^ @foo[]=1&foo[]=2@
- | LinkArrayElementPlain -- ^ @foo=1&foo=2@
- deriving (Eq, Ord, Show, Enum, Bounded)
-
--- | Configurable 'linkURI'.
---
--- >>> type API = "sum" :> QueryParams "x" Int :> Get '[JSON] Int
--- >>> linkURI' LinkArrayElementBracket $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API) [1, 2, 3]
--- sum?x[]=1&x[]=2&x[]=3
---
--- >>> linkURI' LinkArrayElementPlain $ safeLink (Proxy :: Proxy API) (Proxy :: Proxy API) [1, 2, 3]
--- sum?x=1&x=2&x=3
---
-linkURI' :: LinkArrayElementStyle -> Link -> URI
-linkURI' addBrackets (Link segments q_params) =
- URI mempty -- No scheme (relative)
- Nothing -- Or authority (relative)
- (intercalate "/" $ map getEscaped segments)
- (makeQueries q_params) mempty
+module Servant.Utils.Links
+ {-# DEPRECATED "Use Servant.Links." #-}
+ ( module Servant.Links )
where
- makeQueries :: [Param] -> String
- makeQueries [] = ""
- makeQueries xs =
- "?" <> intercalate "&" (fmap makeQuery xs)
-
- makeQuery :: Param -> String
- makeQuery (ArrayElemParam k v) = escape k <> style <> escape (Text.unpack v)
- makeQuery (SingleParam k v) = escape k <> "=" <> escape (Text.unpack v)
- makeQuery (FlagParam k) = escape k
-
- style = case addBrackets of
- LinkArrayElementBracket -> "[]="
- LinkArrayElementPlain -> "="
-
-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 api -- ^ The whole API that this endpoint is a part of
- -> Proxy endpoint -- ^ The API endpoint you would like to point to
- -> MkLink endpoint Link
-safeLink = safeLink' id
-
--- | More general 'safeLink'.
---
-safeLink'
- :: forall endpoint api a. (IsElem endpoint api, HasLink endpoint)
- => (Link -> a)
- -> 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 a
-safeLink' toA _ endpoint = toLink toA endpoint (Link mempty mempty)
-
--- | Create all links in an API.
---
--- Note that the @api@ type must be restricted to the endpoints that have
--- valid links to them.
---
--- >>> type API = "foo" :> Capture "name" Text :> Get '[JSON] Text :<|> "bar" :> Capture "name" Int :> Get '[JSON] Double
--- >>> let fooLink :<|> barLink = allLinks (Proxy :: Proxy API)
--- >>> :t fooLink
--- fooLink :: Text -> Link
--- >>> :t barLink
--- barLink :: Int -> Link
---
--- Note: nested APIs don't work well with this approach
---
--- >>> :kind! MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double)) Link
--- MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double)) Link :: *
--- = Char -> (Int -> Link) :<|> (Double -> Link)
-allLinks
- :: forall api. HasLink api
- => Proxy api
- -> MkLink api Link
-allLinks = allLinks' id
-
--- | More general 'allLinks'. See `safeLink'`.
-allLinks'
- :: forall api a. HasLink api
- => (Link -> a)
- -> Proxy api
- -> MkLink api a
-allLinks' toA api = toLink toA api (Link mempty mempty)
-
--- | Construct a toLink for an endpoint.
-class HasLink endpoint where
- type MkLink endpoint (a :: *)
- toLink
- :: (Link -> a)
- -> Proxy endpoint -- ^ The API endpoint you would like to point to
- -> Link
- -> MkLink endpoint a
-
--- Naked symbol instance
-instance (KnownSymbol sym, HasLink sub) => HasLink (sym :> sub) where
- type MkLink (sym :> sub) a = MkLink sub a
- toLink toA _ =
- toLink toA (Proxy :: Proxy sub) . addSegment (escaped seg)
- where
- seg = symbolVal (Proxy :: Proxy sym)
-
--- QueryParam instances
-instance (KnownSymbol sym, ToHttpApiData v, HasLink sub, SBoolI (FoldRequired mods))
- => HasLink (QueryParam' mods sym v :> sub)
- where
- type MkLink (QueryParam' mods sym v :> sub) a = If (FoldRequired mods) v (Maybe v) -> MkLink sub a
- toLink toA _ l mv =
- toLink toA (Proxy :: Proxy sub) $
- case sbool :: SBool (FoldRequired mods) of
- STrue -> (addQueryParam . SingleParam k . toQueryParam) mv l
- SFalse -> maybe id (addQueryParam . SingleParam k . toQueryParam) mv l
- where
- k :: String
- k = symbolVal (Proxy :: Proxy sym)
-
-instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)
- => HasLink (QueryParams sym v :> sub)
- where
- type MkLink (QueryParams sym v :> sub) a = [v] -> MkLink sub a
- toLink toA _ l =
- toLink toA (Proxy :: Proxy sub) .
- foldl' (\l' v -> addQueryParam (ArrayElemParam k (toQueryParam v)) l') l
- where
- k = symbolVal (Proxy :: Proxy sym)
-
-instance (KnownSymbol sym, HasLink sub)
- => HasLink (QueryFlag sym :> sub)
- where
- type MkLink (QueryFlag sym :> sub) a = Bool -> MkLink sub a
- toLink toA _ l False =
- toLink toA (Proxy :: Proxy sub) l
- toLink toA _ l True =
- toLink toA (Proxy :: Proxy sub) $ addQueryParam (FlagParam k) l
- where
- k = symbolVal (Proxy :: Proxy sym)
-
--- :<|> instance - Generate all links at once
-instance (HasLink a, HasLink b) => HasLink (a :<|> b) where
- type MkLink (a :<|> b) r = MkLink a r :<|> MkLink b r
- toLink toA _ l = toLink toA (Proxy :: Proxy a) l :<|> toLink toA (Proxy :: Proxy b) l
-
--- Misc instances
-instance HasLink sub => HasLink (ReqBody' mods ct a :> sub) where
- type MkLink (ReqBody' mods ct a :> sub) r = MkLink sub r
- toLink toA _ = toLink toA (Proxy :: Proxy sub)
-
-instance (ToHttpApiData v, HasLink sub)
- => HasLink (Capture' mods sym v :> sub)
- where
- type MkLink (Capture' mods sym v :> sub) a = v -> MkLink sub a
- toLink toA _ l v =
- toLink toA (Proxy :: Proxy sub) $
- addSegment (escaped . Text.unpack $ toUrlPiece v) l
-
-instance (ToHttpApiData v, HasLink sub)
- => HasLink (CaptureAll sym v :> sub)
- where
- type MkLink (CaptureAll sym v :> sub) a = [v] -> MkLink sub a
- toLink toA _ l vs = toLink toA (Proxy :: Proxy sub) $
- foldl' (flip $ addSegment . escaped . Text.unpack . toUrlPiece) l vs
-
-instance HasLink sub => HasLink (Header' mods sym (a :: *) :> sub) where
- type MkLink (Header' mods sym a :> sub) r = MkLink sub r
- toLink = simpleToLink (Proxy :: Proxy sub)
-
-instance HasLink sub => HasLink (Vault :> sub) where
- type MkLink (Vault :> sub) a = MkLink sub a
- toLink = simpleToLink (Proxy :: Proxy sub)
-
-instance HasLink sub => HasLink (Description s :> sub) where
- type MkLink (Description s :> sub) a = MkLink sub a
- toLink = simpleToLink (Proxy :: Proxy sub)
-
-instance HasLink sub => HasLink (Summary s :> sub) where
- type MkLink (Summary s :> sub) a = MkLink sub a
- toLink = simpleToLink (Proxy :: Proxy sub)
-
-instance HasLink sub => HasLink (HttpVersion :> sub) where
- type MkLink (HttpVersion:> sub) a = MkLink sub a
- toLink = simpleToLink (Proxy :: Proxy sub)
-
-instance HasLink sub => HasLink (IsSecure :> sub) where
- type MkLink (IsSecure :> sub) a = MkLink sub a
- toLink = simpleToLink (Proxy :: Proxy sub)
-
-instance HasLink sub => HasLink (WithNamedContext name context sub) where
- type MkLink (WithNamedContext name context sub) a = MkLink sub a
- toLink toA _ = toLink toA (Proxy :: Proxy sub)
-
-instance HasLink sub => HasLink (RemoteHost :> sub) where
- type MkLink (RemoteHost :> sub) a = MkLink sub a
- toLink = simpleToLink (Proxy :: Proxy sub)
-
-instance HasLink sub => HasLink (BasicAuth realm a :> sub) where
- type MkLink (BasicAuth realm a :> sub) r = MkLink sub r
- toLink = simpleToLink (Proxy :: Proxy sub)
-
-instance HasLink EmptyAPI where
- type MkLink EmptyAPI a = EmptyAPI
- toLink _ _ _ = EmptyAPI
-
--- Verb (terminal) instances
-instance HasLink (Verb m s ct a) where
- type MkLink (Verb m s ct a) r = r
- toLink toA _ = toA
-
-instance HasLink Raw where
- type MkLink Raw a = a
- toLink toA _ = toA
-
-instance HasLink (Stream m fr ct a) where
- type MkLink (Stream m fr ct a) r = r
- toLink toA _ = toA
-
--- AuthProtext instances
-instance HasLink sub => HasLink (AuthProtect tag :> sub) where
- type MkLink (AuthProtect tag :> sub) a = MkLink sub a
- toLink = simpleToLink (Proxy :: Proxy sub)
-
--- | Helper for implemneting 'toLink' for combinators not affecting link
--- structure.
-simpleToLink
- :: forall sub a combinator.
- (HasLink sub, MkLink sub a ~ MkLink (combinator :> sub) a)
- => Proxy sub
- -> (Link -> a)
- -> Proxy (combinator :> sub)
- -> Link
- -> MkLink (combinator :> sub) a
-simpleToLink _ toA _ = toLink toA (Proxy :: Proxy sub)
-
--- $setup
--- >>> import Servant.API
--- >>> import Data.Text (Text)
+import Servant.Links
diff --git a/test/Servant/Utils/LinksSpec.hs b/test/Servant/LinksSpec.hs
index 1ebb0fc..9cd5b0d 100644
--- a/test/Servant/Utils/LinksSpec.hs
+++ b/test/Servant/LinksSpec.hs
@@ -7,7 +7,7 @@
#if __GLASGOW_HASKELL__ < 709
{-# OPTIONS_GHC -fcontext-stack=41 #-}
#endif
-module Servant.Utils.LinksSpec where
+module Servant.LinksSpec where
import Data.Proxy (Proxy (..))
import Test.Hspec (Expectation, Spec, describe, it,
@@ -15,7 +15,7 @@ import Test.Hspec (Expectation, Spec, describe, it,
import Data.String (fromString)
import Servant.API
-import Servant.Utils.Links
+import Servant.Links
import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPIWithoutRaw)
type TestApi =
@@ -51,7 +51,7 @@ shouldBeLink link expected =
toUrlPiece link `shouldBe` fromString expected
spec :: Spec
-spec = describe "Servant.Utils.Links" $ do
+spec = describe "Servant.Links" $ do
it "generates correct links for capture query params" $ do
let l1 = Proxy :: Proxy ("hello" :> Capture "name" String :> Delete '[JSON] NoContent)
apiLink l1 "hi" `shouldBeLink` "hello/hi"