@@ -0,0 +1,146 @@
1+{-# LANGUAGE ConstraintKinds #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE TypeFamilies #-}
4+{-# LANGUAGE TypeOperators #-}
5+-- | Define servant servers from record types. Generics for the win.
7+-- The usage is simple, if you only need a collection of routes. First you
8+-- define a record with field types prefixed by a parameter `route`:
11+-- data Routes route = Routes
12+-- { _get :: route :- Capture "id" Int :> Get '[JSON] String
13+-- , _put :: route :- ReqBody '[JSON] Int :> Put '[JSON] Bool
15+-- deriving ('Generic')
18+-- You can get a 'Proxy' of the server using
21+-- api :: Proxy (ToServantApi Routes)
22+-- api = genericApi (Proxy :: Proxy Routes)
25+-- Using 'genericApi' is better as it checks that instances exists,
26+-- i.e. you get better error messages than simply using 'Proxy' value.
28+-- __Note:__ in 0.14 series this module isn't re-exported from 'Servant.API'.
30+-- "Servant.API.Generic" is based on @servant-generic@ package by
31+-- [Patrick Chilton](https://github.com/chpatrick)
34+module Servant.API.Generic (
50+-- Based on servant-generic licensed under MIT License
52+-- Copyright (c) 2017 Patrick Chilton
54+-- Permission is hereby granted, free of charge, to any person obtaining a copy
55+-- of this software and associated documentation files (the "Software"), to deal
56+-- in the Software without restriction, including without limitation the rights
57+-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
58+-- copies of the Software, and to permit persons to whom the Software is
59+-- furnished to do so, subject to the following conditions:
61+-- The above copyright notice and this permission notice shall be included in all
62+-- copies or substantial portions of the Software.
64+-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
65+-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
66+-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
67+-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
68+-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
69+-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
75+ ((:*:) (..), Generic (..), K1 (..), M1 (..))
77+import Servant.API.Alternative
79+-- | A constraint alias, for work with 'mode' and 'routes'.
80+type GenericServant routes mode = (GenericMode mode, Generic (routes mode), GServantProduct (Rep (routes mode)))
82+-- | A class with a type family that applies an appropriate type family to the @api@
83+-- parameter. For example, 'AsApi' will leave @api@ untouched, while
84+-- @'AsServerT' m@ will produce @'ServerT' api m@.
85+class GenericMode mode where
86+ type mode :- api :: *
90+-- | Turns a generic product type into a tree of `:<|>` combinators.
91+type ToServant routes mode = GToServant (Rep (routes mode))
93+type ToServantApi routes = ToServant routes AsApi
95+-- | See `ToServant`, but at value-level.
97+ :: GenericServant routes mode
98+ => routes mode -> ToServant routes mode
99+toServant = gtoServant . from
101+-- | Inverse of `toServant`.
103+-- This can be used to turn 'generated' values such as client functions into records.
105+-- You may need to provide a type signature for the /output/ type (your record type).
107+ :: GenericServant routes mode
108+ => ToServant routes mode -> routes mode
109+fromServant = to . gfromServant
111+-- | A type that specifies that an API record contains an API definition. Only useful at type-level.
113+instance GenericMode AsApi where
114+ type AsApi :- api = api
116+-- | Get a 'Proxy' of an API type.
118+ :: GenericServant routes AsApi
120+ -> Proxy (ToServantApi routes)
123+-------------------------------------------------------------------------------
125+-------------------------------------------------------------------------------
128+class GServantProduct f where
130+ gtoServant :: f p -> GToServant f
131+ gfromServant :: GToServant f -> f p
133+instance GServantProduct f => GServantProduct (M1 i c f) where
134+ type GToServant (M1 i c f) = GToServant f
135+ gtoServant = gtoServant . unM1
136+ gfromServant = M1 . gfromServant
138+instance (GServantProduct l, GServantProduct r) => GServantProduct (l :*: r) where
139+ type GToServant (l :*: r) = GToServant l :<|> GToServant r
140+ gtoServant (l :*: r) = gtoServant l :<|> gtoServant r
141+ gfromServant (l :<|> r) = gfromServant l :*: gfromServant r
143+instance GServantProduct (K1 i c) where
144+ type GToServant (K1 i c) = c