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

Merge servant-generic

Browse source
This commit is contained in:
Oleg Grenrus 2018-07-04 22:59:43 +03:00
parent 374a7b88fb
commit 88f8d3b0d1
14 changed files with 508 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
cabal.project
View file

@ -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

106
doc/cookbook/generic/Generic.lhs Normal file
View file

@ -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"
```

25
doc/cookbook/generic/generic.cabal Normal file
View file

@ -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

4
doc/tutorial/tutorial.cabal
View file

@ -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

8
servant-client-core/CHANGELOG.md
View file

@ -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
----

5
servant-client-core/servant-client-core.cabal
View file

@ -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.

51
servant-client-core/src/Servant/Client/Generic.hs Normal file
View file

@ -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)

10
servant-server/CHANGELOG.md
View file

@ -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
----

5
servant-server/servant-server.cabal
View file

@ -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.

52
servant-server/src/Servant/Server/Generic.hs Normal file
View file

@ -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

13
servant/CHANGELOG.md
View file

@ -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
----

3
servant/servant.cabal
View file

@ -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

146
servant/src/Servant/API/Generic.hs Normal file
View file

@ -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

86
servant/src/Servant/Links.hs
View file

@ -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 :: *)