@@ -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.
6+--
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`:
9+--
10+-- @
11+-- data Routes route = Routes
12+-- { _get :: route :- Capture "id" Int :> Get '[JSON] String
13+-- , _put :: route :- ReqBody '[JSON] Int :> Put '[JSON] Bool
14+-- }
15+-- deriving ('Generic')
16+-- @
17+--
18+-- You can get a 'Proxy' of the server using
19+--
20+-- @
21+-- api :: Proxy (ToServantApi Routes)
22+-- api = genericApi (Proxy :: Proxy Routes)
23+-- @
24+--
25+-- Using 'genericApi' is better as it checks that instances exists,
26+-- i.e. you get better error messages than simply using 'Proxy' value.
27+--
28+-- __Note:__ in 0.14 series this module isn't re-exported from 'Servant.API'.
29+--
30+-- "Servant.API.Generic" is based on @servant-generic@ package by
31+-- [Patrick Chilton](https://github.com/chpatrick)
32+--
33+-- @since 0.14.1
34+module Servant.API.Generic (
35+ GenericMode (..),
36+ GenericServant,
37+ ToServant,
38+ toServant,
39+ fromServant,
40+ -- * AsApi
41+ AsApi,
42+ ToServantApi,
43+ genericApi,
44+ -- * Utility
45+ GServantProduct,
46+ -- * re-exports
47+ Generic (Rep),
48+ ) where
49+
50+-- Based on servant-generic licensed under MIT License
51+--
52+-- Copyright (c) 2017 Patrick Chilton
53+--
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:
60+--
61+-- The above copyright notice and this permission notice shall be included in all
62+-- copies or substantial portions of the Software.
63+--
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
70+-- SOFTWARE.
71+
72+import Data.Proxy
73+ (Proxy (..))
74+import GHC.Generics
75+ ((:*:) (..), Generic (..), K1 (..), M1 (..))
76+
77+import Servant.API.Alternative
78+
79+-- | A constraint alias, for work with 'mode' and 'routes'.
80+type GenericServant routes mode = (GenericMode mode, Generic (routes mode), GServantProduct (Rep (routes mode)))
81+
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 :: *
87+
88+infixl 0 :-
89+
90+-- | Turns a generic product type into a tree of `:<|>` combinators.
91+type ToServant routes mode = GToServant (Rep (routes mode))
92+
93+type ToServantApi routes = ToServant routes AsApi
94+
95+-- | See `ToServant`, but at value-level.
96+toServant
97+ :: GenericServant routes mode
98+ => routes mode -> ToServant routes mode
99+toServant = gtoServant . from
100+
101+-- | Inverse of `toServant`.
102+--
103+-- This can be used to turn 'generated' values such as client functions into records.
104+--
105+-- You may need to provide a type signature for the /output/ type (your record type).
106+fromServant
107+ :: GenericServant routes mode
108+ => ToServant routes mode -> routes mode
109+fromServant = to . gfromServant
110+
111+-- | A type that specifies that an API record contains an API definition. Only useful at type-level.
112+data AsApi
113+instance GenericMode AsApi where
114+ type AsApi :- api = api
115+
116+-- | Get a 'Proxy' of an API type.
117+genericApi
118+ :: GenericServant routes AsApi
119+ => Proxy routes
120+ -> Proxy (ToServantApi routes)
121+genericApi _ = Proxy
122+
123+-------------------------------------------------------------------------------
124+-- Class
125+-------------------------------------------------------------------------------
126+
127+
128+class GServantProduct f where
129+ type GToServant f
130+ gtoServant :: f p -> GToServant f
131+ gfromServant :: GToServant f -> f p
132+
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
137+
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
142+
143+instance GServantProduct (K1 i c) where
144+ type GToServant (K1 i c) = c
145+ gtoServant = unK1
146+ gfromServant = K1