From 5578488538c8213d2015cc83eaf4d37217c6e3d2 Mon Sep 17 00:00:00 2001
From: Timo von Holtz <tvh@anchor.com.au>
Date: Thu, 19 Feb 2015 11:36:31 +1100
Subject: [PATCH] Code changes to support Jkarni/content types.

These are just straight forward changes to compile against servant.
---
 src/Servant/JQuery/Internal.hs | 28 ++++++++++++++++++----------
 test/Servant/JQuerySpec.hs     | 16 +++++++---------
 2 files changed, 25 insertions(+), 19 deletions(-)

diff --git a/src/Servant/JQuery/Internal.hs b/src/Servant/JQuery/Internal.hs
index c8f583ca..6df155a0 100644
--- a/src/Servant/JQuery/Internal.hs
+++ b/src/Servant/JQuery/Internal.hs
@@ -1,9 +1,12 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableInstances #-}
 module Servant.JQuery.Internal where
 
 import Control.Applicative
@@ -15,6 +18,7 @@ import Data.List
 import Data.Monoid
 import Data.Proxy
 import qualified Data.Text as T
+import GHC.Exts (Constraint)
 import GHC.TypeLits
 import Servant.API
 
@@ -157,7 +161,12 @@ paramToStr qarg notTheEnd =
 defReq :: AjaxReq
 defReq = AjaxReq defUrl "GET" [] False ""
 
-class HasJQ layout where
+type family Elem (a :: *) (ls::[*]) :: Constraint where
+  Elem a '[] = 'False ~ 'True
+  Elem a (a ': list) = ()
+  Elem a (b ': list) = Elem a list
+
+class HasJQ (layout :: *) where
   type JQ layout :: *
   jqueryFor :: Proxy layout -> AjaxReq -> JQ layout
 
@@ -186,8 +195,8 @@ instance HasJQ Delete where
     req & funcName  %~ ("delete" <>)
         & reqMethod .~ "DELETE"
 
-instance HasJQ (Get a) where
-  type JQ (Get a) = AjaxReq
+instance Elem JSON list => HasJQ (Get list a) where
+  type JQ (Get list a) = AjaxReq
 
   jqueryFor Proxy req =
     req & funcName  %~ ("get" <>)
@@ -203,15 +212,15 @@ instance (KnownSymbol sym, HasJQ sublayout)
     where hname = symbolVal (Proxy :: Proxy sym)
           subP = Proxy :: Proxy sublayout
 
-instance HasJQ (Post a) where
-  type JQ (Post a) = AjaxReq
+instance Elem JSON list => HasJQ (Post list a) where
+  type JQ (Post list a) = AjaxReq
 
   jqueryFor Proxy req =
     req & funcName  %~ ("post" <>)
         & reqMethod .~ "POST"
 
-instance HasJQ (Put a) where
-  type JQ (Put a) = AjaxReq
+instance Elem JSON list => HasJQ (Put list a) where
+  type JQ (Put list a) = AjaxReq
 
   jqueryFor Proxy req =
     req & funcName  %~ ("put" <>)
@@ -226,7 +235,6 @@ instance (KnownSymbol sym, HasJQ sublayout)
       req & reqUrl.queryStr <>~ [QueryArg str Normal]
 
     where str = symbolVal (Proxy :: Proxy sym)
-          strArg = str ++ "Value"
 
 instance (KnownSymbol sym, HasJQ sublayout)
       => HasJQ (QueryParams sym a :> sublayout) where
@@ -255,8 +263,8 @@ instance HasJQ Raw where
     req & funcName %~ ((toLower <$> method) <>)
         & reqMethod .~ method
 
-instance HasJQ sublayout => HasJQ (ReqBody a :> sublayout) where
-  type JQ (ReqBody a :> sublayout) = JQ sublayout
+instance (Elem JSON list, HasJQ sublayout) => HasJQ (ReqBody list a :> sublayout) where
+  type JQ (ReqBody list a :> sublayout) = JQ sublayout
 
   jqueryFor Proxy req =
     jqueryFor (Proxy :: Proxy sublayout) $
diff --git a/test/Servant/JQuerySpec.hs b/test/Servant/JQuerySpec.hs
index fdc9331f..8952018f 100644
--- a/test/Servant/JQuerySpec.hs
+++ b/test/Servant/JQuerySpec.hs
@@ -16,25 +16,23 @@ import Servant.API
 import Servant.JQuery
 import Servant.JQuerySpec.CustomHeaders
 
-type TestAPI = [sitemap|
-POST    /simple                  String -> Bool
-GET     /has.extension           Bool
-|]
+type TestAPI = "simple" :> ReqBody '[JSON] String :> Post '[JSON] Bool
+          :<|> "has.extension" :> Get '[JSON] Bool
 
-type TopLevelRawAPI = "something" :> Get Int
+type TopLevelRawAPI = "something" :> Get '[JSON] Int
                   :<|> Raw
 
 type HeaderHandlingAPI = "something" :> Header "Foo" String
-                                     :> Get Int
+                                     :> Get '[JSON] Int
 
 type CustomAuthAPI = "something" :> Authorization "Basic" String
-                                 :> Get Int
+                                 :> Get '[JSON] Int
 
 type CustomHeaderAPI = "something" :> MyLovelyHorse String
-                                   :> Get Int
+                                   :> Get '[JSON] Int
 
 type CustomHeaderAPI2 = "something" :> WhatsForDinner String
-                                    :> Get Int
+                                    :> Get '[JSON] Int
 
 headerHandlingProxy :: Proxy HeaderHandlingAPI
 headerHandlingProxy = Proxy