65e3070cac
Allows users to directly embed APIs defined as records of routes into
vanilla Servant API types.
E.g.:
```haskell
data MyRoutes mode = MyRoutes
{ version :: mode :- Get '[JSON] Int
, …
}
type API = "prefix" :> NamedRoutes MyRoutes :<|> …
```
APIs can thus be recursively defined directly with Generic record types.
152 lines
5.1 KiB
Haskell
152 lines
5.1 KiB
Haskell
{-# 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,
|
|
-- * NamedRoutes combinator
|
|
NamedRoutes,
|
|
-- * 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
|
|
|
|
-- | Combinator for embedding a record of named routes into a Servant API type.
|
|
data NamedRoutes (api :: * -> *)
|
|
|
|
-------------------------------------------------------------------------------
|
|
-- 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
|