From ad0c6521ed772d9434d39cc6ce680bce00128e13 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 | 6 +++-- src/Servant/JQuery/Internal.hs | 32 +++++++++++++----------- test/Servant/JQuerySpec/CustomHeaders.hs | 6 ++--- 3 files changed, 24 insertions(+), 20 deletions(-) diff --git a/src/Servant/JQuery.hs b/src/Servant/JQuery.hs index 38ff92d8..47a6bee2 100644 --- a/src/Servant/JQuery.hs +++ b/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 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 6df155a0..21dd69de 100644 --- a/src/Servant/JQuery/Internal.hs +++ b/src/Servant/JQuery/Internal.hs @@ -167,12 +167,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 @@ -180,7 +182,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) $ @@ -189,14 +191,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" <>) @@ -204,7 +206,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]) @@ -213,14 +215,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" <>) @@ -228,7 +230,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) $ @@ -238,7 +240,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) $ @@ -248,7 +250,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) $ @@ -257,14 +259,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) $ @@ -272,7 +274,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 ]