From 2a4efaa973d7f5f4159518d1d0d37f06a899058c Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 31 Oct 2016 11:19:43 +0100 Subject: [PATCH 1/2] Add TypeRep of api end-point to Foreign.Req. --- servant-foreign/src/Servant/Foreign.hs | 1 + .../src/Servant/Foreign/Internal.hs | 57 ++++++++++++------- servant-js/src/Servant/JS/JQuery.hs | 6 +- 3 files changed, 43 insertions(+), 21 deletions(-) diff --git a/servant-foreign/src/Servant/Foreign.hs b/servant-foreign/src/Servant/Foreign.hs index e2d212b61..8cd925345 100644 --- a/servant-foreign/src/Servant/Foreign.hs +++ b/servant-foreign/src/Servant/Foreign.hs @@ -23,6 +23,7 @@ module Servant.Foreign , reqBody , reqReturnType , reqFuncName + , reqApiType , path , queryStr , queryArgName diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs index 4e4578973..a56c63e44 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/servant-foreign/src/Servant/Foreign/Internal.hs @@ -13,6 +13,7 @@ import Control.Lens (makePrisms, makeLenses, Getter, (&), (<>~), (%~), import Data.Monoid #endif import Data.Proxy +import Data.Typeable (Typeable, TypeRep, typeOf) import Data.String import Data.Text import Data.Text.Encoding (decodeUtf8) @@ -125,6 +126,7 @@ data Req f = Req , _reqBody :: Maybe f , _reqReturnType :: Maybe f , _reqFuncName :: FunctionName + , _reqApiType :: TypeRep } deriving instance Eq f => Eq (Req f) @@ -133,7 +135,7 @@ deriving instance Show f => Show (Req f) makeLenses ''Req defReq :: Req ftype -defReq = Req defUrl "GET" [] Nothing Nothing (FunctionName []) +defReq = Req defUrl "GET" [] Nothing Nothing (FunctionName []) (typeOf ()) -- | To be used exclusively as a "negative" return type/constraint -- by @'Elem`@ type family. @@ -196,7 +198,7 @@ instance (HasForeign lang ftype a, HasForeign lang ftype b) foreignFor lang ftype (Proxy :: Proxy a) req :<|> foreignFor lang ftype (Proxy :: Proxy b) req -instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype sublayout) +instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype sublayout, Typeable (Capture sym t :> sublayout)) => HasForeign lang ftype (Capture sym t :> sublayout) where type Foreign ftype (Capture sym a :> sublayout) = Foreign ftype sublayout @@ -204,6 +206,7 @@ instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype su foreignFor lang Proxy (Proxy :: Proxy sublayout) $ req & reqUrl . path <>~ [Segment (Cap arg)] & reqFuncName . _FunctionName %~ (++ ["by", str]) + & reqApiType .~ typeOf (undefined :: Capture sym t :> sublayout) where str = pack . symbolVal $ (Proxy :: Proxy sym) ftype = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy t) @@ -211,7 +214,7 @@ instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype su { _argName = PathSegment str , _argType = ftype } -instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method) +instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method, Typeable (Verb method status list a)) => HasForeign lang ftype (Verb method status list a) where type Foreign ftype (Verb method status list a) = Req ftype @@ -219,17 +222,19 @@ instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method) req & reqFuncName . _FunctionName %~ (methodLC :) & reqMethod .~ method & reqReturnType .~ Just retType + & reqApiType .~ typeOf (undefined :: Verb method status list a) where retType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) method = reflectMethod (Proxy :: Proxy method) methodLC = toLower $ decodeUtf8 method -instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout) +instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout, Typeable (Header sym a :> sublayout)) => HasForeign lang ftype (Header sym a :> sublayout) where type Foreign ftype (Header sym a :> sublayout) = Foreign ftype sublayout foreignFor lang Proxy Proxy req = foreignFor lang Proxy subP $ req & reqHeaders <>~ [HeaderArg arg] + & reqApiType .~ typeOf (undefined :: Header sym a :> sublayout) where hname = pack . symbolVal $ (Proxy :: Proxy sym) arg = Arg @@ -237,13 +242,14 @@ instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype su , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) } subP = Proxy :: Proxy sublayout -instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout) +instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout, Typeable (QueryParam sym a :> sublayout)) => HasForeign lang ftype (QueryParam sym a :> sublayout) where type Foreign ftype (QueryParam sym a :> sublayout) = Foreign ftype sublayout foreignFor lang Proxy Proxy req = foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy sublayout) $ req & reqUrl.queryStr <>~ [QueryArg arg Normal] + & reqApiType .~ typeOf (undefined :: QueryParam sym a :> sublayout) where str = pack . symbolVal $ (Proxy :: Proxy sym) arg = Arg @@ -251,12 +257,13 @@ instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype su , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) } instance - (KnownSymbol sym, HasForeignType lang ftype [a], HasForeign lang ftype sublayout) + (KnownSymbol sym, HasForeignType lang ftype [a], HasForeign lang ftype sublayout, Typeable (QueryParams sym a :> sublayout)) => HasForeign lang ftype (QueryParams sym a :> sublayout) where type Foreign ftype (QueryParams sym a :> sublayout) = Foreign ftype sublayout foreignFor lang Proxy Proxy req = foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy sublayout) $ req & reqUrl.queryStr <>~ [QueryArg arg List] + & reqApiType .~ typeOf (undefined :: QueryParams sym a :> sublayout) where str = pack . symbolVal $ (Proxy :: Proxy sym) arg = Arg @@ -264,13 +271,14 @@ instance , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy [a]) } instance - (KnownSymbol sym, HasForeignType lang ftype Bool, HasForeign lang ftype sublayout) + (KnownSymbol sym, HasForeignType lang ftype Bool, HasForeign lang ftype sublayout, Typeable (QueryFlag sym :> sublayout)) => HasForeign lang ftype (QueryFlag sym :> sublayout) where type Foreign ftype (QueryFlag sym :> sublayout) = Foreign ftype sublayout foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $ req & reqUrl.queryStr <>~ [QueryArg arg Flag] + & reqApiType .~ typeOf (undefined :: QueryFlag sym :> sublayout) where str = pack . symbolVal $ (Proxy :: Proxy sym) arg = Arg @@ -283,16 +291,18 @@ instance HasForeign lang ftype Raw where foreignFor _ Proxy Proxy req method = req & reqFuncName . _FunctionName %~ ((toLower $ decodeUtf8 method) :) & reqMethod .~ method + & reqApiType .~ typeOf (undefined :: Raw) -instance (Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype sublayout) +instance (Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype sublayout, Typeable (ReqBody list a :> sublayout)) => HasForeign lang ftype (ReqBody list a :> sublayout) where type Foreign ftype (ReqBody list a :> sublayout) = Foreign ftype sublayout foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $ req & reqBody .~ (Just $ typeFor lang ftype (Proxy :: Proxy a)) + & reqApiType .~ typeOf (undefined :: ReqBody list a :> sublayout) -instance (KnownSymbol path, HasForeign lang ftype sublayout) +instance (KnownSymbol path, HasForeign lang ftype sublayout, Typeable (path :> sublayout)) => HasForeign lang ftype (path :> sublayout) where type Foreign ftype (path :> sublayout) = Foreign ftype sublayout @@ -300,44 +310,51 @@ instance (KnownSymbol path, HasForeign lang ftype sublayout) foreignFor lang ftype (Proxy :: Proxy sublayout) $ req & reqUrl . path <>~ [Segment (Static (PathSegment str))] & reqFuncName . _FunctionName %~ (++ [str]) + & reqApiType .~ typeOf (undefined :: path :> sublayout) where str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path) -instance HasForeign lang ftype sublayout +instance (HasForeign lang ftype sublayout, Typeable (RemoteHost :> sublayout)) => HasForeign lang ftype (RemoteHost :> sublayout) where type Foreign ftype (RemoteHost :> sublayout) = Foreign ftype sublayout foreignFor lang ftype Proxy req = - foreignFor lang ftype (Proxy :: Proxy sublayout) req + foreignFor lang ftype (Proxy :: Proxy sublayout) $ + req & reqApiType .~ typeOf (undefined :: (RemoteHost :> sublayout)) -instance HasForeign lang ftype sublayout +instance (HasForeign lang ftype sublayout, Typeable (IsSecure :> sublayout)) => HasForeign lang ftype (IsSecure :> sublayout) where type Foreign ftype (IsSecure :> sublayout) = Foreign ftype sublayout foreignFor lang ftype Proxy req = - foreignFor lang ftype (Proxy :: Proxy sublayout) req + foreignFor lang ftype (Proxy :: Proxy sublayout) $ + req & reqApiType .~ typeOf (undefined :: IsSecure :> sublayout) -instance HasForeign lang ftype sublayout => HasForeign lang ftype (Vault :> sublayout) where +instance (HasForeign lang ftype sublayout, Typeable (Vault :> sublayout)) + => HasForeign lang ftype (Vault :> sublayout) where type Foreign ftype (Vault :> sublayout) = Foreign ftype sublayout foreignFor lang ftype Proxy req = - foreignFor lang ftype (Proxy :: Proxy sublayout) req + foreignFor lang ftype (Proxy :: Proxy sublayout) $ + req & reqApiType .~ typeOf (undefined :: Vault :> sublayout) -instance HasForeign lang ftype sublayout => - HasForeign lang ftype (WithNamedContext name context sublayout) where +instance (HasForeign lang ftype sublayout, Typeable (WithNamedContext name context sublayout)) + => HasForeign lang ftype (WithNamedContext name context sublayout) where type Foreign ftype (WithNamedContext name context sublayout) = Foreign ftype sublayout - foreignFor lang ftype Proxy = foreignFor lang ftype (Proxy :: Proxy sublayout) + foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $ + req & reqApiType .~ typeOf (undefined :: WithNamedContext name context sublayout) -instance HasForeign lang ftype sublayout +instance (HasForeign lang ftype sublayout, Typeable (HttpVersion :> sublayout)) => HasForeign lang ftype (HttpVersion :> sublayout) where type Foreign ftype (HttpVersion :> sublayout) = Foreign ftype sublayout foreignFor lang ftype Proxy req = - foreignFor lang ftype (Proxy :: Proxy sublayout) req + foreignFor lang ftype (Proxy :: Proxy sublayout) $ + req & reqApiType .~ typeOf (undefined :: HttpVersion :> sublayout) -- | Utility class used by 'listFromAPI' which computes -- the data needed to generate a function for each endpoint diff --git a/servant-js/src/Servant/JS/JQuery.hs b/servant-js/src/Servant/JS/JQuery.hs index 98038f0c6..91961df9d 100644 --- a/servant-js/src/Servant/JS/JQuery.hs +++ b/servant-js/src/Servant/JS/JQuery.hs @@ -29,7 +29,8 @@ generateJQueryJS = generateJQueryJSWith defCommonGeneratorOptions -- | js codegen using JQuery generateJQueryJSWith :: CommonGeneratorOptions -> AjaxReq -> Text generateJQueryJSWith opts req = "\n" <> - fname <> " = function(" <> argsStr <> ")\n" + jsdocs + <> fname <> " = function(" <> argsStr <> ")\n" <> "{\n" <> " $.ajax(\n" <> " { url: " <> url <> "\n" @@ -101,3 +102,6 @@ generateJQueryJSWith opts req = "\n" <> queryArgs = if null queryparams then "" else " + '?" <> jsParams queryparams + + jsdocs :: Text + jsdocs = "// " <> (T.pack .show $ req ^. reqApiType) <> "\n" From 1a4052eeec3cab5037508b73dda7d7d252a77759 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Mon, 31 Oct 2016 13:00:35 +0100 Subject: [PATCH 2/2] ... --- .../src/Servant/Foreign/Internal.hs | 59 +++++++------------ servant-js/src/Servant/JS/JQuery.hs | 2 +- 2 files changed, 23 insertions(+), 38 deletions(-) diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs index a56c63e44..b9d33ee58 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/servant-foreign/src/Servant/Foreign/Internal.hs @@ -190,15 +190,15 @@ class HasForeign lang ftype (layout :: *) where type Foreign ftype layout :: * foreignFor :: Proxy lang -> Proxy ftype -> Proxy layout -> Req ftype -> Foreign ftype layout -instance (HasForeign lang ftype a, HasForeign lang ftype b) +instance (HasForeign lang ftype a, HasForeign lang ftype b, Typeable a, Typeable b) => HasForeign lang ftype (a :<|> b) where type Foreign ftype (a :<|> b) = Foreign ftype a :<|> Foreign ftype b foreignFor lang ftype Proxy req = - foreignFor lang ftype (Proxy :: Proxy a) req - :<|> foreignFor lang ftype (Proxy :: Proxy b) req + foreignFor lang ftype (Proxy :: Proxy a) (req & reqApiType .~ typeOf (undefined :: a)) + :<|> foreignFor lang ftype (Proxy :: Proxy b) (req & reqApiType .~ typeOf (undefined :: b)) -instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype sublayout, Typeable (Capture sym t :> sublayout)) +instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype sublayout) => HasForeign lang ftype (Capture sym t :> sublayout) where type Foreign ftype (Capture sym a :> sublayout) = Foreign ftype sublayout @@ -206,7 +206,6 @@ instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype su foreignFor lang Proxy (Proxy :: Proxy sublayout) $ req & reqUrl . path <>~ [Segment (Cap arg)] & reqFuncName . _FunctionName %~ (++ ["by", str]) - & reqApiType .~ typeOf (undefined :: Capture sym t :> sublayout) where str = pack . symbolVal $ (Proxy :: Proxy sym) ftype = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy t) @@ -214,7 +213,7 @@ instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype su { _argName = PathSegment str , _argType = ftype } -instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method, Typeable (Verb method status list a)) +instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method) => HasForeign lang ftype (Verb method status list a) where type Foreign ftype (Verb method status list a) = Req ftype @@ -222,19 +221,17 @@ instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method, Typ req & reqFuncName . _FunctionName %~ (methodLC :) & reqMethod .~ method & reqReturnType .~ Just retType - & reqApiType .~ typeOf (undefined :: Verb method status list a) where retType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) method = reflectMethod (Proxy :: Proxy method) methodLC = toLower $ decodeUtf8 method -instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout, Typeable (Header sym a :> sublayout)) +instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout) => HasForeign lang ftype (Header sym a :> sublayout) where type Foreign ftype (Header sym a :> sublayout) = Foreign ftype sublayout foreignFor lang Proxy Proxy req = foreignFor lang Proxy subP $ req & reqHeaders <>~ [HeaderArg arg] - & reqApiType .~ typeOf (undefined :: Header sym a :> sublayout) where hname = pack . symbolVal $ (Proxy :: Proxy sym) arg = Arg @@ -242,14 +239,13 @@ instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype su , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) } subP = Proxy :: Proxy sublayout -instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout, Typeable (QueryParam sym a :> sublayout)) +instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout) => HasForeign lang ftype (QueryParam sym a :> sublayout) where type Foreign ftype (QueryParam sym a :> sublayout) = Foreign ftype sublayout foreignFor lang Proxy Proxy req = foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy sublayout) $ req & reqUrl.queryStr <>~ [QueryArg arg Normal] - & reqApiType .~ typeOf (undefined :: QueryParam sym a :> sublayout) where str = pack . symbolVal $ (Proxy :: Proxy sym) arg = Arg @@ -257,13 +253,12 @@ instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype su , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) } instance - (KnownSymbol sym, HasForeignType lang ftype [a], HasForeign lang ftype sublayout, Typeable (QueryParams sym a :> sublayout)) + (KnownSymbol sym, HasForeignType lang ftype [a], HasForeign lang ftype sublayout) => HasForeign lang ftype (QueryParams sym a :> sublayout) where type Foreign ftype (QueryParams sym a :> sublayout) = Foreign ftype sublayout foreignFor lang Proxy Proxy req = foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy sublayout) $ req & reqUrl.queryStr <>~ [QueryArg arg List] - & reqApiType .~ typeOf (undefined :: QueryParams sym a :> sublayout) where str = pack . symbolVal $ (Proxy :: Proxy sym) arg = Arg @@ -271,14 +266,13 @@ instance , _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy [a]) } instance - (KnownSymbol sym, HasForeignType lang ftype Bool, HasForeign lang ftype sublayout, Typeable (QueryFlag sym :> sublayout)) + (KnownSymbol sym, HasForeignType lang ftype Bool, HasForeign lang ftype sublayout) => HasForeign lang ftype (QueryFlag sym :> sublayout) where type Foreign ftype (QueryFlag sym :> sublayout) = Foreign ftype sublayout foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $ req & reqUrl.queryStr <>~ [QueryArg arg Flag] - & reqApiType .~ typeOf (undefined :: QueryFlag sym :> sublayout) where str = pack . symbolVal $ (Proxy :: Proxy sym) arg = Arg @@ -291,18 +285,16 @@ instance HasForeign lang ftype Raw where foreignFor _ Proxy Proxy req method = req & reqFuncName . _FunctionName %~ ((toLower $ decodeUtf8 method) :) & reqMethod .~ method - & reqApiType .~ typeOf (undefined :: Raw) -instance (Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype sublayout, Typeable (ReqBody list a :> sublayout)) +instance (Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype sublayout) => HasForeign lang ftype (ReqBody list a :> sublayout) where type Foreign ftype (ReqBody list a :> sublayout) = Foreign ftype sublayout foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $ req & reqBody .~ (Just $ typeFor lang ftype (Proxy :: Proxy a)) - & reqApiType .~ typeOf (undefined :: ReqBody list a :> sublayout) -instance (KnownSymbol path, HasForeign lang ftype sublayout, Typeable (path :> sublayout)) +instance (KnownSymbol path, HasForeign lang ftype sublayout) => HasForeign lang ftype (path :> sublayout) where type Foreign ftype (path :> sublayout) = Foreign ftype sublayout @@ -310,51 +302,44 @@ instance (KnownSymbol path, HasForeign lang ftype sublayout, Typeable (path :> s foreignFor lang ftype (Proxy :: Proxy sublayout) $ req & reqUrl . path <>~ [Segment (Static (PathSegment str))] & reqFuncName . _FunctionName %~ (++ [str]) - & reqApiType .~ typeOf (undefined :: path :> sublayout) where str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path) -instance (HasForeign lang ftype sublayout, Typeable (RemoteHost :> sublayout)) +instance HasForeign lang ftype sublayout => HasForeign lang ftype (RemoteHost :> sublayout) where type Foreign ftype (RemoteHost :> sublayout) = Foreign ftype sublayout foreignFor lang ftype Proxy req = - foreignFor lang ftype (Proxy :: Proxy sublayout) $ - req & reqApiType .~ typeOf (undefined :: (RemoteHost :> sublayout)) + foreignFor lang ftype (Proxy :: Proxy sublayout) req -instance (HasForeign lang ftype sublayout, Typeable (IsSecure :> sublayout)) +instance HasForeign lang ftype sublayout => HasForeign lang ftype (IsSecure :> sublayout) where type Foreign ftype (IsSecure :> sublayout) = Foreign ftype sublayout foreignFor lang ftype Proxy req = - foreignFor lang ftype (Proxy :: Proxy sublayout) $ - req & reqApiType .~ typeOf (undefined :: IsSecure :> sublayout) + foreignFor lang ftype (Proxy :: Proxy sublayout) req -instance (HasForeign lang ftype sublayout, Typeable (Vault :> sublayout)) - => HasForeign lang ftype (Vault :> sublayout) where +instance HasForeign lang ftype sublayout => HasForeign lang ftype (Vault :> sublayout) where type Foreign ftype (Vault :> sublayout) = Foreign ftype sublayout foreignFor lang ftype Proxy req = - foreignFor lang ftype (Proxy :: Proxy sublayout) $ - req & reqApiType .~ typeOf (undefined :: Vault :> sublayout) + foreignFor lang ftype (Proxy :: Proxy sublayout) req -instance (HasForeign lang ftype sublayout, Typeable (WithNamedContext name context sublayout)) - => HasForeign lang ftype (WithNamedContext name context sublayout) where +instance HasForeign lang ftype sublayout => + HasForeign lang ftype (WithNamedContext name context sublayout) where type Foreign ftype (WithNamedContext name context sublayout) = Foreign ftype sublayout - foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $ - req & reqApiType .~ typeOf (undefined :: WithNamedContext name context sublayout) + foreignFor lang ftype Proxy = foreignFor lang ftype (Proxy :: Proxy sublayout) -instance (HasForeign lang ftype sublayout, Typeable (HttpVersion :> sublayout)) +instance HasForeign lang ftype sublayout => HasForeign lang ftype (HttpVersion :> sublayout) where type Foreign ftype (HttpVersion :> sublayout) = Foreign ftype sublayout foreignFor lang ftype Proxy req = - foreignFor lang ftype (Proxy :: Proxy sublayout) $ - req & reqApiType .~ typeOf (undefined :: HttpVersion :> sublayout) + foreignFor lang ftype (Proxy :: Proxy sublayout) req -- | Utility class used by 'listFromAPI' which computes -- the data needed to generate a function for each endpoint diff --git a/servant-js/src/Servant/JS/JQuery.hs b/servant-js/src/Servant/JS/JQuery.hs index 91961df9d..b02996158 100644 --- a/servant-js/src/Servant/JS/JQuery.hs +++ b/servant-js/src/Servant/JS/JQuery.hs @@ -104,4 +104,4 @@ generateJQueryJSWith opts req = "\n" <> else " + '?" <> jsParams queryparams jsdocs :: Text - jsdocs = "// " <> (T.pack .show $ req ^. reqApiType) <> "\n" + jsdocs = "// " <> (T.pack . show $ req ^. reqApiType) <> "\n"