git.iko.soy/servant
on master help sign in
Code changes to support Jkarni/content types.
5578488Timo von Holtz
src/Servant/JQuery/Internal.hs+18−10
compare with master
unifiedsplit
@@ -1,9 +1,12 @@
1{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE TypeFamilies #-}
2{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE TypeOperators #-}
3{-# LANGUAGE TypeOperators #-}
4+{-# LANGUAGE ConstraintKinds #-}
4{-# LANGUAGE TemplateHaskell #-}
5{-# LANGUAGE TemplateHaskell #-}
6+{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE ScopedTypeVariables #-}
8{-# LANGUAGE ScopedTypeVariables #-}
9+{-# LANGUAGE UndecidableInstances #-}
7module Servant.JQuery.Internal where
10module Servant.JQuery.Internal where
8
11
9import Control.Applicative
12import Control.Applicative
@@ -15,6 +18,7 @@ import Data.List
15import Data.Monoid
18import Data.Monoid
16import Data.Proxy
19import Data.Proxy
17import qualified Data.Text as T
20import qualified Data.Text as T
21+import GHC.Exts (Constraint)
18import GHC.TypeLits
22import GHC.TypeLits
19import Servant.API
23import Servant.API
20
24
@@ -157,7 +161,12 @@ paramToStr qarg notTheEnd =
157defReq :: AjaxReq
161defReq :: AjaxReq
158defReq = AjaxReq defUrl "GET" [] False ""
162defReq = AjaxReq defUrl "GET" [] False ""
159
163
164+type family Elem (a :: *) (ls::[*]) :: Constraint where
165+ Elem a '[] = 'False ~ 'True
166+ Elem a (a ': list) = ()
167+ Elem a (b ': list) = Elem a list
168+
160−class HasJQ layout where
169+class HasJQ (layout :: *) where
161 type JQ layout :: *
170 type JQ layout :: *
162 jqueryFor :: Proxy layout -> AjaxReq -> JQ layout
171 jqueryFor :: Proxy layout -> AjaxReq -> JQ layout
163
172
@@ -186,8 +195,8 @@ instance HasJQ Delete where
186 req & funcName %~ ("delete" <>)
195 req & funcName %~ ("delete" <>)
187 & reqMethod .~ "DELETE"
196 & reqMethod .~ "DELETE"
188
197
189−instance HasJQ (Get a) where
198+instance Elem JSON list => HasJQ (Get list a) where
190− type JQ (Get a) = AjaxReq
199+ type JQ (Get list a) = AjaxReq
191
200
192 jqueryFor Proxy req =
201 jqueryFor Proxy req =
193 req & funcName %~ ("get" <>)
202 req & funcName %~ ("get" <>)
@@ -203,15 +212,15 @@ instance (KnownSymbol sym, HasJQ sublayout)
203 where hname = symbolVal (Proxy :: Proxy sym)
212 where hname = symbolVal (Proxy :: Proxy sym)
204 subP = Proxy :: Proxy sublayout
213 subP = Proxy :: Proxy sublayout
205
214
206−instance HasJQ (Post a) where
215+instance Elem JSON list => HasJQ (Post list a) where
207− type JQ (Post a) = AjaxReq
216+ type JQ (Post list a) = AjaxReq
208
217
209 jqueryFor Proxy req =
218 jqueryFor Proxy req =
210 req & funcName %~ ("post" <>)
219 req & funcName %~ ("post" <>)
211 & reqMethod .~ "POST"
220 & reqMethod .~ "POST"
212
221
213−instance HasJQ (Put a) where
222+instance Elem JSON list => HasJQ (Put list a) where
214− type JQ (Put a) = AjaxReq
223+ type JQ (Put list a) = AjaxReq
215
224
216 jqueryFor Proxy req =
225 jqueryFor Proxy req =
217 req & funcName %~ ("put" <>)
226 req & funcName %~ ("put" <>)
@@ -226,7 +235,6 @@ instance (KnownSymbol sym, HasJQ sublayout)
226 req & reqUrl.queryStr <>~ [QueryArg str Normal]
235 req & reqUrl.queryStr <>~ [QueryArg str Normal]
227
236
228 where str = symbolVal (Proxy :: Proxy sym)
237 where str = symbolVal (Proxy :: Proxy sym)
229− strArg = str ++ "Value"
230
238
231instance (KnownSymbol sym, HasJQ sublayout)
239instance (KnownSymbol sym, HasJQ sublayout)
232 => HasJQ (QueryParams sym a :> sublayout) where
240 => HasJQ (QueryParams sym a :> sublayout) where
@@ -255,8 +263,8 @@ instance HasJQ Raw where
255 req & funcName %~ ((toLower <$> method) <>)
263 req & funcName %~ ((toLower <$> method) <>)
256 & reqMethod .~ method
264 & reqMethod .~ method
257
265
258−instance HasJQ sublayout => HasJQ (ReqBody a :> sublayout) where
266+instance (Elem JSON list, HasJQ sublayout) => HasJQ (ReqBody list a :> sublayout) where
259− type JQ (ReqBody a :> sublayout) = JQ sublayout
267+ type JQ (ReqBody list a :> sublayout) = JQ sublayout
260
268
261 jqueryFor Proxy req =
269 jqueryFor Proxy req =
262 jqueryFor (Proxy :: Proxy sublayout) $
270 jqueryFor (Proxy :: Proxy sublayout) $
test/Servant/JQuerySpec.hs+7−9
@@ -16,25 +16,23 @@ import Servant.API
16import Servant.JQuery
16import Servant.JQuery
17import Servant.JQuerySpec.CustomHeaders
17import Servant.JQuerySpec.CustomHeaders
18
18
19−type TestAPI = [sitemap|
20−POST /simple String -> Bool
19+type TestAPI = "simple" :> ReqBody '[JSON] String :> Post '[JSON] Bool
21−GET /has.extension Bool
20+ :<|> "has.extension" :> Get '[JSON] Bool
22−|]
23
21
24−type TopLevelRawAPI = "something" :> Get Int
22+type TopLevelRawAPI = "something" :> Get '[JSON] Int
25 :<|> Raw
23 :<|> Raw
26
24
27type HeaderHandlingAPI = "something" :> Header "Foo" String
25type HeaderHandlingAPI = "something" :> Header "Foo" String
28− :> Get Int
26+ :> Get '[JSON] Int
29
27
30type CustomAuthAPI = "something" :> Authorization "Basic" String
28type CustomAuthAPI = "something" :> Authorization "Basic" String
31− :> Get Int
29+ :> Get '[JSON] Int
32
30
33type CustomHeaderAPI = "something" :> MyLovelyHorse String
31type CustomHeaderAPI = "something" :> MyLovelyHorse String
34− :> Get Int
32+ :> Get '[JSON] Int
35
33
36type CustomHeaderAPI2 = "something" :> WhatsForDinner String
34type CustomHeaderAPI2 = "something" :> WhatsForDinner String
37− :> Get Int
35+ :> Get '[JSON] Int
38
36
39headerHandlingProxy :: Proxy HeaderHandlingAPI
37headerHandlingProxy :: Proxy HeaderHandlingAPI
40headerHandlingProxy = Proxy
38headerHandlingProxy = Proxy