summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorphadej <>2018-06-19 09:35:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-06-19 09:35:00 (GMT)
commit790def66ee34c117306861523b1bf78096a5bf1a (patch)
treeac68b837044122b1a3f5d78adb3a6e6c136bc6d4
parent99ae6b104c1f85a34e5fb26856f6ed55a0ed5a41 (diff)
version 0.140.14
-rw-r--r--CHANGELOG.md120
-rw-r--r--servant.cabal49
-rw-r--r--src/Servant/API.hs130
-rw-r--r--src/Servant/API/Alternative.hs8
-rw-r--r--src/Servant/API/BasicAuth.hs15
-rw-r--r--src/Servant/API/Capture.hs6
-rw-r--r--src/Servant/API/ContentTypes.hs36
-rw-r--r--src/Servant/API/Description.hs11
-rw-r--r--src/Servant/API/Empty.hs3
-rw-r--r--src/Servant/API/Experimental/Auth.hs9
-rw-r--r--src/Servant/API/Header.hs6
-rw-r--r--src/Servant/API/HttpVersion.hs3
-rw-r--r--src/Servant/API/Internal/Test/ComprehensiveAPI.hs3
-rw-r--r--src/Servant/API/IsSecure.hs6
-rw-r--r--src/Servant/API/Modifiers.hs14
-rw-r--r--src/Servant/API/QueryParam.hs8
-rw-r--r--src/Servant/API/Raw.hs4
-rw-r--r--src/Servant/API/RemoteHost.hs1
-rw-r--r--src/Servant/API/ReqBody.hs7
-rw-r--r--src/Servant/API/ResponseHeaders.hs76
-rw-r--r--src/Servant/API/Stream.hs79
-rw-r--r--src/Servant/API/Sub.hs3
-rw-r--r--src/Servant/API/TypeLevel.hs27
-rw-r--r--src/Servant/API/Vault.hs3
-rw-r--r--src/Servant/API/Verbs.hs21
-rw-r--r--src/Servant/API/WithNamedContext.hs4
-rw-r--r--src/Servant/Utils/Enter.hs7
-rw-r--r--src/Servant/Utils/Links.hs281
-rw-r--r--test/Servant/Utils/LinksSpec.hs4
29 files changed, 617 insertions, 327 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index b623704..79ceeb9 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -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
--------
diff --git a/servant.cabal b/servant.cabal
index ef3da37..6cf94bd 100644
--- a/servant.cabal
+++ b/servant.cabal
@@ -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 @@ category: Servant, Web
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 @@ custom-setup
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 @@ library
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 @@ test-suite spec
base
, base-compat
, aeson
- , attoparsec
, bytestring
, servant
, string-conversions
@@ -153,23 +152,23 @@ test-suite spec
-- 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
diff --git a/src/Servant/API.hs b/src/Servant/API.hs
index 7ed610f..4ae2b8e 100644
--- a/src/Servant/API.hs
+++ b/src/Servant/API.hs
@@ -66,71 +66,75 @@ module Servant.API (
-- * 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 (..))
diff --git a/src/Servant/API/Alternative.hs b/src/Servant/API/Alternative.hs
index a9acbb0..5f8e393 100644
--- a/src/Servant/API/Alternative.hs
+++ b/src/Servant/API/Alternative.hs
@@ -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
diff --git a/src/Servant/API/BasicAuth.hs b/src/Servant/API/BasicAuth.hs
index 307c21a..27544d4 100644
--- a/src/Servant/API/BasicAuth.hs
+++ b/src/Servant/API/BasicAuth.hs
@@ -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>.
diff --git a/src/Servant/API/Capture.hs b/src/Servant/API/Capture.hs
index 57317e7..9391fe1 100644
--- a/src/Servant/API/Capture.hs
+++ b/src/Servant/API/Capture.hs
@@ -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:
diff --git a/src/Servant/API/ContentTypes.hs b/src/Servant/API/ContentTypes.hs
index ea08300..797d058 100644
--- a/src/Servant/API/ContentTypes.hs
+++ b/src/Servant/API/ContentTypes.hs
@@ -71,32 +71,38 @@ module Servant.API.ContentTypes
, 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
diff --git a/src/Servant/API/Description.hs b/src/Servant/API/Description.hs
index fee0bc8..b799665 100644
--- a/src/Servant/API/Description.hs
+++ b/src/Servant/API/Description.hs
@@ -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 @@ module Servant.API.Description (
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.
--
diff --git a/src/Servant/API/Empty.hs b/src/Servant/API/Empty.hs
index efc7935..b8e05c1 100644
--- a/src/Servant/API/Empty.hs
+++ b/src/Servant/API/Empty.hs
@@ -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
diff --git a/src/Servant/API/Experimental/Auth.hs b/src/Servant/API/Experimental/Auth.hs
index fa79bfc..586b495 100644
--- a/src/Servant/API/Experimental/Auth.hs
+++ b/src/Servant/API/Experimental/Auth.hs
@@ -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.
diff --git a/src/Servant/API/Header.hs b/src/Servant/API/Header.hs
index ebee3a3..14562df 100644
--- a/src/Servant/API/Header.hs
+++ b/src/Servant/API/Header.hs
@@ -6,8 +6,10 @@ module Servant.API.Header (
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@.
diff --git a/src/Servant/API/HttpVersion.hs b/src/Servant/API/HttpVersion.hs
index 23b682b..3ad21b9 100644
--- a/src/Servant/API/HttpVersion.hs
+++ b/src/Servant/API/HttpVersion.hs
@@ -3,7 +3,8 @@ module Servant.API.HttpVersion
HttpVersion(..)
) where
-import Network.HTTP.Types (HttpVersion (..))
+import Network.HTTP.Types
+ (HttpVersion (..))
-- $httpversion
--
diff --git a/src/Servant/API/Internal/Test/ComprehensiveAPI.hs b/src/Servant/API/Internal/Test/ComprehensiveAPI.hs
index d6eb763..ed1b520 100644
--- a/src/Servant/API/Internal/Test/ComprehensiveAPI.hs
+++ b/src/Servant/API/Internal/Test/ComprehensiveAPI.hs
@@ -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
diff --git a/src/Servant/API/IsSecure.hs b/src/Servant/API/IsSecure.hs
index cbf1ab7..1c00cec 100644
--- a/src/Servant/API/IsSecure.hs
+++ b/src/Servant/API/IsSecure.hs
@@ -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?
--
diff --git a/src/Servant/API/Modifiers.hs b/src/Servant/API/Modifiers.hs
index f34f5bf..7979ac1 100644
--- a/src/Servant/API/Modifiers.hs
+++ b/src/Servant/API/Modifiers.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
@@ -19,10 +19,14 @@ module Servant.API.Modifiers (
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
diff --git a/src/Servant/API/QueryParam.hs b/src/Servant/API/QueryParam.hs
index ffa6605..45d0e7e 100644
--- a/src/Servant/API/QueryParam.hs
+++ b/src/Servant/API/QueryParam.hs
@@ -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
diff --git a/src/Servant/API/Raw.hs b/src/Servant/API/Raw.hs
index 4107771..0624298 100644
--- a/src/Servant/API/Raw.hs
+++ b/src/Servant/API/Raw.hs
@@ -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
diff --git a/src/Servant/API/RemoteHost.hs b/src/Servant/API/RemoteHost.hs
index e2de3a0..ab2e383 100644
--- a/src/Servant/API/RemoteHost.hs
+++ b/src/Servant/API/RemoteHost.hs
@@ -5,6 +5,7 @@ module Servant.API.RemoteHost
) where
import Data.Typeable
+ (Typeable)
-- | Provides access to the host or IP address
-- from which the HTTP request was sent.
diff --git a/src/Servant/API/ReqBody.hs b/src/Servant/API/ReqBody.hs
index 512b77c..e8dd796 100644
--- a/src/Servant/API/ReqBody.hs
+++ b/src/Servant/API/ReqBody.hs
@@ -6,8 +6,9 @@ module Servant.API.ReqBody (
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 @@ import Servant.API.Modifiers
-- >>> type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book
type ReqBody = ReqBody' '[Required, Strict]
--- |
+-- |
--
-- /Note:/ 'ReqBody'' is always 'Required'.
data ReqBody' (mods :: [*]) (contentTypes :: [*]) (a :: *)
diff --git a/src/Servant/API/ResponseHeaders.hs b/src/Servant/API/ResponseHeaders.hs
index ff867bc..a0036c9 100644
--- a/src/Servant/API/ResponseHeaders.hs
+++ b/src/Servant/API/ResponseHeaders.hs
@@ -34,18 +34,22 @@ module Servant.API.ResponseHeaders
, 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 Servant.API.Header (Header)
-import Prelude ()
+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 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 @@ instance OVERLAPPABLE_ ( FromHttpApiData v, BuildHeadersTo xs, KnownSymbol h )
class GetHeaders ls where
getHeaders :: ls -> [HTTP.Header]
-instance OVERLAPPING_ GetHeaders (HList '[]) where
- getHeaders _ = []
-
-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 OVERLAPPING_ GetHeaders (Headers '[] a) where
- getHeaders _ = []
-
-instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToHttpApiData v )
- => GetHeaders (Headers (Header h v ': rest) a) where
- getHeaders hs = getHeaders $ getHeadersHList hs
+-- | Auxiliary class for @'GetHeaders' ('HList' hs)@ instance
+class GetHeadersFromHList hs where
+ getHeadersFromHList :: HList hs -> [HTTP.Header]
+
+instance GetHeadersFromHList hs => GetHeaders (HList hs) where
+ getHeaders = getHeadersFromHList
+
+instance GetHeadersFromHList '[] where
+ getHeadersFromHList _ = []
+
+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
diff --git a/src/Servant/API/Stream.hs b/src/Servant/API/Stream.hs
index 1a079e6..6a44eae 100644
--- a/src/Servant/API/Stream.hs
+++ b/src/Servant/API/Stream.hs
@@ -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 (..))
-
--- | 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 :: *)
+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. 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 @@ data ByteStringParser a = ByteStringParser {
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).
diff --git a/src/Servant/API/Sub.hs b/src/Servant/API/Sub.hs
index 45beac4..da0cfb3 100644
--- a/src/Servant/API/Sub.hs
+++ b/src/Servant/API/Sub.hs
@@ -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).
diff --git a/src/Servant/API/TypeLevel.hs b/src/Servant/API/TypeLevel.hs
index 3cb8076..70968e4 100644
--- a/src/Servant/API/TypeLevel.hs
+++ b/src/Servant/API/TypeLevel.hs
@@ -47,16 +47,25 @@ module Servant.API.TypeLevel (
) 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
diff --git a/src/Servant/API/Vault.hs b/src/Servant/API/Vault.hs
index 7b0a097..fae04c5 100644
--- a/src/Servant/API/Vault.hs
+++ b/src/Servant/API/Vault.hs
@@ -3,7 +3,8 @@ module Servant.API.Vault
Vault
) where
-import Data.Vault.Lazy (Vault)
+import Data.Vault.Lazy
+ (Vault)
-- $vault
--
diff --git a/src/Servant/API/Verbs.hs b/src/Servant/API/Verbs.hs
index d1e1d6e..a82e8a0 100644
--- a/src/Servant/API/Verbs.hs
+++ b/src/Servant/API/Verbs.hs
@@ -8,15 +8,18 @@ module Servant.API.Verbs
, 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
diff --git a/src/Servant/API/WithNamedContext.hs b/src/Servant/API/WithNamedContext.hs
index e467ea4..ef157f7 100644
--- a/src/Servant/API/WithNamedContext.hs
+++ b/src/Servant/API/WithNamedContext.hs
@@ -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@,
diff --git a/src/Servant/Utils/Enter.hs b/src/Servant/Utils/Enter.hs
index 208e0d2..80c073c 100644
--- a/src/Servant/Utils/Enter.hs
+++ b/src/Servant/Utils/Enter.hs
@@ -13,7 +13,6 @@ module Servant.Utils.Enter {-# DEPRECATED "Use hoistServer or hoistServerWithCon
(:~>)(..),
) 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.Lazy as LState
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
diff --git a/src/Servant/Utils/Links.hs b/src/Servant/Utils/Links.hs
index 37098f0..5002bcc 100644
--- a/src/Servant/Utils/Links.hs
+++ b/src/Servant/Utils/Links.hs
@@ -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 @@ module Servant.Utils.Links (
--
-- | 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 @@ module Servant.Utils.Links (
) 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,8 +290,18 @@ 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
-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.
--
@@ -268,37 +317,47 @@ safeLink _ endpoint = toLink endpoint (Link mempty mempty)
--
-- 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 @@ instance (KnownSymbol sym, ToHttpApiData v, HasLink sub, SBoolI (FoldRequired mo
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
diff --git a/test/Servant/Utils/LinksSpec.hs b/test/Servant/Utils/LinksSpec.hs
index 2629ce1..1ebb0fc 100644
--- a/test/Servant/Utils/LinksSpec.hs
+++ b/test/Servant/Utils/LinksSpec.hs
@@ -15,7 +15,7 @@ import Test.Hspec (Expectation, Spec, describe, it,
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 @@ type LinkableApi =
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