on master help sign in
add jq support for Servant.API.Header
3d467cfAlp Mestanogullari
src/Servant/JQuery.hs+12
@@ -34,6 +34,7 @@ generateJS req = "\n" <>
34 <> " { url: " <> url <> "\n"
34 <> " { url: " <> url <> "\n"
35 <> " , success: onSuccess\n"
35 <> " , success: onSuccess\n"
36 <> dataBody
36 <> dataBody
37+ <> reqheaders
37 <> " , error: onError\n"
38 <> " , error: onError\n"
38 <> " , type: '" <> method <> "'\n"
39 <> " , type: '" <> method <> "'\n"
39 <> " });\n"
40 <> " });\n"
@@ -43,12 +44,15 @@ generateJS req = "\n" <>
43 args = captures
44 args = captures
44 ++ map (view argName) queryparams
45 ++ map (view argName) queryparams
45 ++ body
46 ++ body
47+ ++ map ("header"++) hs
46 ++ ["onSuccess", "onError"]
48 ++ ["onSuccess", "onError"]
47
49
48 captures = map captureArg
50 captures = map captureArg
49 . filter isCapture
51 . filter isCapture
50 $ req ^. reqUrl.path
52 $ req ^. reqUrl.path
51
53
54+ hs = req ^. reqHeaders
55+
52 queryparams = req ^.. reqUrl.queryStr.traverse
56 queryparams = req ^.. reqUrl.queryStr.traverse
53
57
54 body = if req ^. reqBody
58 body = if req ^. reqBody
@@ -60,6 +64,14 @@ generateJS req = "\n" <>
60 then "\n , data: JSON.stringify(body)\n"
64 then "\n , data: JSON.stringify(body)\n"
61 else ""
65 else ""
62
66
67+ reqheaders =
68+ if null hs
69+ then ""
70+ else "\n , headers: { " ++ headersStr hs ++ " } }\n"
71+
72+ where headersStr hs = intercalate ", " $ map headerStr hs
73+ headerStr hname = hname ++ ": header" ++ hname
74+
63 fname = req ^. funcName
75 fname = req ^. funcName
64 method = req ^. reqMethod
76 method = req ^. reqMethod
65 url = "'"
77 url = "'"
src/Servant/JQuery/Internal.hs+18−5
@@ -51,6 +51,8 @@ data QueryArg = QueryArg
51 , _argType :: ArgType
51 , _argType :: ArgType
52 } deriving (Eq, Show)
52 } deriving (Eq, Show)
53
53
54+type HeaderArg = String
55+
54data Url = Url
56data Url = Url
55 { _path :: Path
57 { _path :: Path
56 , _queryStr :: [QueryArg]
58 , _queryStr :: [QueryArg]
@@ -63,10 +65,11 @@ type FunctionName = String
63type Method = String
65type Method = String
64
66
65data AjaxReq = AjaxReq
67data AjaxReq = AjaxReq
66− { _reqUrl :: Url
68+ { _reqUrl :: Url
67− , _reqMethod :: Method
69+ , _reqMethod :: Method
70+ , _reqHeaders :: [HeaderArg]
68− , _reqBody :: Bool
71+ , _reqBody :: Bool
69− , _funcName :: FunctionName
72+ , _funcName :: FunctionName
70 } deriving (Eq, Show)
73 } deriving (Eq, Show)
71
74
72makeLenses ''QueryArg
75makeLenses ''QueryArg
@@ -96,7 +99,7 @@ paramToStr qarg notTheEnd =
96 where name = qarg ^. argName
99 where name = qarg ^. argName
97
100
98defReq :: AjaxReq
101defReq :: AjaxReq
99−defReq = AjaxReq defUrl "GET" False ""
102+defReq = AjaxReq defUrl "GET" [] False ""
100
103
101class HasJQ layout where
104class HasJQ layout where
102 type JQ layout :: *
105 type JQ layout :: *
@@ -134,6 +137,16 @@ instance HasJQ (Get a) where
134 req & funcName %~ ("get" <>)
137 req & funcName %~ ("get" <>)
135 & reqMethod .~ "GET"
138 & reqMethod .~ "GET"
136
139
140+instance (KnownSymbol sym, HasJQ sublayout)
141+ => HasJQ (Header sym a :> sublayout) where
142+ type JQ (Header sym a :> sublayout) = JQ sublayout
143+
144+ jqueryFor Proxy req =
145+ jqueryFor subP (req & reqHeaders <>~ [hname])
146+
147+ where hname = symbolVal (Proxy :: Proxy sym)
148+ subP = Proxy :: Proxy sublayout
149+
137instance HasJQ (Post a) where
150instance HasJQ (Post a) where
138 type JQ (Post a) = AjaxReq
151 type JQ (Post a) = AjaxReq
139
152