Merge branch 'canonical-types'

src/Servant/JQuery.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 -----------------------------------------------------------------------------
 -- |
@@ -20,10 +21,11 @@ import Control.Lens
 import Data.List
 import Data.Monoid
 import Data.Proxy
+import Servant.API
 import Servant.JQuery.Internal
 
-jquery :: HasJQ layout => Proxy layout -> JQ layout
+jquery :: HasJQ (Canonicalize layout) => Proxy layout -> JQ layout
-jquery p = jqueryFor p defReq
+jquery p = jqueryFor (canonicalize p) defReq
 
 -- js codegen
 generateJS :: AjaxReq -> String

src/Servant/JQuery/Internal.hs

@@ -191,12 +191,14 @@ type family Elem (a :: *) (ls::[*]) :: Constraint where
   Elem a (b ': list) = Elem a list
 
 class HasJQ (layout :: *) where
-  type JQ layout :: *
+  type JQ' layout :: *
-  jqueryFor :: Proxy layout -> AjaxReq -> JQ layout
+  jqueryFor :: Proxy layout -> AjaxReq -> JQ' layout
+
+type JQ layout = JQ' (Canonicalize layout)
 
 instance (HasJQ a, HasJQ b)
       => HasJQ (a :<|> b) where
-  type JQ (a :<|> b) = JQ a :<|> JQ b
+  type JQ' (a :<|> b) = JQ' a :<|> JQ' b
 
   jqueryFor Proxy req =
          jqueryFor (Proxy :: Proxy a) req
@@ -204,7 +206,7 @@ instance (HasJQ a, HasJQ b)
 
 instance (KnownSymbol sym, HasJQ sublayout)
       => HasJQ (Capture sym a :> sublayout) where
-  type JQ (Capture sym a :> sublayout) = JQ sublayout
+  type JQ' (Capture sym a :> sublayout) = JQ' sublayout
 
   jqueryFor Proxy req =
     jqueryFor (Proxy :: Proxy sublayout) $
@@ -213,14 +215,14 @@ instance (KnownSymbol sym, HasJQ sublayout)
     where str = symbolVal (Proxy :: Proxy sym)
 
 instance HasJQ Delete where
-  type JQ Delete = AjaxReq
+  type JQ' Delete = AjaxReq
 
   jqueryFor Proxy req =
     req & funcName  %~ ("delete" <>)
         & reqMethod .~ "DELETE"
 
 instance Elem JSON list => HasJQ (Get list a) where
-  type JQ (Get list a) = AjaxReq
+  type JQ' (Get list a) = AjaxReq
 
   jqueryFor Proxy req =
     req & funcName  %~ ("get" <>)
@@ -228,7 +230,7 @@ instance Elem JSON list => HasJQ (Get list a) where
 
 instance (KnownSymbol sym, HasJQ sublayout)
       => HasJQ (Header sym a :> sublayout) where
-  type JQ (Header sym a :> sublayout) = JQ sublayout
+  type JQ' (Header sym a :> sublayout) = JQ' sublayout
 
   jqueryFor Proxy req =
     jqueryFor subP (req & reqHeaders <>~ [HeaderArg hname])
@@ -237,14 +239,14 @@ instance (KnownSymbol sym, HasJQ sublayout)
           subP = Proxy :: Proxy sublayout
 
 instance Elem JSON list => HasJQ (Post list a) where
-  type JQ (Post list a) = AjaxReq
+  type JQ' (Post list a) = AjaxReq
 
   jqueryFor Proxy req =
     req & funcName  %~ ("post" <>)
         & reqMethod .~ "POST"
 
 instance Elem JSON list => HasJQ (Put list a) where
-  type JQ (Put list a) = AjaxReq
+  type JQ' (Put list a) = AjaxReq
 
   jqueryFor Proxy req =
     req & funcName  %~ ("put" <>)
@@ -252,7 +254,7 @@ instance Elem JSON list => HasJQ (Put list a) where
 
 instance (KnownSymbol sym, HasJQ sublayout)
       => HasJQ (QueryParam sym a :> sublayout) where
-  type JQ (QueryParam sym a :> sublayout) = JQ sublayout
+  type JQ' (QueryParam sym a :> sublayout) = JQ' sublayout
 
   jqueryFor Proxy req =
     jqueryFor (Proxy :: Proxy sublayout) $
@@ -262,7 +264,7 @@ instance (KnownSymbol sym, HasJQ sublayout)
 
 instance (KnownSymbol sym, HasJQ sublayout)
       => HasJQ (QueryParams sym a :> sublayout) where
-  type JQ (QueryParams sym a :> sublayout) = JQ sublayout
+  type JQ' (QueryParams sym a :> sublayout) = JQ' sublayout
 
   jqueryFor Proxy req =
     jqueryFor (Proxy :: Proxy sublayout) $
@@ -272,7 +274,7 @@ instance (KnownSymbol sym, HasJQ sublayout)
 
 instance (KnownSymbol sym, HasJQ sublayout)
       => HasJQ (QueryFlag sym :> sublayout) where
-  type JQ (QueryFlag sym :> sublayout) = JQ sublayout
+  type JQ' (QueryFlag sym :> sublayout) = JQ' sublayout
 
   jqueryFor Proxy req =
     jqueryFor (Proxy :: Proxy sublayout) $
@@ -312,14 +314,14 @@ instance (KnownSymbol sym, HasJQ sublayout)
     where str = symbolVal (Proxy :: Proxy sym)
 
 instance HasJQ Raw where
-  type JQ Raw = Method -> AjaxReq
+  type JQ' Raw = Method -> AjaxReq
 
   jqueryFor Proxy req method =
     req & funcName %~ ((toLower <$> method) <>)
         & reqMethod .~ method
 
 instance (Elem JSON list, HasJQ sublayout) => HasJQ (ReqBody list a :> sublayout) where
-  type JQ (ReqBody list a :> sublayout) = JQ sublayout
+  type JQ' (ReqBody list a :> sublayout) = JQ' sublayout
 
   jqueryFor Proxy req =
     jqueryFor (Proxy :: Proxy sublayout) $
@@ -327,7 +329,7 @@ instance (Elem JSON list, HasJQ sublayout) => HasJQ (ReqBody list a :> sublayout
 
 instance (KnownSymbol path, HasJQ sublayout)
       => HasJQ (path :> sublayout) where
-  type JQ (path :> sublayout) = JQ sublayout
+  type JQ' (path :> sublayout) = JQ' sublayout
 
   jqueryFor Proxy req =
     jqueryFor (Proxy :: Proxy sublayout) $

test/Servant/JQuerySpec/CustomHeaders.hs

@@ -22,7 +22,7 @@ data Authorization (sym :: Symbol) a
 
 instance (KnownSymbol sym, HasJQ sublayout)
     => HasJQ (Authorization sym a :> sublayout) where
-    type JQ (Authorization sym a :> sublayout) = JQ sublayout
+    type JQ' (Authorization sym a :> sublayout) = JQ' sublayout
 
     jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $
         req & reqHeaders <>~ [ ReplaceHeaderArg "Authorization" $
@@ -35,7 +35,7 @@ data MyLovelyHorse a
 
 instance (HasJQ sublayout)
     => HasJQ (MyLovelyHorse a :> sublayout) where
-    type JQ (MyLovelyHorse a :> sublayout) = JQ sublayout
+    type JQ' (MyLovelyHorse a :> sublayout) = JQ' sublayout
 
     jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $
         req & reqHeaders <>~ [ ReplaceHeaderArg "X-MyLovelyHorse" tpl ]
@@ -47,7 +47,7 @@ data WhatsForDinner a
 
 instance (HasJQ sublayout)
     => HasJQ (WhatsForDinner a :> sublayout) where
-    type JQ (WhatsForDinner a :> sublayout) = JQ sublayout
+    type JQ' (WhatsForDinner a :> sublayout) = JQ' sublayout
 
     jqueryFor Proxy req = jqueryFor (Proxy :: Proxy sublayout) $
         req & reqHeaders <>~ [ ReplaceHeaderArg "X-WhatsForDinner" tpl ]