eeva
/
servant
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Add description modifier helpers and parametrise Capture

This commit is contained in:
Oleg Grenrus 2018-02-09 12:05:30 +02:00
parent e8e62d6d99
commit 3e1748c965
10 changed files with 73 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs
View File

@ -34,7 +34,7 @@ import Servant.API ((:<|>) ((:<|>)), (:>),
BuildHeadersTo (..),
BuildFromStream (..),
ByteStringParser (..),
Capture, CaptureAll,
Capture', CaptureAll,
Description, EmptyAPI,
FramingUnrender (..),
Header', Headers (..),
@ -155,9 +155,9 @@ instance RunClient m => HasClient m EmptyAPI where
-- > getBook = client myApi
-- > -- then you can just use "getBook" to query that endpoint
instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
=> HasClient m (Capture capture a :> api) where
=> HasClient m (Capture' mods capture a :> api) where
type Client m (Capture capture a :> api) =
type Client m (Capture' mods capture a :> api) =
a -> Client m api
clientWithRoute pm Proxy req val =

2
servant-docs/src/Servant/Docs/Internal.hs
View File

@ -795,7 +795,7 @@ instance HasDocs EmptyAPI where
-- | @"books" :> 'Capture' "isbn" Text@ will appear as
-- @/books/:isbn@ in the docs.
instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
=> HasDocs (Capture sym a :> api) where
=> HasDocs (Capture' mods sym a :> api) where
docsFor Proxy (endpoint, action) =
docsFor subApiP (endpoint', action')

4
servant-foreign/src/Servant/Foreign/Internal.hs
View File

@ -195,8 +195,8 @@ instance HasForeign lang ftype EmptyAPI where
foreignFor Proxy Proxy Proxy _ = EmptyForeignAPI
instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype api)
=> HasForeign lang ftype (Capture sym t :> api) where
type Foreign ftype (Capture sym t :> api) = Foreign ftype api
=> HasForeign lang ftype (Capture' mods sym t :> api) where
type Foreign ftype (Capture' mods sym t :> api) = Foreign ftype api
foreignFor lang Proxy Proxy req =
foreignFor lang Proxy (Proxy :: Proxy api) $

14
servant-server/src/Servant/Server/Internal.hs
View File

@ -67,7 +67,7 @@ import Web.HttpApiData (FromHttpApiData, parseHeader,
parseQueryParam,
parseUrlPieceMaybe,
parseUrlPieces)
import Servant.API ((:<|>) (..), (:>), BasicAuth, Capture,
import Servant.API ((:<|>) (..), (:>), BasicAuth, Capture',
CaptureAll, Verb, EmptyAPI,
ReflectMethod(reflectMethod),
IsSecure(..), Header', QueryFlag,
@ -164,9 +164,9 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont
-- > where getBook :: Text -> Handler Book
-- > getBook isbn = ...
instance (KnownSymbol capture, FromHttpApiData a, HasServer api context)
=> HasServer (Capture capture a :> api) context where
=> HasServer (Capture' mods capture a :> api) context where
type ServerT (Capture capture a :> api) m =
type ServerT (Capture' mods capture a :> api) m =
a -> ServerT api m
hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s
@ -749,14 +749,14 @@ instance (HasContextEntry context (NamedContext name subContext), HasServer subA
-- ...
-- ...Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'.
-- ...Maybe you haven't applied enough arguments to
-- ...Capture "foo"
-- ...Capture' '[] "foo"
-- ...
--
-- >>> undefined :: Server (Capture "foo" :> Get '[JSON] Int)
-- ...
-- ...Expected something of kind Symbol or *, got: k -> l on the LHS of ':>'.
-- ...Maybe you haven't applied enough arguments to
-- ...Capture "foo"
-- ...Capture' '[] "foo"
-- ...
--
instance TypeError (HasServerArrowKindError arr) => HasServer ((arr :: k -> l) :> api) context
@ -778,7 +778,7 @@ type HasServerArrowKindError arr =
-- ...
-- ...No instance HasServer (a -> b).
-- ...Maybe you have used '->' instead of ':>' between
-- ...Capture "foo" Int
-- ...Capture' '[] "foo" Int
-- ...and
-- ...Verb 'GET 200 '[JSON] Int
-- ...
@ -787,7 +787,7 @@ type HasServerArrowKindError arr =
-- ...
-- ...No instance HasServer (a -> b).
-- ...Maybe you have used '->' instead of ':>' between
-- ...Capture "foo" Int
-- ...Capture' '[] "foo" Int
-- ...and
-- ...Verb 'GET 200 '[JSON] Int
-- ...

6
servant/CHANGELOG.md
View File

@ -18,12 +18,16 @@
- [Querying an API - Querying Streaming APIs](http://haskell-servant.readthedocs.io/en/release-0.13/tutorial/Client.html#querying-streaming-apis)
- *servant* Add `Servant.API.Modifiers`
([#873](https://github.com/haskell-servant/servant/pull/873))
([#873](https://github.com/haskell-servant/servant/pull/873)
[#903](https://github.com/haskell-servant/servant/pull/903))
`QueryParam`, `Header` and `ReqBody` understand modifiers:
- `Required` or `Optional` (resulting in `a` or `Maybe a` in handlers)
- `Strict` or `Lenient` (resulting in `a` or `Either String a` in handlers)
Also you can use `Description` as a modifier, but it doesn't yet work
with `servant-docs`, only `servant-swagger`. [There is an issue.](https://github.com/haskell-servant/servant/issues/902)
- *servant-client* Support `http-client`’s `CookieJar`
([#897](https://github.com/haskell-servant/servant/pull/897)
[#883](https://github.com/haskell-servant/servant/pull/883))

2
servant/src/Servant/API.hs
View File

@ -74,7 +74,7 @@ module Servant.API (
import Servant.API.Alternative ((:<|>) (..))
import Servant.API.BasicAuth (BasicAuth,BasicAuthData(..))
import Servant.API.Capture (Capture, CaptureAll)
import Servant.API.Capture (Capture, Capture', CaptureAll)
import Servant.API.ContentTypes (Accept (..), FormUrlEncoded,
JSON,
MimeRender (..), NoContent (NoContent),

8
servant/src/Servant/API/Capture.hs
View File

@ -2,7 +2,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE PolyKinds #-}
{-# OPTIONS_HADDOCK not-home #-}
module Servant.API.Capture (Capture, CaptureAll) where
module Servant.API.Capture (Capture, Capture', CaptureAll) where
import Data.Typeable (Typeable)
import GHC.TypeLits (Symbol)
@ -12,9 +12,11 @@ import GHC.TypeLits (Symbol)
--
-- >>> -- GET /books/:isbn
-- >>> type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
data Capture (sym :: Symbol) (a :: *)
deriving (Typeable)
type Capture = Capture' '[] -- todo
-- | 'Capture' which can be modified. For example with 'Description'.
data Capture' (mods :: [*]) (sym :: Symbol) (a :: *)
deriving (Typeable)
-- | Capture all remaining values from the request path under a certain type
-- @a@.

50
servant/src/Servant/API/Description.hs
View File

@ -1,11 +1,25 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_HADDOCK not-home #-}
module Servant.API.Description (Description, Summary) where
module Servant.API.Description (
-- * Combinators
Description,
Summary,
-- * Used as modifiers
FoldDescription,
FoldDescription',
reflectDescription,
) where
import Data.Typeable (Typeable)
import GHC.TypeLits (Symbol)
import GHC.TypeLits (Symbol, KnownSymbol, symbolVal)
import Data.Proxy (Proxy (..))
-- | Add a short summary for (part of) API.
--
-- Example:
@ -29,6 +43,32 @@ data Summary (sym :: Symbol)
data Description (sym :: Symbol)
deriving (Typeable)
-- | Fold modifier list to decide whether argument should be parsed strictly or leniently.
--
-- >>> :kind! FoldDescription '[]
-- FoldDescription '[] :: Symbol
-- = ""
--
-- >>> :kind! FoldDescription '[Required, Description "foobar", Lenient]
-- FoldDescription '[Required, Description "foobar", Lenient] :: Symbol
-- = "foobar"
--
type FoldDescription mods = FoldDescription' "" mods
-- | Implementation of 'FoldDescription'.
type family FoldDescription' (acc :: Symbol) (mods :: [*]) :: Symbol where
FoldDescription' acc '[] = acc
FoldDescription' acc (Description desc ': mods) = FoldDescription' desc mods
FoldDescription' acc (mod ': mods) = FoldDescription' acc mods
-- | Reflect description to the term level.
--
-- >>> reflectDescription (Proxy :: Proxy '[Required, Description "foobar", Lenient])
-- "foobar"
--
reflectDescription :: forall mods. KnownSymbol (FoldDescription mods) => Proxy mods -> String
reflectDescription _ = symbolVal (Proxy :: Proxy (FoldDescription mods))
-- $setup
-- >>> import Servant.API
-- >>> import Data.Aeson

2
servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs
View File

@ -22,7 +22,7 @@ comprehensiveAPI = Proxy
type ComprehensiveAPIWithoutRaw =
GET :<|>
Get '[JSON] Int :<|>
Capture "foo" Int :> GET :<|>
Capture' '[Description "example description"] "foo" Int :> GET :<|>
Header "foo" Int :> GET :<|>
Header' '[Required, Lenient] "bar" Int :> GET :<|>
HttpVersion :> GET :<|>

6
servant/src/Servant/Utils/Links.hs
View File

@ -115,7 +115,7 @@ import Prelude.Compat
import Web.HttpApiData
import Servant.API.Alternative ( (:<|>)((:<|>)) )
import Servant.API.BasicAuth ( BasicAuth )
import Servant.API.Capture ( Capture, CaptureAll )
import Servant.API.Capture ( Capture', CaptureAll )
import Servant.API.ReqBody ( ReqBody' )
import Servant.API.QueryParam ( QueryParam', QueryParams, QueryFlag )
import Servant.API.Header ( Header' )
@ -336,8 +336,8 @@ instance HasLink sub => HasLink (ReqBody' mods ct a :> sub) where
toLink _ = toLink (Proxy :: Proxy sub)
instance (ToHttpApiData v, HasLink sub)
=> HasLink (Capture sym v :> sub) where
type MkLink (Capture sym v :> sub) = v -> MkLink 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) $
addSegment (escaped . Text.unpack $ toUrlPiece v) l