Merge servant-generic
This commit is contained in:
Oleg Grenrus
parent
374a7b88fb
commit
88f8d3b0d1
|
|
@ -12,6 +12,7 @@ packages: servant/
|
|||
doc/cookbook/db-postgres-pool
|
||||
doc/cookbook/db-sqlite-simple
|
||||
doc/cookbook/file-upload
|
||||
doc/cookbook/generic
|
||||
doc/cookbook/https
|
||||
doc/cookbook/jwt-and-basic-auth
|
||||
doc/cookbook/pagination
|
||||
|
|
|
|||
|
|
@ -0,0 +1,106 @@
|
|||
# Using generics
|
||||
|
||||
```haskell
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
module Main (main, api, getLink, routesLinks, cliGet) where
|
||||
|
||||
import Control.Exception (throwIO)
|
||||
import Data.Proxy (Proxy (..))
|
||||
import Network.Wai.Handler.Warp (run)
|
||||
import System.Environment (getArgs)
|
||||
|
||||
import Servant
|
||||
import Servant.Client
|
||||
|
||||
import Servant.API.Generic
|
||||
import Servant.Client.Generic
|
||||
import Servant.Server.Generic
|
||||
```
|
||||
|
||||
The usage is simple, if you only need a collection of routes.
|
||||
First you define a record with field types prefixed by a parameter `route`:
|
||||
|
||||
```haskell
|
||||
data Routes route = Routes
|
||||
{ _get :: route :- Capture "id" Int :> Get '[JSON] String
|
||||
, _put :: route :- ReqBody '[JSON] Int :> Put '[JSON] Bool
|
||||
}
|
||||
deriving (Generic)
|
||||
```
|
||||
|
||||
Then we'll use this data type to define API, links, server and client.
|
||||
|
||||
## API
|
||||
|
||||
You can get a `Proxy` of the API using `genericApi`:
|
||||
|
||||
```haskell
|
||||
api :: Proxy (ToServantApi Routes)
|
||||
api = genericApi (Proxy :: Proxy Routes)
|
||||
```
|
||||
|
||||
It's recommented to use `genericApi` function, as then you'll get
|
||||
better error message, for example if you forget to `derive Generic`.
|
||||
|
||||
## Links
|
||||
|
||||
The clear advantage of record-based generics approach, is that
|
||||
we can get safe links very conviently. We don't need to define endpoint types,
|
||||
as field accessors work as proxies:
|
||||
|
||||
```haskell
|
||||
getLink :: Int -> Link
|
||||
getLink = fieldLink _get
|
||||
```
|
||||
|
||||
We can also get all links at once, as a record:
|
||||
|
||||
```haskell
|
||||
routesLinks :: Routes (AsLink Link)
|
||||
routesLinks = allFieldLinks
|
||||
```
|
||||
|
||||
## Client
|
||||
|
||||
Even more power starts to show when we generate a record of client functions.
|
||||
Here we use `genericClientHoist` function, which let us simultaneously
|
||||
hoist the monad, in this case from `ClientM` to `IO`.
|
||||
|
||||
```haskell
|
||||
cliRoutes :: Routes (AsClientT IO)
|
||||
cliRoutes = genericClientHoist
|
||||
(\x -> runClientM x env >>= either throwIO return)
|
||||
where
|
||||
env = error "undefined environment"
|
||||
|
||||
cliGet :: Int -> IO String
|
||||
cliGet = _get cliRoutes
|
||||
```
|
||||
|
||||
## Server
|
||||
|
||||
Finally, probably the most handy usage: we can convert record of handlers into
|
||||
the server implementation:
|
||||
|
||||
```haskell
|
||||
record :: Routes AsServer
|
||||
record = Routes
|
||||
{ _get = return . show
|
||||
, _put = return . odd
|
||||
}
|
||||
|
||||
app :: Application
|
||||
app = genericServe record
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- getArgs
|
||||
case args of
|
||||
("run":_) -> do
|
||||
putStrLn "Starting cookbook-generic at http://localhost:8000"
|
||||
run 8000 app
|
||||
_ -> putStrLn "To run, pass 'run' argument: cabal new-run cookbook-generic run"
|
||||
```
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
name: cookbook-generic
|
||||
version: 0.1
|
||||
synopsis: Using custom monad to pass a state between handlers
|
||||
homepage: http://haskell-servant.readthedocs.org/
|
||||
license: BSD3
|
||||
license-file: ../../../servant/LICENSE
|
||||
author: Servant Contributors
|
||||
maintainer: haskell-servant-maintainers@googlegroups.com
|
||||
build-type: Simple
|
||||
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.3
|
||||
|
||||
executable cookbook-using-custom-monad
|
||||
main-is: Generic.lhs
|
||||
build-depends: base == 4.*
|
||||
, servant
|
||||
, servant-client
|
||||
, servant-client-core
|
||||
, servant-server
|
||||
, base-compat
|
||||
, warp >= 3.2
|
||||
, transformers >= 0.3
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall -pgmL markdown-unlit
|
||||
build-tool-depends: markdown-unlit:markdown-unlit >= 0.4
|
||||
|
|
@ -75,8 +75,8 @@ library
|
|||
, time >= 1.4.2 && < 1.9
|
||||
|
||||
-- For legacy tools, we need to specify build-depends too
|
||||
build-depends: markdown-unlit >= 0.4.1 && <0.5
|
||||
build-tool-depends: markdown-unlit:markdown-unlit >= 0.4.1 && <0.5
|
||||
build-depends: markdown-unlit >= 0.5.0 && <0.6
|
||||
build-tool-depends: markdown-unlit:markdown-unlit >= 0.5.0 && <0.6
|
||||
|
||||
test-suite spec
|
||||
type: exitcode-stdio-1.0
|
||||
|
|
|
|||
|
|
@ -1,6 +1,14 @@
|
|||
[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client-core/CHANGELOG.md)
|
||||
[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
|
||||
|
||||
0.14.1
|
||||
------
|
||||
|
||||
- Merge in `servant-generic` (by [Patrick Chilton](https://github.com/chpatrick))
|
||||
into `servant` (`Servant.API.Generic`),
|
||||
`servant-client-code` (`Servant.Client.Generic`)
|
||||
and `servant-server` (`Servant.Server.Generic`).
|
||||
|
||||
0.14
|
||||
----
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
name: servant-client-core
|
||||
version: 0.14
|
||||
version: 0.14.1
|
||||
synopsis: Core functionality and class for client function generation for servant APIs
|
||||
description:
|
||||
This library provides backend-agnostic generation of client functions. For
|
||||
|
|
@ -33,6 +33,7 @@ library
|
|||
exposed-modules:
|
||||
Servant.Client.Core
|
||||
Servant.Client.Free
|
||||
Servant.Client.Generic
|
||||
Servant.Client.Core.Reexport
|
||||
Servant.Client.Core.Internal.Auth
|
||||
Servant.Client.Core.Internal.BaseUrl
|
||||
|
|
@ -60,7 +61,7 @@ library
|
|||
|
||||
-- Servant dependencies
|
||||
build-depends:
|
||||
servant == 0.14.*
|
||||
servant >= 0.14.1 && <0.15
|
||||
|
||||
-- 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.
|
||||
|
|
|
|||
|
|
@ -0,0 +1,51 @@
|
|||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
module Servant.Client.Generic (
|
||||
AsClientT,
|
||||
genericClient,
|
||||
genericClientHoist,
|
||||
) where
|
||||
|
||||
import Data.Proxy
|
||||
(Proxy (..))
|
||||
|
||||
import Servant.API.Generic
|
||||
import Servant.Client.Core
|
||||
|
||||
-- | A type that specifies that an API reocrd contains a client implementation.
|
||||
data AsClientT (m :: * -> *)
|
||||
instance GenericMode (AsClientT m) where
|
||||
type AsClientT m :- api = Client m api
|
||||
|
||||
-- | Generate a record of client functions.
|
||||
genericClient
|
||||
:: forall routes m.
|
||||
( HasClient m (ToServantApi routes)
|
||||
, GenericServant routes (AsClientT m)
|
||||
, Client m (ToServantApi routes) ~ ToServant routes (AsClientT m)
|
||||
)
|
||||
=> routes (AsClientT m)
|
||||
genericClient
|
||||
= fromServant
|
||||
$ clientIn (Proxy :: Proxy (ToServantApi routes)) (Proxy :: Proxy m)
|
||||
|
||||
-- | 'genericClient' but with 'hoistClientMonad' in between.
|
||||
genericClientHoist
|
||||
:: forall routes m n.
|
||||
( HasClient m (ToServantApi routes)
|
||||
, GenericServant routes (AsClientT n)
|
||||
, Client n (ToServantApi routes) ~ ToServant routes (AsClientT n)
|
||||
)
|
||||
=> (forall x. m x -> n x) -- ^ natural transformation
|
||||
-> routes (AsClientT n)
|
||||
genericClientHoist nt
|
||||
= fromServant
|
||||
$ hoistClientMonad m api nt
|
||||
$ clientIn api m
|
||||
where
|
||||
m = Proxy :: Proxy m
|
||||
api = Proxy :: Proxy (ToServantApi routes)
|
||||
|
|
@ -1,6 +1,16 @@
|
|||
[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-server/CHANGELOG.md)
|
||||
[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
|
||||
|
||||
0.14.1
|
||||
------
|
||||
|
||||
- Merge in `servant-generic` (by [Patrick Chilton](https://github.com/chpatrick))
|
||||
into `servant` (`Servant.API.Generic`),
|
||||
`servant-client-code` (`Servant.Client.Generic`)
|
||||
and `servant-server` (`Servant.Server.Generic`).
|
||||
|
||||
- *servant-server* Deprecate `Servant.Utils.StaticUtils`, use `Servant.Server.StaticUtils`.
|
||||
|
||||
0.14
|
||||
----
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
name: servant-server
|
||||
version: 0.14
|
||||
version: 0.14.1
|
||||
synopsis: A family of combinators for defining webservices APIs and serving them
|
||||
description:
|
||||
A family of combinators for defining webservices APIs and serving them
|
||||
|
|
@ -47,6 +47,7 @@ library
|
|||
Servant
|
||||
Servant.Server
|
||||
Servant.Server.Experimental.Auth
|
||||
Servant.Server.Generic
|
||||
Servant.Server.Internal
|
||||
Servant.Server.Internal.BasicAuth
|
||||
Servant.Server.Internal.Context
|
||||
|
|
@ -79,7 +80,7 @@ library
|
|||
|
||||
-- Servant dependencies
|
||||
build-depends:
|
||||
servant == 0.14.*
|
||||
servant >= 0.14.1 && <0.15
|
||||
|
||||
-- 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.
|
||||
|
|
|
|||
|
|
@ -0,0 +1,52 @@
|
|||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
-- | @since 0.14.1
|
||||
module Servant.Server.Generic (
|
||||
AsServerT,
|
||||
AsServer,
|
||||
genericServe,
|
||||
genericServer,
|
||||
genericServerT,
|
||||
) where
|
||||
|
||||
import Data.Proxy
|
||||
(Proxy (..))
|
||||
|
||||
import Servant.API.Generic
|
||||
import Servant.Server
|
||||
|
||||
-- | A type that specifies that an API record contains a server implementation.
|
||||
data AsServerT (m :: * -> *)
|
||||
instance GenericMode (AsServerT m) where
|
||||
type AsServerT m :- api = ServerT api m
|
||||
|
||||
type AsServer = AsServerT Handler
|
||||
|
||||
-- | Transform record of routes into a WAI 'Application'.
|
||||
genericServe
|
||||
:: forall routes.
|
||||
( HasServer (ToServantApi routes) '[]
|
||||
, GenericServant routes AsServer
|
||||
, Server (ToServantApi routes) ~ ToServant routes AsServer
|
||||
)
|
||||
=> routes AsServer -> Application
|
||||
genericServe = serve (Proxy :: Proxy (ToServantApi routes)) . genericServer
|
||||
|
||||
-- | Transform record of endpoints into a 'Server'.
|
||||
genericServer
|
||||
:: GenericServant routes AsServer
|
||||
=> routes AsServer
|
||||
-> ToServant routes AsServer
|
||||
genericServer = toServant
|
||||
|
||||
genericServerT
|
||||
:: GenericServant routes (AsServerT m)
|
||||
=> routes (AsServerT m)
|
||||
-> ToServant routes (AsServerT m)
|
||||
genericServerT = toServant
|
||||
|
|
@ -1,5 +1,18 @@
|
|||
[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
|
||||
|
||||
0.14.1
|
||||
------
|
||||
|
||||
- Merge in (and slightly refactor) `servant-generic`
|
||||
(by [Patrick Chilton](https://github.com/chpatrick))
|
||||
into `servant` (`Servant.API.Generic`),
|
||||
`servant-client-code` (`Servant.Client.Generic`)
|
||||
and `servant-server` (`Servant.Server.Generic`).
|
||||
|
||||
- Deprecate `Servant.Utils.Links`, use `Servant.Links`.
|
||||
|
||||
- *servant-server* Deprecate `Servant.Utils.StaticUtils`, use `Servant.Server.StaticUtils`.
|
||||
|
||||
0.14
|
||||
----
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
name: servant
|
||||
version: 0.14
|
||||
version: 0.14.1
|
||||
synopsis: A family of combinators for defining webservices APIs
|
||||
description:
|
||||
A family of combinators for defining webservices APIs and serving them
|
||||
|
|
@ -46,6 +46,7 @@ library
|
|||
Servant.API.Description
|
||||
Servant.API.Empty
|
||||
Servant.API.Experimental.Auth
|
||||
Servant.API.Generic
|
||||
Servant.API.Header
|
||||
Servant.API.HttpVersion
|
||||
Servant.API.Internal.Test.ComprehensiveAPI
|
||||
|
|
|
|||
|
|
@ -0,0 +1,146 @@
|
|||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
-- | Define servant servers from record types. Generics for the win.
|
||||
--
|
||||
-- The usage is simple, if you only need a collection of routes. First you
|
||||
-- define a record with field types prefixed by a parameter `route`:
|
||||
--
|
||||
-- @
|
||||
-- data Routes route = Routes
|
||||
-- { _get :: route :- Capture "id" Int :> Get '[JSON] String
|
||||
-- , _put :: route :- ReqBody '[JSON] Int :> Put '[JSON] Bool
|
||||
-- }
|
||||
-- deriving ('Generic')
|
||||
-- @
|
||||
--
|
||||
-- You can get a 'Proxy' of the server using
|
||||
--
|
||||
-- @
|
||||
-- api :: Proxy (ToServantApi Routes)
|
||||
-- api = genericApi (Proxy :: Proxy Routes)
|
||||
-- @
|
||||
--
|
||||
-- Using 'genericApi' is better as it checks that instances exists,
|
||||
-- i.e. you get better error messages than simply using 'Proxy' value.
|
||||
--
|
||||
-- __Note:__ in 0.14 series this module isn't re-exported from 'Servant.API'.
|
||||
--
|
||||
-- "Servant.API.Generic" is based on @servant-generic@ package by
|
||||
-- [Patrick Chilton](https://github.com/chpatrick)
|
||||
--
|
||||
-- @since 0.14.1
|
||||
module Servant.API.Generic (
|
||||
GenericMode (..),
|
||||
GenericServant,
|
||||
ToServant,
|
||||
toServant,
|
||||
fromServant,
|
||||
-- * AsApi
|
||||
AsApi,
|
||||
ToServantApi,
|
||||
genericApi,
|
||||
-- * Utility
|
||||
GServantProduct,
|
||||
-- * re-exports
|
||||
Generic (Rep),
|
||||
) where
|
||||
|
||||
-- Based on servant-generic licensed under MIT License
|
||||
--
|
||||
-- Copyright (c) 2017 Patrick Chilton
|
||||
--
|
||||
-- Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
-- of this software and associated documentation files (the "Software"), to deal
|
||||
-- in the Software without restriction, including without limitation the rights
|
||||
-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
|
||||
-- copies of the Software, and to permit persons to whom the Software is
|
||||
-- furnished to do so, subject to the following conditions:
|
||||
--
|
||||
-- The above copyright notice and this permission notice shall be included in all
|
||||
-- copies or substantial portions of the Software.
|
||||
--
|
||||
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||
-- SOFTWARE.
|
||||
|
||||
import Data.Proxy
|
||||
(Proxy (..))
|
||||
import GHC.Generics
|
||||
((:*:) (..), Generic (..), K1 (..), M1 (..))
|
||||
|
||||
import Servant.API.Alternative
|
||||
|
||||
-- | A constraint alias, for work with 'mode' and 'routes'.
|
||||
type GenericServant routes mode = (GenericMode mode, Generic (routes mode), GServantProduct (Rep (routes mode)))
|
||||
|
||||
-- | A class with a type family that applies an appropriate type family to the @api@
|
||||
-- parameter. For example, 'AsApi' will leave @api@ untouched, while
|
||||
-- @'AsServerT' m@ will produce @'ServerT' api m@.
|
||||
class GenericMode mode where
|
||||
type mode :- api :: *
|
||||
|
||||
infixl 0 :-
|
||||
|
||||
-- | Turns a generic product type into a tree of `:<|>` combinators.
|
||||
type ToServant routes mode = GToServant (Rep (routes mode))
|
||||
|
||||
type ToServantApi routes = ToServant routes AsApi
|
||||
|
||||
-- | See `ToServant`, but at value-level.
|
||||
toServant
|
||||
:: GenericServant routes mode
|
||||
=> routes mode -> ToServant routes mode
|
||||
toServant = gtoServant . from
|
||||
|
||||
-- | Inverse of `toServant`.
|
||||
--
|
||||
-- This can be used to turn 'generated' values such as client functions into records.
|
||||
--
|
||||
-- You may need to provide a type signature for the /output/ type (your record type).
|
||||
fromServant
|
||||
:: GenericServant routes mode
|
||||
=> ToServant routes mode -> routes mode
|
||||
fromServant = to . gfromServant
|
||||
|
||||
-- | A type that specifies that an API record contains an API definition. Only useful at type-level.
|
||||
data AsApi
|
||||
instance GenericMode AsApi where
|
||||
type AsApi :- api = api
|
||||
|
||||
-- | Get a 'Proxy' of an API type.
|
||||
genericApi
|
||||
:: GenericServant routes AsApi
|
||||
=> Proxy routes
|
||||
-> Proxy (ToServantApi routes)
|
||||
genericApi _ = Proxy
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Class
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
|
||||
class GServantProduct f where
|
||||
type GToServant f
|
||||
gtoServant :: f p -> GToServant f
|
||||
gfromServant :: GToServant f -> f p
|
||||
|
||||
instance GServantProduct f => GServantProduct (M1 i c f) where
|
||||
type GToServant (M1 i c f) = GToServant f
|
||||
gtoServant = gtoServant . unM1
|
||||
gfromServant = M1 . gfromServant
|
||||
|
||||
instance (GServantProduct l, GServantProduct r) => GServantProduct (l :*: r) where
|
||||
type GToServant (l :*: r) = GToServant l :<|> GToServant r
|
||||
gtoServant (l :*: r) = gtoServant l :<|> gtoServant r
|
||||
gfromServant (l :<|> r) = gfromServant l :*: gfromServant r
|
||||
|
||||
instance GServantProduct (K1 i c) where
|
||||
type GToServant (K1 i c) = c
|
||||
gtoServant = unK1
|
||||
gfromServant = K1
|
||||
|
|
@ -91,6 +91,8 @@
|
|||
-- This error is essentially saying that the type family couldn't find
|
||||
-- bad_link under api after trying the open (but empty) type family
|
||||
-- `IsElem'` as a last resort.
|
||||
--
|
||||
-- @since 0.14.1
|
||||
module Servant.Links (
|
||||
module Servant.API.TypeLevel,
|
||||
|
||||
|
|
@ -102,6 +104,12 @@ module Servant.Links (
|
|||
, allLinks
|
||||
, allLinks'
|
||||
, URI(..)
|
||||
-- * Generics
|
||||
, AsLink
|
||||
, fieldLink
|
||||
, fieldLink'
|
||||
, allFieldLinks
|
||||
, allFieldLinks'
|
||||
-- * Adding custom types
|
||||
, HasLink(..)
|
||||
, Link
|
||||
|
|
@ -144,6 +152,7 @@ import Servant.API.Empty
|
|||
(EmptyAPI (..))
|
||||
import Servant.API.Experimental.Auth
|
||||
(AuthProtect)
|
||||
import Servant.API.Generic
|
||||
import Servant.API.Header
|
||||
(Header')
|
||||
import Servant.API.HttpVersion
|
||||
|
|
@ -334,6 +343,83 @@ allLinks'
|
|||
-> MkLink api a
|
||||
allLinks' toA api = toLink toA api (Link mempty mempty)
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Generics
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
-- | Given an API record field, create a link for that route. Only the field's
|
||||
-- type is used.
|
||||
--
|
||||
-- @
|
||||
-- data Record route = Record
|
||||
-- { _get :: route :- Capture "id" Int :> Get '[JSON] String
|
||||
-- , _put :: route :- ReqBody '[JSON] Int :> Put '[JSON] Bool
|
||||
-- }
|
||||
-- deriving ('Generic')
|
||||
--
|
||||
-- getLink :: Int -> Link
|
||||
-- getLink = 'fieldLink' _get
|
||||
-- @
|
||||
--
|
||||
-- @since 0.14.1
|
||||
fieldLink
|
||||
:: ( IsElem endpoint (ToServantApi routes), HasLink endpoint
|
||||
, GenericServant routes AsApi
|
||||
)
|
||||
=> (routes AsApi -> endpoint)
|
||||
-> MkLink endpoint Link
|
||||
fieldLink = fieldLink' id
|
||||
|
||||
-- | More general version of 'fieldLink'
|
||||
--
|
||||
-- @since 0.14.1
|
||||
fieldLink'
|
||||
:: forall routes endpoint a.
|
||||
( IsElem endpoint (ToServantApi routes), HasLink endpoint
|
||||
, GenericServant routes AsApi
|
||||
)
|
||||
=> (Link -> a)
|
||||
-> (routes AsApi -> endpoint)
|
||||
-> MkLink endpoint a
|
||||
fieldLink' toA _ = safeLink' toA (genericApi (Proxy :: Proxy routes)) (Proxy :: Proxy endpoint)
|
||||
|
||||
-- | A type that specifies that an API record contains a set of links.
|
||||
--
|
||||
-- @since 0.14.1
|
||||
data AsLink (a :: *)
|
||||
instance GenericMode (AsLink a) where
|
||||
type (AsLink a) :- api = MkLink api a
|
||||
|
||||
-- | Get all links as a record.
|
||||
--
|
||||
-- @since 0.14.1
|
||||
allFieldLinks
|
||||
:: ( HasLink (ToServantApi routes)
|
||||
, GenericServant routes (AsLink Link)
|
||||
, ToServant routes (AsLink Link) ~ MkLink (ToServantApi routes) Link
|
||||
)
|
||||
=> routes (AsLink Link)
|
||||
allFieldLinks = allFieldLinks' id
|
||||
|
||||
-- | More general version of 'allFieldLinks'.
|
||||
--
|
||||
-- @since 0.14.1
|
||||
allFieldLinks'
|
||||
:: forall routes a.
|
||||
( HasLink (ToServantApi routes)
|
||||
, GenericServant routes (AsLink a)
|
||||
, ToServant routes (AsLink a) ~ MkLink (ToServantApi routes) a
|
||||
)
|
||||
=> (Link -> a)
|
||||
-> routes (AsLink a)
|
||||
allFieldLinks' toA
|
||||
= fromServant
|
||||
$ allLinks' toA (Proxy :: Proxy (ToServantApi routes))
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- HasLink
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
-- | Construct a toLink for an endpoint.
|
||||
class HasLink endpoint where
|
||||
type MkLink endpoint (a :: *)
|
||||
|
|
|
|||
Loading…
Reference in New Issue