servant 0.13.0.1 → 0.14
raw patch · 29 files changed
+612/−322 lines, 29 filesdep ~QuickCheckdep ~aesondep ~aeson-compat
Dependency ranges changed: QuickCheck, aeson, aeson-compat, attoparsec, base-compat, doctest, hspec, http-api-data, http-media, http-types, mmorph, quickcheck-instances, semigroups, singleton-bool, vault
Files
- CHANGELOG.md +120/−0
- servant.cabal +24/−25
- src/Servant/API.hs +67/−63
- src/Servant/API/Alternative.hs +5/−3
- src/Servant/API/BasicAuth.hs +9/−6
- src/Servant/API/Capture.hs +4/−2
- src/Servant/API/ContentTypes.hs +21/−15
- src/Servant/API/Description.hs +7/−4
- src/Servant/API/Empty.hs +2/−1
- src/Servant/API/Experimental/Auth.hs +5/−4
- src/Servant/API/Header.hs +4/−2
- src/Servant/API/HttpVersion.hs +2/−1
- src/Servant/API/Internal/Test/ComprehensiveAPI.hs +1/−2
- src/Servant/API/IsSecure.hs +4/−2
- src/Servant/API/Modifiers.hs +9/−5
- src/Servant/API/QueryParam.hs +5/−3
- src/Servant/API/Raw.hs +3/−1
- src/Servant/API/RemoteHost.hs +1/−0
- src/Servant/API/ReqBody.hs +4/−3
- src/Servant/API/ResponseHeaders.hs +45/−23
- src/Servant/API/Stream.hs +50/−27
- src/Servant/API/Sub.hs +2/−1
- src/Servant/API/TypeLevel.hs +18/−9
- src/Servant/API/Vault.hs +2/−1
- src/Servant/API/Verbs.hs +12/−9
- src/Servant/API/WithNamedContext.hs +2/−2
- src/Servant/Utils/Enter.hs +4/−3
- src/Servant/Utils/Links.hs +178/−103
- test/Servant/Utils/LinksSpec.hs +2/−2
CHANGELOG.md view
@@ -1,5 +1,125 @@ [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md) +0.14+----++### Signifacant changes++- `Stream` takes a status code argument++ ```diff+ -Stream method framing ctype a+ +Stream method status framing ctype a+ ```++ ([#966](https://github.com/haskell-servant/servant/pull/966)+ [#972](https://github.com/haskell-servant/servant/pull/972))++- `ToStreamGenerator` definition changed, so it's possible to write an instance+ for conduits.++ ```diff+ -class ToStreamGenerator f a where+ - toStreamGenerator :: f a -> StreamGenerator a+ +class ToStreamGenerator a b | a -> b where+ + toStreamGenerator :: a -> StreamGenerator b+ ```++ ([#959](https://github.com/haskell-servant/servant/pull/959))++- Added `NoFraming` streaming strategy+ ([#959](https://github.com/haskell-servant/servant/pull/959))++- *servant-client-core* Free `Client` implementation.+ Useful for testing `HasClient` instances.+ ([#920](https://github.com/haskell-servant/servant/pull/920))++- *servant-client-core* Add `hoistClient` to `HasClient`.+ Just like `hoistServer` allows us to change the monad in which request handlers+ of a web application live in, we also have `hoistClient` for changing the monad+ in which *client functions* live.+ Read [tutorial section for more information](https://haskell-servant.readthedocs.io/en/release-0.14/tutorial/Client.html#changing-the-monad-the-client-functions-live-in).+ ([#936](https://github.com/haskell-servant/servant/pull/936))++ iF you have own combinators, you'll need to define a new method of+ `HasClient` class, for example:++ ```haskell+ type Client m (MyCombinator :> api) = MyValue :> Client m api+ hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy api) nt . cl+ ```++- *servant* Add `safeLink' :: (Link -> a) -> ... -> MkLink endpoint a`,+ which allows to create helpers returning something else than `Link`.+ ([#968](https://github.com/haskell-servant/servant/pull/968))++- *servant-server* File serving in polymorphic monad.+ i.e. Generalised types of `serveDirectoryFileServer` etc functions in+ `Servant.Utils.StaticFiles`+ ([#953](https://github.com/haskell-servant/servant/pull/953))++- *servant-server* `ReqBody` content type check is recoverable.+ This allows writing APIs like:++ ```haskell+ ReqBody '[JSON] Int :> Post '[PlainText] Int+ :<|> ReqBody '[PlainText] Int :> Post '[PlainText] Int+ ```++ which is useful when handlers are subtly different,+ for example may do less work.+ ([#937](https://github.com/haskell-servant/servant/pull/937))++- *servant-client* Add more constructors to `RequestBody`, including+ `RequestBodyStream`.+ *Note:* we are looking for http-library agnostic API,+ so the might change again soon.+ Tell us which constructors are useful for you!+ ([#913](https://github.com/haskell-servant/servant/pull/913))++### Other changes++- `GetHeaders` instances implemented without `OverlappingInstances`+ ([#971](https://github.com/haskell-servant/servant/pull/971))++- Added tests or enabled tests+ ([#975](https://github.com/haskell-servant/servant/pull/975))++- Add [pagination cookbook recipe](https://haskell-servant.readthedocs.io/en/release-0.14/cookbook/pagination/Pagination.html)+ ([#946](https://github.com/haskell-servant/servant/pull/946))++- Add [`servant-flatten` "spice" to the structuring api recipe](https://haskell-servant.readthedocs.io/en/release-0.14/cookbook/structuring-apis/StructuringApis.html)+ ([#929](https://github.com/haskell-servant/servant/pull/929))++- Dependency updates+ ([#900](https://github.com/haskell-servant/servant/pull/900)+ [#919](https://github.com/haskell-servant/servant/pull/919)+ [#924](https://github.com/haskell-servant/servant/pull/924)+ [#943](https://github.com/haskell-servant/servant/pull/943)+ [#964](https://github.com/haskell-servant/servant/pull/964)+ [#967](https://github.com/haskell-servant/servant/pull/967)+ [#976](https://github.com/haskell-servant/servant/pull/976))++- Documentation updates+ [#963](https://github.com/haskell-servant/servant/pull/963)+ [#960](https://github.com/haskell-servant/servant/pull/960)+ [#908](https://github.com/haskell-servant/servant/pull/908)+ [#958](https://github.com/haskell-servant/servant/pull/958)+ [#948](https://github.com/haskell-servant/servant/pull/948)+ [#928](https://github.com/haskell-servant/servant/pull/928)+ [#921](https://github.com/haskell-servant/servant/pull/921))++- Development process improvements+ ([#680](https://github.com/haskell-servant/servant/pull/680)+ [#917](https://github.com/haskell-servant/servant/pull/917)+ [#923](https://github.com/haskell-servant/servant/pull/923)+ [#961](https://github.com/haskell-servant/servant/pull/961)+ [#973](https://github.com/haskell-servant/servant/pull/973))++### Note++(VIM) Regular-expression to link PR numbers: `s/\v#(\d+)/[#\1](https:\/\/github.com\/haskell-servant\/servant/pull\/\1)/`+ 0.13.0.1 --------
servant.cabal view
@@ -1,5 +1,5 @@ name: servant-version: 0.13.0.1+version: 0.14 synopsis: A family of combinators for defining webservices APIs description: A family of combinators for defining webservices APIs and serving them@@ -18,11 +18,11 @@ build-type: Custom cabal-version: >=1.10 tested-with:- GHC==7.8.4,- GHC==7.10.3,- GHC==8.0.2,- GHC==8.2.2,- GHC==8.4.1+ GHC==7.8.4+ GHC==7.10.3+ GHC==8.0.2+ GHC==8.2.2+ GHC==8.4.3 extra-source-files: include/*.h CHANGELOG.md@@ -34,7 +34,7 @@ setup-depends: base >= 4 && <5, Cabal,- cabal-doctest >= 1.0.2 && <1.1+ cabal-doctest >= 1.0.6 && <1.1 library exposed-modules:@@ -77,25 +77,25 @@ if !impl(ghc >= 8.0) build-depends:- semigroups >= 0.18.3 && < 0.19+ semigroups >= 0.18.4 && < 0.19 -- Other dependencies: Lower bound around what is in the latest Stackage LTS. -- Here can be exceptions if we really need features from the newer versions. build-depends:- base-compat >= 0.9.3 && < 0.11- , aeson >= 1.2.3.0 && < 1.4- , attoparsec >= 0.13.2.0 && < 0.14+ base-compat >= 0.10.1 && < 0.11+ , aeson >= 1.3.1.1 && < 1.5+ , attoparsec >= 0.13.2.2 && < 0.14 , case-insensitive >= 1.2.0.10 && < 1.3- , http-api-data >= 0.3.7.1 && < 0.4- , http-media >= 0.7.0 && < 0.8- , http-types >= 0.12 && < 0.13+ , http-api-data >= 0.3.8.1 && < 0.4+ , http-media >= 0.7.1.2 && < 0.8+ , http-types >= 0.12.1 && < 0.13 , natural-transformation >= 0.4 && < 0.5- , mmorph >= 1.1.0 && < 1.2+ , mmorph >= 1.1.2 && < 1.2 , tagged >= 0.8.5 && < 0.9- , singleton-bool >= 0.1.2.0 && < 0.2+ , singleton-bool >= 0.1.4 && < 0.2 , string-conversions >= 0.4.0.1 && < 0.5 , network-uri >= 2.6.1.0 && < 2.7- , vault >= 0.3.0.7 && < 0.4+ , vault >= 0.3.1.1 && < 0.4 hs-source-dirs: src default-language: Haskell2010@@ -141,7 +141,6 @@ base , base-compat , aeson- , attoparsec , bytestring , servant , string-conversions@@ -153,23 +152,23 @@ -- Additonal dependencies build-depends:- aeson-compat >= 0.3.3 && < 0.4- , hspec >= 2.4.4 && < 2.6- , QuickCheck >= 2.10.1 && < 2.12- , quickcheck-instances >= 0.3.16 && < 0.4+ aeson-compat >= 0.3.7.1 && < 0.4+ , hspec >= 2.5.1 && < 2.6+ , QuickCheck >= 2.11.3 && < 2.12+ , quickcheck-instances >= 0.3.18 && < 0.4 build-tool-depends:- hspec-discover:hspec-discover >= 2.4.4 && < 2.6+ hspec-discover:hspec-discover >= 2.5.1 && < 2.6 test-suite doctests build-depends: base , servant- , doctest >= 0.13.0 && <0.16+ , doctest >= 0.15.0 && <0.16 -- We test Links failure with doctest, so we need extra dependencies build-depends:- hspec >= 2.4.4 && < 2.6+ hspec >= 2.5.1 && < 2.6 type: exitcode-stdio-1.0 main-is: test/doctests.hs
src/Servant/API.hs view
@@ -66,71 +66,75 @@ -- * Utilities module Servant.Utils.Links, -- | Type-safe internal URIs- + -- * Re-exports If, SBool (..), SBoolI (..) ) where -import Servant.API.Alternative ((:<|>) (..))-import Servant.API.BasicAuth (BasicAuth,BasicAuthData(..))-import Servant.API.Capture (Capture, Capture', CaptureAll)-import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,- JSON,- MimeRender (..), NoContent (NoContent),- MimeUnrender (..), OctetStream,- PlainText)-import Servant.API.Description (Description, Summary)-import Servant.API.Empty (EmptyAPI (..))-import Servant.API.Experimental.Auth (AuthProtect)-import Servant.API.Header (Header, Header')-import Servant.API.HttpVersion (HttpVersion (..))-import Servant.API.IsSecure (IsSecure (..))-import Servant.API.Modifiers (Required, Optional, Lenient, Strict)-import Servant.API.QueryParam (QueryFlag, QueryParam, QueryParam',- QueryParams)-import Servant.API.Raw (Raw)-import Servant.API.Stream (Stream, StreamGet, StreamPost,- StreamGenerator (..),- ToStreamGenerator (..),- ResultStream(..), BuildFromStream (..),- ByteStringParser (..),- FramingRender (..), BoundaryStrategy (..),- FramingUnrender (..),- NewlineFraming,- NetstringFraming)-import Servant.API.RemoteHost (RemoteHost)-import Servant.API.ReqBody (ReqBody, ReqBody')-import Servant.API.ResponseHeaders (AddHeader, addHeader, noHeader,- BuildHeadersTo (buildHeadersTo),- GetHeaders (getHeaders),- HList (..), Headers (..),- getHeadersHList, getResponse, ResponseHeader (..))-import Servant.API.Sub ((:>))-import Servant.API.Vault (Vault)-import Servant.API.Verbs (PostCreated, Delete, DeleteAccepted,- DeleteNoContent,- DeleteNonAuthoritative, Get,- GetAccepted, GetNoContent,- GetNonAuthoritative,- GetPartialContent,- GetResetContent,- Patch,- PatchAccepted, PatchNoContent,- PatchNoContent,- PatchNonAuthoritative, Post,- PostAccepted, PostNoContent,- PostNonAuthoritative,- PostResetContent, Put,- PutAccepted, PutNoContent,- PutNoContent, PutNonAuthoritative,- ReflectMethod (reflectMethod),- Verb, StdMethod(..))-import Servant.API.WithNamedContext (WithNamedContext)-import Servant.Utils.Links (HasLink (..), Link, IsElem, IsElem',- URI (..), safeLink)-import Web.HttpApiData (FromHttpApiData (..),- ToHttpApiData (..))--import Data.Type.Bool (If)-import Data.Singletons.Bool (SBool (..), SBoolI (..))+import Data.Singletons.Bool+ (SBool (..), SBoolI (..))+import Data.Type.Bool+ (If)+import Servant.API.Alternative+ ((:<|>) (..))+import Servant.API.BasicAuth+ (BasicAuth, BasicAuthData (..))+import Servant.API.Capture+ (Capture, Capture', CaptureAll)+import Servant.API.ContentTypes+ (Accept (..), FormUrlEncoded, JSON, MimeRender (..),+ MimeUnrender (..), NoContent (NoContent), OctetStream,+ PlainText)+import Servant.API.Description+ (Description, Summary)+import Servant.API.Empty+ (EmptyAPI (..))+import Servant.API.Experimental.Auth+ (AuthProtect)+import Servant.API.Header+ (Header, Header')+import Servant.API.HttpVersion+ (HttpVersion (..))+import Servant.API.IsSecure+ (IsSecure (..))+import Servant.API.Modifiers+ (Lenient, Optional, Required, Strict)+import Servant.API.QueryParam+ (QueryFlag, QueryParam, QueryParam', QueryParams)+import Servant.API.Raw+ (Raw)+import Servant.API.RemoteHost+ (RemoteHost)+import Servant.API.ReqBody+ (ReqBody, ReqBody')+import Servant.API.ResponseHeaders+ (AddHeader, BuildHeadersTo (buildHeadersTo),+ GetHeaders (getHeaders), HList (..), Headers (..),+ ResponseHeader (..), addHeader, getHeadersHList, getResponse,+ noHeader)+import Servant.API.Stream+ (BoundaryStrategy (..), BuildFromStream (..),+ ByteStringParser (..), FramingRender (..),+ FramingUnrender (..), NetstringFraming, NewlineFraming,+ NoFraming, ResultStream (..), Stream, StreamGenerator (..),+ StreamGet, StreamPost, ToStreamGenerator (..))+import Servant.API.Sub+ ((:>))+import Servant.API.Vault+ (Vault)+import Servant.API.Verbs+ (Delete, DeleteAccepted, DeleteNoContent,+ DeleteNonAuthoritative, Get, GetAccepted, GetNoContent,+ GetNonAuthoritative, GetPartialContent, GetResetContent,+ Patch, PatchAccepted, PatchNoContent, PatchNonAuthoritative,+ Post, PostAccepted, PostCreated, PostNoContent,+ PostNonAuthoritative, PostResetContent, Put, PutAccepted,+ PutNoContent, PutNonAuthoritative,+ ReflectMethod (reflectMethod), StdMethod (..), Verb)+import Servant.API.WithNamedContext+ (WithNamedContext)+import Servant.Utils.Links+ (HasLink (..), IsElem, IsElem', Link, URI (..), safeLink)+import Web.HttpApiData+ (FromHttpApiData (..), ToHttpApiData (..))
src/Servant/API/Alternative.hs view
@@ -1,14 +1,16 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_HADDOCK not-home #-} module Servant.API.Alternative ((:<|>)(..)) where -import Data.Semigroup (Semigroup (..))-import Data.Typeable (Typeable)+import Data.Semigroup+ (Semigroup (..))+import Data.Typeable+ (Typeable) import Prelude () import Prelude.Compat
src/Servant/API/BasicAuth.hs view
@@ -1,13 +1,16 @@-{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PolyKinds #-} module Servant.API.BasicAuth where -import Data.ByteString (ByteString)-import Data.Typeable (Typeable)-import GHC.TypeLits (Symbol)+import Data.ByteString+ (ByteString)+import Data.Typeable+ (Typeable)+import GHC.TypeLits+ (Symbol) -- | Combinator for <https://tools.ietf.org/html/rfc2617#section-2 Basic Access Authentication>.
src/Servant/API/Capture.hs view
@@ -4,8 +4,10 @@ {-# OPTIONS_HADDOCK not-home #-} module Servant.API.Capture (Capture, Capture', CaptureAll) where -import Data.Typeable (Typeable)-import GHC.TypeLits (Symbol)+import Data.Typeable+ (Typeable)+import GHC.TypeLits+ (Symbol) -- | Capture a value from the request path under a certain type @a@. -- -- Example:
src/Servant/API/ContentTypes.hs view
@@ -71,32 +71,38 @@ , canHandleAcceptH ) where -import Control.Arrow (left)+import Control.Arrow+ (left) import Control.Monad.Compat-import Data.Aeson (FromJSON(..), ToJSON(..), encode)-import Data.Aeson.Parser (value)-import Data.Aeson.Types (parseEither)-import Data.Attoparsec.ByteString.Char8 (endOfInput, parseOnly,- skipSpace, (<?>))+import Data.Aeson+ (FromJSON (..), ToJSON (..), encode)+import Data.Aeson.Parser+ (value)+import Data.Aeson.Types+ (parseEither)+import Data.Attoparsec.ByteString.Char8+ (endOfInput, parseOnly, skipSpace, (<?>)) import qualified Data.ByteString as BS-import Data.ByteString.Lazy (ByteString, fromStrict,- toStrict)+import Data.ByteString.Lazy+ (ByteString, fromStrict, toStrict) import qualified Data.ByteString.Lazy.Char8 as BC import qualified Data.List.NonEmpty as NE-import Data.Maybe (isJust)-import Data.String.Conversions (cs)+import Data.Maybe+ (isJust)+import Data.String.Conversions+ (cs) import qualified Data.Text as TextS import qualified Data.Text.Encoding as TextS import qualified Data.Text.Lazy as TextL import qualified Data.Text.Lazy.Encoding as TextL import Data.Typeable-import GHC.Generics (Generic)+import GHC.Generics+ (Generic) import qualified Network.HTTP.Media as M-import Web.FormUrlEncoded (FromForm, ToForm,- urlEncodeAsForm,- urlDecodeAsForm)-import Prelude ()+import Prelude () import Prelude.Compat+import Web.FormUrlEncoded+ (FromForm, ToForm, urlDecodeAsForm, urlEncodeAsForm) #if MIN_VERSION_base(4,9,0) import qualified GHC.TypeLits as TL
src/Servant/API/Description.hs view
@@ -3,8 +3,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# OPTIONS_HADDOCK not-home #-} module Servant.API.Description ( -- * Combinators@@ -16,9 +16,12 @@ reflectDescription, ) where -import Data.Typeable (Typeable)-import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)-import Data.Proxy (Proxy (..))+import Data.Proxy+ (Proxy (..))+import Data.Typeable+ (Typeable)+import GHC.TypeLits+ (KnownSymbol, Symbol, symbolVal) -- | Add a short summary for (part of) API. --
src/Servant/API/Empty.hs view
@@ -2,7 +2,8 @@ {-# OPTIONS_HADDOCK not-home #-} module Servant.API.Empty(EmptyAPI(..)) where -import Data.Typeable (Typeable)+import Data.Typeable+ (Typeable) import Prelude () import Prelude.Compat
src/Servant/API/Experimental/Auth.hs view
@@ -1,10 +1,11 @@-{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PolyKinds #-} module Servant.API.Experimental.Auth where -import Data.Typeable (Typeable)+import Data.Typeable+ (Typeable) -- | A generalized Authentication combinator. Use this if you have a -- non-standard authentication technique.
src/Servant/API/Header.hs view
@@ -6,8 +6,10 @@ Header, Header', ) where -import Data.Typeable (Typeable)-import GHC.TypeLits (Symbol)+import Data.Typeable+ (Typeable)+import GHC.TypeLits+ (Symbol) import Servant.API.Modifiers -- | Extract the given header's value as a value of type @a@.
src/Servant/API/HttpVersion.hs view
@@ -3,7 +3,8 @@ HttpVersion(..) ) where -import Network.HTTP.Types (HttpVersion (..))+import Network.HTTP.Types+ (HttpVersion (..)) -- $httpversion --
src/Servant/API/Internal/Test/ComprehensiveAPI.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-} -- | This is a module containing an API with all `Servant.API` combinators. It@@ -7,7 +7,6 @@ module Servant.API.Internal.Test.ComprehensiveAPI where import Data.Proxy- import Servant.API type GET = Get '[JSON] NoContent
src/Servant/API/IsSecure.hs view
@@ -1,12 +1,14 @@ {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveGeneric #-} module Servant.API.IsSecure ( -- $issecure IsSecure(..) ) where import Data.Typeable-import GHC.Generics (Generic)+ (Typeable)+import GHC.Generics+ (Generic) -- | Was this request made over an SSL connection? --
src/Servant/API/Modifiers.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}@@ -19,10 +19,14 @@ unfoldRequestArgument, ) where -import Data.Proxy (Proxy (..))-import Data.Singletons.Bool (SBool (..), SBoolI (..))-import Data.Text (Text)-import Data.Type.Bool (If)+import Data.Proxy+ (Proxy (..))+import Data.Singletons.Bool+ (SBool (..), SBoolI (..))+import Data.Text+ (Text)+import Data.Type.Bool+ (If) -- | Required argument. Not wrapped. data Required
src/Servant/API/QueryParam.hs view
@@ -1,12 +1,14 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeOperators #-} {-# OPTIONS_HADDOCK not-home #-} module Servant.API.QueryParam (QueryFlag, QueryParam, QueryParam', QueryParams) where -import Data.Typeable (Typeable)-import GHC.TypeLits (Symbol)+import Data.Typeable+ (Typeable)+import GHC.TypeLits+ (Symbol) import Servant.API.Modifiers -- | Lookup the value associated to the @sym@ query string parameter
src/Servant/API/Raw.hs view
@@ -2,7 +2,9 @@ {-# OPTIONS_HADDOCK not-home #-} module Servant.API.Raw where -import Data.Typeable (Typeable)+import Data.Typeable+ (Typeable)+ -- | Endpoint for plugging in your own Wai 'Application's. -- -- The given 'Application' will get the request as received by the server, potentially with
src/Servant/API/RemoteHost.hs view
@@ -5,6 +5,7 @@ ) where import Data.Typeable+ (Typeable) -- | Provides access to the host or IP address -- from which the HTTP request was sent.
src/Servant/API/ReqBody.hs view
@@ -6,8 +6,9 @@ ReqBody, ReqBody', ) where -import Data.Typeable (Typeable)-import Servant.API.Modifiers+import Data.Typeable+ (Typeable)+import Servant.API.Modifiers -- | Extract the request body as a value of type @a@. --@@ -17,7 +18,7 @@ -- >>> type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book type ReqBody = ReqBody' '[Required, Strict] --- | +-- | -- -- /Note:/ 'ReqBody'' is always 'Required'. data ReqBody' (mods :: [*]) (contentTypes :: [*]) (a :: *)
src/Servant/API/ResponseHeaders.hs view
@@ -34,18 +34,22 @@ , HList(..) ) where -import Data.ByteString.Char8 as BS (ByteString, pack, unlines, init)-import Data.Typeable (Typeable)-import Web.HttpApiData (ToHttpApiData, toHeader,- FromHttpApiData, parseHeader)-import qualified Data.CaseInsensitive as CI+import Data.ByteString.Char8 as BS+ (ByteString, init, pack, unlines)+import qualified Data.CaseInsensitive as CI import Data.Proxy-import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)-import qualified Network.HTTP.Types.Header as HTTP+import Data.Typeable+ (Typeable)+import GHC.TypeLits+ (KnownSymbol, Symbol, symbolVal)+import qualified Network.HTTP.Types.Header as HTTP+import Web.HttpApiData+ (FromHttpApiData, ToHttpApiData, parseHeader, toHeader) -import Servant.API.Header (Header)-import Prelude ()+import Prelude () import Prelude.Compat+import Servant.API.Header+ (Header) -- | Response Header objects. You should never need to construct one directly. -- Instead, use 'addOptionalHeader'.@@ -96,23 +100,41 @@ class GetHeaders ls where getHeaders :: ls -> [HTTP.Header] -instance OVERLAPPING_ GetHeaders (HList '[]) where- getHeaders _ = []+-- | Auxiliary class for @'GetHeaders' ('HList' hs)@ instance+class GetHeadersFromHList hs where+ getHeadersFromHList :: HList hs -> [HTTP.Header] -instance OVERLAPPABLE_ ( KnownSymbol h, ToHttpApiData x, GetHeaders (HList xs) )- => GetHeaders (HList (Header h x ': xs)) where- getHeaders hdrs = case hdrs of- Header val `HCons` rest -> (headerName , toHeader val):getHeaders rest- UndecodableHeader h `HCons` rest -> (headerName, h) :getHeaders rest- MissingHeader `HCons` rest -> getHeaders rest- where headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)+instance GetHeadersFromHList hs => GetHeaders (HList hs) where+ getHeaders = getHeadersFromHList -instance OVERLAPPING_ GetHeaders (Headers '[] a) where- getHeaders _ = []+instance GetHeadersFromHList '[] where+ getHeadersFromHList _ = [] -instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToHttpApiData v )- => GetHeaders (Headers (Header h v ': rest) a) where- getHeaders hs = getHeaders $ getHeadersHList hs+instance (KnownSymbol h, ToHttpApiData x, GetHeadersFromHList xs)+ => GetHeadersFromHList (Header h x ': xs)+ where+ getHeadersFromHList hdrs = case hdrs of+ Header val `HCons` rest -> (headerName , toHeader val) : getHeadersFromHList rest+ UndecodableHeader h `HCons` rest -> (headerName, h) : getHeadersFromHList rest+ MissingHeader `HCons` rest -> getHeadersFromHList rest+ where+ headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)++-- | Auxiliary class for @'GetHeaders' ('Headers' hs a)@ instance+class GetHeaders' hs where+ getHeaders' :: Headers hs a -> [HTTP.Header]++instance GetHeaders' hs => GetHeaders (Headers hs a) where+ getHeaders = getHeaders'++-- | This instance is an optimisation+instance GetHeaders' '[] where+ getHeaders' _ = []++instance (KnownSymbol h, GetHeadersFromHList rest, ToHttpApiData v)+ => GetHeaders' (Header h v ': rest)+ where+ getHeaders' hs = getHeadersFromHList $ getHeadersHList hs -- * Adding
src/Servant/API/Stream.hs view
@@ -1,42 +1,53 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TupleSections #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-} {-# OPTIONS_HADDOCK not-home #-} module Servant.API.Stream where -import Data.ByteString.Lazy (ByteString, empty)-import qualified Data.ByteString.Lazy.Char8 as LB-import Data.Monoid ((<>))-import Data.Proxy (Proxy)-import Data.Typeable (Typeable)-import GHC.Generics (Generic)-import Text.Read (readMaybe)-import Control.Arrow (first)-import Network.HTTP.Types.Method (StdMethod (..))+import Control.Arrow+ (first)+import Data.ByteString.Lazy+ (ByteString, empty)+import qualified Data.ByteString.Lazy.Char8 as LB+import Data.Monoid+ ((<>))+import Data.Proxy+ (Proxy)+import Data.Typeable+ (Typeable)+import GHC.Generics+ (Generic)+import GHC.TypeLits+ (Nat)+import Network.HTTP.Types.Method+ (StdMethod (..))+import Text.Read+ (readMaybe) --- | A Stream endpoint for a given method emits a stream of encoded values at a given Content-Type, delimited by a framing strategy. Steam endpoints always return response code 200 on success. Type synonyms are provided for standard methods.-data Stream (method :: k1) (framing :: *) (contentType :: *) (a :: *)+-- | A Stream endpoint for a given method emits a stream of encoded values at a given Content-Type, delimited by a framing strategy. Stream endpoints always return response code 200 on success. Type synonyms are provided for standard methods.+data Stream (method :: k1) (status :: Nat) (framing :: *) (contentType :: *) (a :: *) deriving (Typeable, Generic) -type StreamGet = Stream 'GET-type StreamPost = Stream 'POST+type StreamGet = Stream 'GET 200+type StreamPost = Stream 'POST 200 -- | Stream endpoints may be implemented as producing a @StreamGenerator@ -- a function that itself takes two emit functions -- the first to be used on the first value the stream emits, and the second to be used on all subsequent values (to allow interspersed framing strategies such as comma separation).-newtype StreamGenerator a = StreamGenerator {getStreamGenerator :: (a -> IO ()) -> (a -> IO ()) -> IO ()}+newtype StreamGenerator a = StreamGenerator {getStreamGenerator :: (a -> IO ()) -> (a -> IO ()) -> IO ()} -- | ToStreamGenerator is intended to be implemented for types such as Conduit, Pipe, etc. By implementing this class, all such streaming abstractions can be used directly as endpoints.-class ToStreamGenerator f a where- toStreamGenerator :: f a -> StreamGenerator a+class ToStreamGenerator a b | a -> b where+ toStreamGenerator :: a -> StreamGenerator b -instance ToStreamGenerator StreamGenerator a+instance ToStreamGenerator (StreamGenerator a) a where toStreamGenerator x = x -- | Clients reading from streaming endpoints can be implemented as producing a @ResultStream@ that captures the setup, takedown, and incremental logic for a read, being an IO continuation that takes a producer of Just either values or errors that terminates with a Nothing.@@ -72,6 +83,18 @@ class FramingUnrender strategy a where unrenderFrames :: Proxy strategy -> Proxy a -> ByteStringParser (ByteStringParser (Either String ByteString)) +-- | A framing strategy that does not do any framing at all, it just passes the input data+-- This will be used most of the time with binary data, such as files+data NoFraming++instance FramingRender NoFraming a where+ header _ _ = empty+ boundary _ _ = BoundaryStrategyGeneral id+ trailer _ _ = empty++instance FramingUnrender NoFraming a where+ unrenderFrames _ _ = ByteStringParser (Just . (go,)) (go,)+ where go = ByteStringParser (Just . (, empty) . Right) ((, empty) . Right) -- | A simple framing strategy that has no header or termination, and inserts a newline character between each frame. -- This assumes that it is used with a Content-Type that encodes without newlines (e.g. JSON).
src/Servant/API/Sub.hs view
@@ -4,7 +4,8 @@ {-# OPTIONS_HADDOCK not-home #-} module Servant.API.Sub ((:>)) where -import Data.Typeable (Typeable)+import Data.Typeable+ (Typeable) -- | The contained API (second argument) can be found under @("/" ++ path)@ -- (path being the first argument).
src/Servant/API/TypeLevel.hs view
@@ -47,16 +47,25 @@ ) where -import GHC.Exts (Constraint)-import Servant.API.Alternative (type (:<|>))-import Servant.API.Capture (Capture, CaptureAll)-import Servant.API.Header (Header)-import Servant.API.QueryParam (QueryFlag, QueryParam, QueryParams)-import Servant.API.ReqBody (ReqBody)-import Servant.API.Sub (type (:>))-import Servant.API.Verbs (Verb)+import GHC.Exts+ (Constraint)+import Servant.API.Alternative+ (type (:<|>))+import Servant.API.Capture+ (Capture, CaptureAll)+import Servant.API.Header+ (Header)+import Servant.API.QueryParam+ (QueryFlag, QueryParam, QueryParams)+import Servant.API.ReqBody+ (ReqBody)+import Servant.API.Sub+ (type (:>))+import Servant.API.Verbs+ (Verb) #if MIN_VERSION_base(4,9,0)-import GHC.TypeLits (TypeError, ErrorMessage(..))+import GHC.TypeLits+ (ErrorMessage (..), TypeError) #endif
src/Servant/API/Vault.hs view
@@ -3,7 +3,8 @@ Vault ) where -import Data.Vault.Lazy (Vault)+import Data.Vault.Lazy+ (Vault) -- $vault --
src/Servant/API/Verbs.hs view
@@ -8,15 +8,18 @@ , StdMethod(GET, POST, HEAD, PUT, DELETE, TRACE, CONNECT, OPTIONS, PATCH) ) where -import Data.Typeable (Typeable)-import Data.Proxy (Proxy)-import GHC.Generics (Generic)-import GHC.TypeLits (Nat)-import Network.HTTP.Types.Method (Method, StdMethod (..),- methodDelete, methodGet, methodHead,- methodPatch, methodPost, methodPut,- methodTrace, methodConnect,- methodOptions)+import Data.Proxy+ (Proxy)+import Data.Typeable+ (Typeable)+import GHC.Generics+ (Generic)+import GHC.TypeLits+ (Nat)+import Network.HTTP.Types.Method+ (Method, StdMethod (..), methodConnect, methodDelete,+ methodGet, methodHead, methodOptions, methodPatch, methodPost,+ methodPut, methodTrace) -- | @Verb@ is a general type for representing HTTP verbs (a.k.a. methods). For -- convenience, type synonyms for each verb with a 200 response code are
src/Servant/API/WithNamedContext.hs view
@@ -1,9 +1,9 @@-{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} module Servant.API.WithNamedContext where -import GHC.TypeLits+import GHC.TypeLits -- | 'WithNamedContext' names a specific tagged context to use for the -- combinators in the API. (See also in @servant-server@,
src/Servant/Utils/Enter.hs view
@@ -13,7 +13,6 @@ (:~>)(..), ) where -import Control.Natural import Control.Monad.Identity import Control.Monad.Morph import Control.Monad.Reader@@ -21,8 +20,10 @@ import qualified Control.Monad.State.Strict as SState import qualified Control.Monad.Writer.Lazy as LWriter import qualified Control.Monad.Writer.Strict as SWriter-import Data.Tagged (Tagged, retag)-import Prelude ()+import Control.Natural+import Data.Tagged+ (Tagged, retag)+import Prelude () import Prelude.Compat import Servant.API
src/Servant/Utils/Links.hs view
@@ -19,8 +19,6 @@ -- >>> 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@@ -63,10 +61,24 @@ -- >>> :set -XConstraintKinds -- >>> :{ -- >>> let apiLink :: (IsElem endpoint API, HasLink endpoint)--- >>> => Proxy endpoint -> MkLink 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: --@@ -86,7 +98,9 @@ -- -- | Note that 'URI' is from the "Network.URI" module in the @network-uri@ package. safeLink+ , safeLink' , allLinks+ , allLinks' , URI(..) -- * Adding custom types , HasLink(..)@@ -101,38 +115,63 @@ ) where import Data.List-import Data.Semigroup ((<>))-import Data.Proxy ( Proxy(..) )-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 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 Web.HttpApiData-import Servant.API.Alternative ( (:<|>)((:<|>)) )-import Servant.API.BasicAuth ( BasicAuth )-import Servant.API.Capture ( Capture', CaptureAll )-import Servant.API.ReqBody ( ReqBody' )-import Servant.API.QueryParam ( QueryParam', QueryParams, QueryFlag )-import Servant.API.Header ( Header' )-import Servant.API.HttpVersion (HttpVersion)-import Servant.API.RemoteHost ( RemoteHost )-import Servant.API.IsSecure (IsSecure)-import Servant.API.Empty (EmptyAPI (..))-import Servant.API.Verbs ( Verb )-import Servant.API.Sub ( type (:>) )-import Servant.API.Raw ( Raw )-import Servant.API.Stream ( Stream )-import Servant.API.TypeLevel-import Servant.API.Modifiers (FoldRequired)-import Servant.API.Description (Description, Summary)-import Servant.API.Vault (Vault)-import Servant.API.WithNamedContext (WithNamedContext)-import Servant.API.Experimental.Auth ( AuthProtect )+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@@ -251,9 +290,19 @@ :: 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-safeLink _ endpoint = toLink endpoint (Link mempty mempty)+ -> 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@@ -268,37 +317,47 @@ -- -- 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))--- MkLink (Capture "nest" Char :> (Capture "x" Int :> Get '[JSON] Int :<|> Capture "y" Double :> Get '[JSON] Double)) :: *+-- >>> :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-allLinks api = toLink api (Link mempty mempty)+ -> 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- toLink :: Proxy endpoint -- ^ The API endpoint you would like to point to- -> Link- -> MkLink endpoint+ 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) = MkLink sub- toLink _ =- toLink (Proxy :: Proxy sub) . addSegment (escaped seg)+ 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) = If (FoldRequired mods) v (Maybe v) -> MkLink sub- toLink _ l mv =- toLink (Proxy :: Proxy sub) $+ => 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@@ -307,105 +366,121 @@ k = symbolVal (Proxy :: Proxy sym) instance (KnownSymbol sym, ToHttpApiData v, HasLink sub)- => HasLink (QueryParams sym v :> sub) where- type MkLink (QueryParams sym v :> sub) = [v] -> MkLink sub- toLink _ l =- toLink (Proxy :: Proxy 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) = Bool -> MkLink sub- toLink _ l False =- toLink (Proxy :: Proxy sub) l- toLink _ l True =- toLink (Proxy :: Proxy sub) $ addQueryParam (FlagParam k) l+ => 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) = MkLink a :<|> MkLink b- toLink _ l = toLink (Proxy :: Proxy a) l :<|> toLink (Proxy :: Proxy b) l+ 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) = MkLink sub- toLink _ = toLink (Proxy :: Proxy sub)+ 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) = v -> MkLink sub- toLink _ l v =- toLink (Proxy :: Proxy 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) = [v] -> MkLink sub- toLink _ l vs =- toLink (Proxy :: Proxy sub) $- foldl' (flip $ addSegment . escaped . Text.unpack . toUrlPiece) l vs+ => 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) = MkLink sub- toLink _ = toLink (Proxy :: Proxy sub)+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) = MkLink sub- toLink _ = toLink (Proxy :: Proxy sub)+ 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) = MkLink sub- toLink _ = toLink (Proxy :: Proxy sub)+ 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) = MkLink sub- toLink _ = toLink (Proxy :: Proxy sub)+ 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) = MkLink sub- toLink _ = toLink (Proxy :: Proxy sub)+ type MkLink (HttpVersion:> sub) a = MkLink sub a+ toLink = simpleToLink (Proxy :: Proxy sub) instance HasLink sub => HasLink (IsSecure :> sub) where- type MkLink (IsSecure :> sub) = MkLink sub- toLink _ = toLink (Proxy :: Proxy sub)+ 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) = MkLink sub- toLink _ = toLink (Proxy :: Proxy sub)+ 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) = MkLink sub- toLink _ = toLink (Proxy :: Proxy sub)+ 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) = MkLink sub- toLink _ = toLink (Proxy :: Proxy sub)+ type MkLink (BasicAuth realm a :> sub) r = MkLink sub r+ toLink = simpleToLink (Proxy :: Proxy sub) instance HasLink EmptyAPI where- type MkLink EmptyAPI = EmptyAPI- toLink _ _ = EmptyAPI+ 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) = Link- toLink _ = id+ type MkLink (Verb m s ct a) r = r+ toLink toA _ = toA instance HasLink Raw where- type MkLink Raw = Link- toLink _ = id+ type MkLink Raw a = a+ toLink toA _ = toA instance HasLink (Stream m fr ct a) where- type MkLink (Stream m fr ct a) = Link- toLink _ = id+ 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) = MkLink sub- toLink _ = toLink (Proxy :: Proxy sub)+ 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
test/Servant/Utils/LinksSpec.hs view
@@ -15,7 +15,7 @@ import Data.String (fromString) import Servant.API-import Servant.Utils.Links (allLinks, linkURI)+import Servant.Utils.Links import Servant.API.Internal.Test.ComprehensiveAPI (comprehensiveAPIWithoutRaw) type TestApi =@@ -41,7 +41,7 @@ apiLink :: (IsElem endpoint TestApi, HasLink endpoint)- => Proxy endpoint -> MkLink endpoint+ => Proxy endpoint -> MkLink endpoint Link apiLink = safeLink (Proxy :: Proxy TestApi) -- | Convert a link to a URI and ensure that this maps to the given string