From 3d467cfab258ae57f4d5593a6411620297c5fa09 Mon Sep 17 00:00:00 2001
From: Alp Mestanogullari <alpmestan@gmail.com>
Date: Mon, 8 Dec 2014 13:32:47 +0100
Subject: [PATCH] add jq support for Servant.API.Header

---
 src/Servant/JQuery.hs          | 12 ++++++++++++
 src/Servant/JQuery/Internal.hs | 23 ++++++++++++++++++-----
 2 files changed, 30 insertions(+), 5 deletions(-)

diff --git a/src/Servant/JQuery.hs b/src/Servant/JQuery.hs
index 21e17def..df6f0ddf 100644
--- a/src/Servant/JQuery.hs
+++ b/src/Servant/JQuery.hs
@@ -34,6 +34,7 @@ generateJS req = "\n" <>
  <> "    { url: " <> url <> "\n"
  <> "    , success: onSuccess\n"
  <> dataBody
+ <> reqheaders
  <> "    , error: onError\n"
  <> "    , type: '" <> method <> "'\n"
  <> "    });\n"
@@ -43,12 +44,15 @@ generateJS req = "\n" <>
         args = captures
             ++ map (view argName) queryparams
             ++ body
+            ++ map ("header"++) hs
             ++ ["onSuccess", "onError"]
         
         captures = map captureArg
                  . filter isCapture
                  $ req ^. reqUrl.path
 
+        hs = req ^. reqHeaders
+
         queryparams = req ^.. reqUrl.queryStr.traverse
 
         body = if req ^. reqBody
@@ -60,6 +64,14 @@ generateJS req = "\n" <>
             then "\n    , data: JSON.stringify(body)\n"
             else ""
 
+        reqheaders =
+          if null hs
+            then ""
+            else "\n    , headers: { " ++ headersStr hs ++ " } }\n"
+
+          where headersStr hs = intercalate ", " $ map headerStr hs
+                headerStr hname = hname ++ ": header" ++ hname
+
         fname = req ^. funcName
         method = req ^. reqMethod
         url = "'"
diff --git a/src/Servant/JQuery/Internal.hs b/src/Servant/JQuery/Internal.hs
index ed92c6b7..229e5e24 100644
--- a/src/Servant/JQuery/Internal.hs
+++ b/src/Servant/JQuery/Internal.hs
@@ -51,6 +51,8 @@ data QueryArg = QueryArg
   , _argType :: ArgType
   } deriving (Eq, Show)
 
+type HeaderArg = String
+
 data Url = Url
   { _path     :: Path
   , _queryStr :: [QueryArg]
@@ -63,10 +65,11 @@ type FunctionName = String
 type Method = String
 
 data AjaxReq = AjaxReq
-  { _reqUrl    :: Url
-  , _reqMethod :: Method
-  , _reqBody   :: Bool
-  , _funcName  :: FunctionName
+  { _reqUrl     :: Url
+  , _reqMethod  :: Method
+  , _reqHeaders :: [HeaderArg]
+  , _reqBody    :: Bool
+  , _funcName   :: FunctionName
   } deriving (Eq, Show)
 
 makeLenses ''QueryArg
@@ -96,7 +99,7 @@ paramToStr qarg notTheEnd =
   where name = qarg ^. argName
 
 defReq :: AjaxReq
-defReq = AjaxReq defUrl "GET" False ""
+defReq = AjaxReq defUrl "GET" [] False ""
 
 class HasJQ layout where
   type JQ layout :: *
@@ -134,6 +137,16 @@ instance HasJQ (Get a) where
     req & funcName  %~ ("get" <>)
         & reqMethod .~ "GET"
 
+instance (KnownSymbol sym, HasJQ sublayout)
+      => HasJQ (Header sym a :> sublayout) where
+  type JQ (Header sym a :> sublayout) = JQ sublayout
+
+  jqueryFor Proxy req =
+    jqueryFor subP (req & reqHeaders <>~ [hname])
+
+    where hname = symbolVal (Proxy :: Proxy sym)
+          subP = Proxy :: Proxy sublayout
+
 instance HasJQ (Post a) where
   type JQ (Post a) = AjaxReq