From 0644c8dd799bb9c568297a944a33210b37f8bc0e Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Mon, 9 Mar 2015 22:54:41 +0100 Subject: [PATCH] canonicalize API type before generating jquery functions, flattening everything on the way --- src/Servant/JQuery.hs | 4 +-- src/Servant/JQuery/Internal.hs | 32 +++++++++++++----------- test/Servant/JQuerySpec/CustomHeaders.hs | 6 ++--- 3 files changed, 22 insertions(+), 20 deletions(-) diff --git a/src/Servant/JQuery.hs b/src/Servant/JQuery.hs index 22d13288..673c81c1 100644 --- a/src/Servant/JQuery.hs +++ b/src/Servant/JQuery.hs @@ -26,8 +26,8 @@ import Data.Proxy import Servant.API import Servant.JQuery.Internal -jquery :: HasJQ layout => Proxy layout -> JQ layout -jquery p = jqueryFor p defReq +jquery :: HasJQ (Canonicalize layout) => Proxy layout -> JQ layout +jquery p = jqueryFor (canonicalize p) defReq -- js codegen generateJS :: AjaxReq -> String diff --git a/src/Servant/JQuery/Internal.hs b/src/Servant/JQuery/Internal.hs index 738acd7e..4d36b83c 100644 --- a/src/Servant/JQuery/Internal.hs +++ b/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 :: * - jqueryFor :: Proxy layout -> AjaxReq -> JQ layout + type 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) $ diff --git a/test/Servant/JQuerySpec/CustomHeaders.hs b/test/Servant/JQuerySpec/CustomHeaders.hs index 4480d44c..95cf4487 100644 --- a/test/Servant/JQuerySpec/CustomHeaders.hs +++ b/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 ]