git.iko.soy/typeable/servant
on master help sign in
Add access to types in servant-foreign.
8932cb2Maksymilian Owsianny
servant-foreign/src/Servant/Foreign.hs+2
compare with master
unifiedsplit
@@ -2,6 +2,7 @@
2-- arbitrary programming languages.
2-- arbitrary programming languages.
3module Servant.Foreign
3module Servant.Foreign
4 ( HasForeign(..)
4 ( HasForeign(..)
5+ , HasForeignType(..)
5 , Segment(..)
6 , Segment(..)
6 , SegmentType(..)
7 , SegmentType(..)
7 , FunctionName
8 , FunctionName
@@ -24,6 +25,7 @@ module Servant.Foreign
24 , reqBody
25 , reqBody
25 , reqHeaders
26 , reqHeaders
26 , reqMethod
27 , reqMethod
28+ , reqReturnType
27 , segment
29 , segment
28 , queryStr
30 , queryStr
29 -- re-exports
31 -- re-exports
servant-foreign/src/Servant/Foreign/Internal.hs+65−34
@@ -45,7 +45,8 @@ camelCase = camelCase' . Prelude.map (replace "-" "")
45 capitalize "" = ""
45 capitalize "" = ""
46 capitalize name = C.toUpper (Data.Text.head name) `cons` Data.Text.tail name
46 capitalize name = C.toUpper (Data.Text.head name) `cons` Data.Text.tail name
47
47
48+type ForeignType = Text
48−type Arg = Text
49+type Arg = (Text, ForeignType)
49
50
50newtype Segment = Segment { _segment :: SegmentType }
51newtype Segment = Segment { _segment :: SegmentType }
51 deriving (Eq, Show)
52 deriving (Eq, Show)
@@ -68,10 +69,10 @@ data QueryArg = QueryArg
68 } deriving (Eq, Show)
69 } deriving (Eq, Show)
69
70
70data HeaderArg = HeaderArg
71data HeaderArg = HeaderArg
71− { headerArgName :: Text
72+ { headerArg :: Arg
72 }
73 }
73 | ReplaceHeaderArg
74 | ReplaceHeaderArg
74− { headerArgName :: Text
75+ { headerArg :: Arg
75 , headerPattern :: Text
76 , headerPattern :: Text
76 } deriving (Eq, Show)
77 } deriving (Eq, Show)
77
78
@@ -88,11 +89,12 @@ type FunctionName = [Text]
88type Method = Text
89type Method = Text
89
90
90data Req = Req
91data Req = Req
91− { _reqUrl :: Url
92+ { _reqUrl :: Url
92− , _reqMethod :: Method
93+ , _reqMethod :: Method
93− , _reqHeaders :: [HeaderArg]
94+ , _reqHeaders :: [HeaderArg]
94− , _reqBody :: Bool
95+ , _reqBody :: Maybe ForeignType
96+ , _reqReturnType :: ForeignType
95− , _funcName :: FunctionName
97+ , _funcName :: FunctionName
96 } deriving (Eq, Show)
98 } deriving (Eq, Show)
97
99
98makeLenses ''QueryArg
100makeLenses ''QueryArg
@@ -109,7 +111,7 @@ captureArg (Segment (Cap s)) = s
109captureArg _ = error "captureArg called on non capture"
111captureArg _ = error "captureArg called on non capture"
110
112
111defReq :: Req
113defReq :: Req
112−defReq = Req defUrl "GET" [] False []
114+defReq = Req defUrl "GET" [] Nothing "" []
113
115
114-- | To be used exclusively as a "negative" return type/constraint
116-- | To be used exclusively as a "negative" return type/constraint
115-- by @'Elem`@ type family.
117-- by @'Elem`@ type family.
@@ -120,6 +122,9 @@ type family Elem (a :: *) (ls::[*]) :: Constraint where
120 Elem a (a ': list) = ()
122 Elem a (a ': list) = ()
121 Elem a (b ': list) = Elem a list
123 Elem a (b ': list) = Elem a list
122
124
125+class HasForeignType a where
126+ typeFor :: Proxy a -> ForeignType
127+
123class HasForeign (layout :: *) where
128class HasForeign (layout :: *) where
124 type Foreign layout :: *
129 type Foreign layout :: *
125 foreignFor :: Proxy layout -> Req -> Foreign layout
130 foreignFor :: Proxy layout -> Req -> Foreign layout
@@ -132,84 +137,107 @@ instance (HasForeign a, HasForeign b)
132 foreignFor (Proxy :: Proxy a) req
137 foreignFor (Proxy :: Proxy a) req
133 :<|> foreignFor (Proxy :: Proxy b) req
138 :<|> foreignFor (Proxy :: Proxy b) req
134
139
135−instance (KnownSymbol sym, HasForeign sublayout)
140+instance (KnownSymbol sym, HasForeignType a, HasForeign sublayout)
136 => HasForeign (Capture sym a :> sublayout) where
141 => HasForeign (Capture sym a :> sublayout) where
137 type Foreign (Capture sym a :> sublayout) = Foreign sublayout
142 type Foreign (Capture sym a :> sublayout) = Foreign sublayout
138
143
139 foreignFor Proxy req =
144 foreignFor Proxy req =
140 foreignFor (Proxy :: Proxy sublayout) $
145 foreignFor (Proxy :: Proxy sublayout) $
141− req & reqUrl.path <>~ [Segment (Cap str)]
146+ req & reqUrl.path <>~ [Segment (Cap arg)]
142 & funcName %~ (++ ["by", str])
147 & funcName %~ (++ ["by", str])
143
148
149+ where
144− where str = pack . symbolVal $ (Proxy :: Proxy sym)
150+ str = pack . symbolVal $ (Proxy :: Proxy sym)
151+ arg = (str, typeFor (Proxy :: Proxy a))
145
152
146−instance Elem JSON list => HasForeign (Delete list a) where
153+instance (Elem JSON list, HasForeignType a) => HasForeign (Delete list a) where
147 type Foreign (Delete list a) = Req
154 type Foreign (Delete list a) = Req
148
155
149 foreignFor Proxy req =
156 foreignFor Proxy req =
150− req & funcName %~ ("delete" :)
157+ req & funcName %~ ("delete" :)
151− & reqMethod .~ "DELETE"
158+ & reqMethod .~ "DELETE"
159+ & reqReturnType .~ retType
160+ where
161+ retType = typeFor (Proxy :: Proxy a)
152
162
153−instance Elem JSON list => HasForeign (Get list a) where
163+instance (Elem JSON list, HasForeignType a) => HasForeign (Get list a) where
154 type Foreign (Get list a) = Req
164 type Foreign (Get list a) = Req
155
165
156 foreignFor Proxy req =
166 foreignFor Proxy req =
157 req & funcName %~ ("get" :)
167 req & funcName %~ ("get" :)
158 & reqMethod .~ "GET"
168 & reqMethod .~ "GET"
169+ & reqReturnType .~ retType
170+ where
171+ retType = typeFor (Proxy :: Proxy a)
159
172
160−instance (KnownSymbol sym, HasForeign sublayout)
173+instance (KnownSymbol sym, HasForeignType a, HasForeign sublayout)
161 => HasForeign (Header sym a :> sublayout) where
174 => HasForeign (Header sym a :> sublayout) where
162 type Foreign (Header sym a :> sublayout) = Foreign sublayout
175 type Foreign (Header sym a :> sublayout) = Foreign sublayout
163
176
164 foreignFor Proxy req =
177 foreignFor Proxy req =
178+ foreignFor subP $ req
165− foreignFor subP (req & reqHeaders <>~ [HeaderArg hname])
179+ & reqHeaders <>~ [HeaderArg arg]
166
180
181+ where
167− where hname = pack . symbolVal $ (Proxy :: Proxy sym)
182+ hname = pack . symbolVal $ (Proxy :: Proxy sym)
183+ arg = (hname, typeFor (Proxy :: Proxy a))
168− subP = Proxy :: Proxy sublayout
184+ subP = Proxy :: Proxy sublayout
169
185
170−instance Elem JSON list => HasForeign (Post list a) where
186+instance (Elem JSON list, HasForeignType a) => HasForeign (Post list a) where
171 type Foreign (Post list a) = Req
187 type Foreign (Post list a) = Req
172
188
173 foreignFor Proxy req =
189 foreignFor Proxy req =
174 req & funcName %~ ("post" :)
190 req & funcName %~ ("post" :)
175 & reqMethod .~ "POST"
191 & reqMethod .~ "POST"
192+ & reqReturnType .~ retType
193+ where
194+ retType = typeFor (Proxy :: Proxy a)
176
195
177−instance Elem JSON list => HasForeign (Put list a) where
196+instance (Elem JSON list, HasForeignType a) => HasForeign (Put list a) where
178 type Foreign (Put list a) = Req
197 type Foreign (Put list a) = Req
179
198
180 foreignFor Proxy req =
199 foreignFor Proxy req =
181 req & funcName %~ ("put" :)
200 req & funcName %~ ("put" :)
182 & reqMethod .~ "PUT"
201 & reqMethod .~ "PUT"
202+ & reqReturnType .~ retType
203+ where
204+ retType = typeFor (Proxy :: Proxy a)
183
205
184−instance (KnownSymbol sym, HasForeign sublayout)
206+instance (KnownSymbol sym, HasForeignType a, HasForeign sublayout)
185 => HasForeign (QueryParam sym a :> sublayout) where
207 => HasForeign (QueryParam sym a :> sublayout) where
186 type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
208 type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout
187
209
188 foreignFor Proxy req =
210 foreignFor Proxy req =
189 foreignFor (Proxy :: Proxy sublayout) $
211 foreignFor (Proxy :: Proxy sublayout) $
190− req & reqUrl.queryStr <>~ [QueryArg str Normal]
212+ req & reqUrl.queryStr <>~ [QueryArg arg Normal]
191
213
214+ where
192− where str = pack . symbolVal $ (Proxy :: Proxy sym)
215+ str = pack . symbolVal $ (Proxy :: Proxy sym)
216+ arg = (str, typeFor (Proxy :: Proxy a))
193
217
194−instance (KnownSymbol sym, HasForeign sublayout)
218+instance (KnownSymbol sym, HasForeignType a, HasForeign sublayout)
195 => HasForeign (QueryParams sym a :> sublayout) where
219 => HasForeign (QueryParams sym a :> sublayout) where
196 type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout
220 type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout
197
221
198 foreignFor Proxy req =
222 foreignFor Proxy req =
199 foreignFor (Proxy :: Proxy sublayout) $
223 foreignFor (Proxy :: Proxy sublayout) $
200− req & reqUrl.queryStr <>~ [QueryArg str List]
224+ req & reqUrl.queryStr <>~ [QueryArg arg List]
201
225
226+ where
202− where str = pack . symbolVal $ (Proxy :: Proxy sym)
227+ str = pack . symbolVal $ (Proxy :: Proxy sym)
228+ arg = (str, typeFor (Proxy :: Proxy a))
203
229
204−instance (KnownSymbol sym, HasForeign sublayout)
230+instance (KnownSymbol sym, HasForeignType a, a ~ Bool, HasForeign sublayout)
205 => HasForeign (QueryFlag sym :> sublayout) where
231 => HasForeign (QueryFlag sym :> sublayout) where
206 type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout
232 type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout
207
233
208 foreignFor Proxy req =
234 foreignFor Proxy req =
209 foreignFor (Proxy :: Proxy sublayout) $
235 foreignFor (Proxy :: Proxy sublayout) $
210− req & reqUrl.queryStr <>~ [QueryArg str Flag]
236+ req & reqUrl.queryStr <>~ [QueryArg arg Flag]
211
237
238+ where
212− where str = pack . symbolVal $ (Proxy :: Proxy sym)
239+ str = pack . symbolVal $ (Proxy :: Proxy sym)
240+ arg = (str, typeFor (Proxy :: Proxy a))
213
241
214instance HasForeign Raw where
242instance HasForeign Raw where
215 type Foreign Raw = Method -> Req
243 type Foreign Raw = Method -> Req
@@ -218,12 +246,13 @@ instance HasForeign Raw where
218 req & funcName %~ ((toLower method) :)
246 req & funcName %~ ((toLower method) :)
219 & reqMethod .~ method
247 & reqMethod .~ method
220
248
249+instance (Elem JSON list, HasForeignType a, HasForeign sublayout)
221−instance (Elem JSON list, HasForeign sublayout) => HasForeign (ReqBody list a :> sublayout) where
250+ => HasForeign (ReqBody list a :> sublayout) where
222 type Foreign (ReqBody list a :> sublayout) = Foreign sublayout
251 type Foreign (ReqBody list a :> sublayout) = Foreign sublayout
223
252
224 foreignFor Proxy req =
253 foreignFor Proxy req =
225 foreignFor (Proxy :: Proxy sublayout) $
254 foreignFor (Proxy :: Proxy sublayout) $
226− req & reqBody .~ True
255+ req & reqBody .~ (Just $ typeFor (Proxy :: Proxy a))
227
256
228instance (KnownSymbol path, HasForeign sublayout)
257instance (KnownSymbol path, HasForeign sublayout)
229 => HasForeign (path :> sublayout) where
258 => HasForeign (path :> sublayout) where
@@ -234,7 +263,9 @@ instance (KnownSymbol path, HasForeign sublayout)
234 req & reqUrl.path <>~ [Segment (Static str)]
263 req & reqUrl.path <>~ [Segment (Static str)]
235 & funcName %~ (++ [str])
264 & funcName %~ (++ [str])
236
265
266+ where
237− where str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path)
267+ str = Data.Text.map (\c -> if c == '.' then '_' else c)
268+ . pack . symbolVal $ (Proxy :: Proxy path)
238
269
239instance HasForeign sublayout => HasForeign (RemoteHost :> sublayout) where
270instance HasForeign sublayout => HasForeign (RemoteHost :> sublayout) where
240 type Foreign (RemoteHost :> sublayout) = Foreign sublayout
271 type Foreign (RemoteHost :> sublayout) = Foreign sublayout