diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs index c6ae80a4..25f6c35f 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/servant-foreign/src/Servant/Foreign/Internal.hs @@ -122,144 +122,148 @@ type family Elem (a :: *) (ls::[*]) :: Constraint where Elem a (a ': list) = () Elem a (b ': list) = Elem a list -class HasForeignType a where - typeFor :: Proxy a -> ForeignType +class HasForeignType lang a where + typeFor :: Proxy lang -> Proxy a -> ForeignType -class HasForeign (layout :: *) where +class HasForeign lang (layout :: *) where type Foreign layout :: * - foreignFor :: Proxy layout -> Req -> Foreign layout + foreignFor :: Proxy lang -> Proxy layout -> Req -> Foreign layout -instance (HasForeign a, HasForeign b) - => HasForeign (a :<|> b) where +instance (HasForeign lang a, HasForeign lang b) + => HasForeign lang (a :<|> b) where type Foreign (a :<|> b) = Foreign a :<|> Foreign b - foreignFor Proxy req = - foreignFor (Proxy :: Proxy a) req - :<|> foreignFor (Proxy :: Proxy b) req + foreignFor lang Proxy req = + foreignFor lang (Proxy :: Proxy a) req + :<|> foreignFor lang (Proxy :: Proxy b) req -instance (KnownSymbol sym, HasForeignType a, HasForeign sublayout) - => HasForeign (Capture sym a :> sublayout) where +instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout) + => HasForeign lang (Capture sym a :> sublayout) where type Foreign (Capture sym a :> sublayout) = Foreign sublayout - foreignFor Proxy req = - foreignFor (Proxy :: Proxy sublayout) $ + foreignFor lang Proxy req = + foreignFor lang (Proxy :: Proxy sublayout) $ req & reqUrl.path <>~ [Segment (Cap arg)] & funcName %~ (++ ["by", str]) where str = pack . symbolVal $ (Proxy :: Proxy sym) - arg = (str, typeFor (Proxy :: Proxy a)) + arg = (str, typeFor lang (Proxy :: Proxy a)) -instance (Elem JSON list, HasForeignType a) => HasForeign (Delete list a) where +instance (Elem JSON list, HasForeignType lang a) + => HasForeign lang (Delete list a) where type Foreign (Delete list a) = Req - foreignFor Proxy req = + foreignFor lang Proxy req = req & funcName %~ ("delete" :) & reqMethod .~ "DELETE" & reqReturnType .~ retType where - retType = typeFor (Proxy :: Proxy a) + retType = typeFor lang (Proxy :: Proxy a) -instance (Elem JSON list, HasForeignType a) => HasForeign (Get list a) where +instance (Elem JSON list, HasForeignType lang a) + => HasForeign lang (Get list a) where type Foreign (Get list a) = Req - foreignFor Proxy req = + foreignFor lang Proxy req = req & funcName %~ ("get" :) & reqMethod .~ "GET" & reqReturnType .~ retType where - retType = typeFor (Proxy :: Proxy a) + retType = typeFor lang (Proxy :: Proxy a) -instance (KnownSymbol sym, HasForeignType a, HasForeign sublayout) - => HasForeign (Header sym a :> sublayout) where +instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout) + => HasForeign lang (Header sym a :> sublayout) where type Foreign (Header sym a :> sublayout) = Foreign sublayout - foreignFor Proxy req = - foreignFor subP $ req + foreignFor lang Proxy req = + foreignFor lang subP $ req & reqHeaders <>~ [HeaderArg arg] where hname = pack . symbolVal $ (Proxy :: Proxy sym) - arg = (hname, typeFor (Proxy :: Proxy a)) + arg = (hname, typeFor lang (Proxy :: Proxy a)) subP = Proxy :: Proxy sublayout -instance (Elem JSON list, HasForeignType a) => HasForeign (Post list a) where +instance (Elem JSON list, HasForeignType lang a) + => HasForeign lang (Post list a) where type Foreign (Post list a) = Req - foreignFor Proxy req = + foreignFor lang Proxy req = req & funcName %~ ("post" :) & reqMethod .~ "POST" & reqReturnType .~ retType where - retType = typeFor (Proxy :: Proxy a) + retType = typeFor lang (Proxy :: Proxy a) -instance (Elem JSON list, HasForeignType a) => HasForeign (Put list a) where +instance (Elem JSON list, HasForeignType lang a) + => HasForeign lang (Put list a) where type Foreign (Put list a) = Req - foreignFor Proxy req = + foreignFor lang Proxy req = req & funcName %~ ("put" :) & reqMethod .~ "PUT" & reqReturnType .~ retType where - retType = typeFor (Proxy :: Proxy a) + retType = typeFor lang (Proxy :: Proxy a) -instance (KnownSymbol sym, HasForeignType a, HasForeign sublayout) - => HasForeign (QueryParam sym a :> sublayout) where +instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout) + => HasForeign lang (QueryParam sym a :> sublayout) where type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout - foreignFor Proxy req = - foreignFor (Proxy :: Proxy sublayout) $ + foreignFor lang Proxy req = + foreignFor lang (Proxy :: Proxy sublayout) $ req & reqUrl.queryStr <>~ [QueryArg arg Normal] where str = pack . symbolVal $ (Proxy :: Proxy sym) - arg = (str, typeFor (Proxy :: Proxy a)) + arg = (str, typeFor lang (Proxy :: Proxy a)) -instance (KnownSymbol sym, HasForeignType a, HasForeign sublayout) - => HasForeign (QueryParams sym a :> sublayout) where +instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout) + => HasForeign lang (QueryParams sym a :> sublayout) where type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout - foreignFor Proxy req = - foreignFor (Proxy :: Proxy sublayout) $ + foreignFor lang Proxy req = + foreignFor lang (Proxy :: Proxy sublayout) $ req & reqUrl.queryStr <>~ [QueryArg arg List] where str = pack . symbolVal $ (Proxy :: Proxy sym) - arg = (str, typeFor (Proxy :: Proxy a)) + arg = (str, typeFor lang (Proxy :: Proxy a)) -instance (KnownSymbol sym, HasForeignType a, a ~ Bool, HasForeign sublayout) - => HasForeign (QueryFlag sym :> sublayout) where +instance (KnownSymbol sym, HasForeignType lang a, a ~ Bool, HasForeign lang sublayout) + => HasForeign lang (QueryFlag sym :> sublayout) where type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout - foreignFor Proxy req = - foreignFor (Proxy :: Proxy sublayout) $ + foreignFor lang Proxy req = + foreignFor lang (Proxy :: Proxy sublayout) $ req & reqUrl.queryStr <>~ [QueryArg arg Flag] where str = pack . symbolVal $ (Proxy :: Proxy sym) - arg = (str, typeFor (Proxy :: Proxy a)) + arg = (str, typeFor lang (Proxy :: Proxy a)) -instance HasForeign Raw where +instance HasForeign lang Raw where type Foreign Raw = Method -> Req - foreignFor Proxy req method = + foreignFor _ Proxy req method = req & funcName %~ ((toLower method) :) & reqMethod .~ method -instance (Elem JSON list, HasForeignType a, HasForeign sublayout) - => HasForeign (ReqBody list a :> sublayout) where +instance (Elem JSON list, HasForeignType lang a, HasForeign lang sublayout) + => HasForeign lang (ReqBody list a :> sublayout) where type Foreign (ReqBody list a :> sublayout) = Foreign sublayout - foreignFor Proxy req = - foreignFor (Proxy :: Proxy sublayout) $ - req & reqBody .~ (Just $ typeFor (Proxy :: Proxy a)) + foreignFor lang Proxy req = + foreignFor lang (Proxy :: Proxy sublayout) $ + req & reqBody .~ (Just $ typeFor lang (Proxy :: Proxy a)) -instance (KnownSymbol path, HasForeign sublayout) - => HasForeign (path :> sublayout) where +instance (KnownSymbol path, HasForeign lang sublayout) + => HasForeign lang (path :> sublayout) where type Foreign (path :> sublayout) = Foreign sublayout - foreignFor Proxy req = - foreignFor (Proxy :: Proxy sublayout) $ + foreignFor lang Proxy req = + foreignFor lang (Proxy :: Proxy sublayout) $ req & reqUrl.path <>~ [Segment (Static str)] & funcName %~ (++ [str]) @@ -267,26 +271,26 @@ instance (KnownSymbol path, HasForeign sublayout) str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path) -instance HasForeign sublayout => HasForeign (RemoteHost :> sublayout) where +instance HasForeign lang sublayout => HasForeign lang (RemoteHost :> sublayout) where type Foreign (RemoteHost :> sublayout) = Foreign sublayout - foreignFor Proxy req = - foreignFor (Proxy :: Proxy sublayout) req + foreignFor lang Proxy req = + foreignFor lang (Proxy :: Proxy sublayout) req -instance HasForeign sublayout => HasForeign (IsSecure :> sublayout) where +instance HasForeign lang sublayout => HasForeign lang (IsSecure :> sublayout) where type Foreign (IsSecure :> sublayout) = Foreign sublayout - foreignFor Proxy req = - foreignFor (Proxy :: Proxy sublayout) req + foreignFor lang Proxy req = + foreignFor lang (Proxy :: Proxy sublayout) req -instance HasForeign sublayout => HasForeign (Vault :> sublayout) where +instance HasForeign lang sublayout => HasForeign lang (Vault :> sublayout) where type Foreign (Vault :> sublayout) = Foreign sublayout - foreignFor Proxy req = - foreignFor (Proxy :: Proxy sublayout) req + foreignFor lang Proxy req = + foreignFor lang (Proxy :: Proxy sublayout) req -instance HasForeign sublayout => HasForeign (HttpVersion :> sublayout) where +instance HasForeign lang sublayout => HasForeign lang (HttpVersion :> sublayout) where type Foreign (HttpVersion :> sublayout) = Foreign sublayout - foreignFor Proxy req = - foreignFor (Proxy :: Proxy sublayout) req + foreignFor lang Proxy req = + foreignFor lang (Proxy :: Proxy sublayout) req diff --git a/servant-js/src/Servant/JS.hs b/servant-js/src/Servant/JS.hs index 77002552..d25706ec 100644 --- a/servant-js/src/Servant/JS.hs +++ b/servant-js/src/Servant/JS.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : Servant.JS @@ -122,16 +123,19 @@ import Servant.JS.Internal import Servant.JS.JQuery import Servant.JS.Vanilla +-- Dummy type specifying target language +data LangJS + -- | Generate the data necessary to generate javascript code -- for all the endpoints of an API, as ':<|>'-separated values -- of type 'AjaxReq'. -javascript :: HasForeign layout => Proxy layout -> Foreign layout -javascript p = foreignFor p defReq +javascript :: HasForeign LangJS layout => Proxy layout -> Foreign layout +javascript p = foreignFor (Proxy :: Proxy LangJS) p defReq -- | Directly generate all the javascript functions for your API -- from a 'Proxy' for your API type. You can then write it to -- a file or integrate it in a page, for example. -jsForAPI :: (HasForeign api, GenerateList (Foreign api)) +jsForAPI :: (HasForeign LangJS api, GenerateList (Foreign api)) => Proxy api -- ^ proxy for your API type -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others) -> Text -- ^ a text that you can embed in your pages or write to a file @@ -140,7 +144,7 @@ jsForAPI p gen = gen (listFromAPI p) -- | Directly generate all the javascript functions for your API -- from a 'Proxy' for your API type using the given generator -- and write the resulting code to a file at the given path. -writeJSForAPI :: (HasForeign api, GenerateList (Foreign api)) +writeJSForAPI :: (HasForeign LangJS api, GenerateList (Foreign api)) => Proxy api -- ^ proxy for your API type -> JavaScriptGenerator -- ^ js code generator to use (angular, vanilla js, jquery, others) -> FilePath -- ^ path to the file you want to write the resulting javascript code into @@ -148,8 +152,8 @@ writeJSForAPI :: (HasForeign api, GenerateList (Foreign api)) writeJSForAPI p gen fp = writeFile fp (jsForAPI p gen) -- A catch all instance since JavaScript has no types. -instance HasForeignType a where - typeFor _ = empty +instance HasForeignType LangJS a where + typeFor _ _ = empty -- | Utility class used by 'jsForAPI' which computes -- the data needed to generate a function for each endpoint @@ -165,6 +169,6 @@ instance (GenerateList start, GenerateList rest) => GenerateList (start :<|> res -- | Generate the necessary data for JS codegen as a list, each 'AjaxReq' -- describing one endpoint from your API type. -listFromAPI :: (HasForeign api, GenerateList (Foreign api)) => Proxy api -> [AjaxReq] +listFromAPI :: (HasForeign LangJS api, GenerateList (Foreign api)) => Proxy api -> [AjaxReq] listFromAPI p = generateList (javascript p) diff --git a/servant-js/test/Servant/JSSpec/CustomHeaders.hs b/servant-js/test/Servant/JSSpec/CustomHeaders.hs index 862eb09b..150436e3 100644 --- a/servant-js/test/Servant/JSSpec/CustomHeaders.hs +++ b/servant-js/test/Servant/JSSpec/CustomHeaders.hs @@ -6,6 +6,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiParamTypeClasses #-} module Servant.JSSpec.CustomHeaders where @@ -21,11 +22,11 @@ import Servant.JS.Internal -- using -- Basic, Digest, whatever. data Authorization (sym :: Symbol) a -instance (KnownSymbol sym, HasForeign sublayout) - => HasForeign (Authorization sym a :> sublayout) where +instance (KnownSymbol sym, HasForeign lang sublayout) + => HasForeign lang (Authorization sym a :> sublayout) where type Foreign (Authorization sym a :> sublayout) = Foreign sublayout - foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ + foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $ req & reqHeaders <>~ [ ReplaceHeaderArg ("Authorization", "") $ tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ] where @@ -34,11 +35,11 @@ instance (KnownSymbol sym, HasForeign sublayout) -- | This is a combinator that fetches an X-MyLovelyHorse header. data MyLovelyHorse a -instance (HasForeign sublayout) - => HasForeign (MyLovelyHorse a :> sublayout) where +instance (HasForeign lang sublayout) + => HasForeign lang (MyLovelyHorse a :> sublayout) where type Foreign (MyLovelyHorse a :> sublayout) = Foreign sublayout - foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ + foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $ req & reqHeaders <>~ [ ReplaceHeaderArg ("X-MyLovelyHorse", "") tpl ] where tpl = "I am good friends with {X-MyLovelyHorse}" @@ -46,11 +47,11 @@ instance (HasForeign sublayout) -- | This is a combinator that fetches an X-WhatsForDinner header. data WhatsForDinner a -instance (HasForeign sublayout) - => HasForeign (WhatsForDinner a :> sublayout) where +instance (HasForeign lang sublayout) + => HasForeign lang (WhatsForDinner a :> sublayout) where type Foreign (WhatsForDinner a :> sublayout) = Foreign sublayout - foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ + foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) $ req & reqHeaders <>~ [ ReplaceHeaderArg ("X-WhatsForDinner", "") tpl ] where tpl = "I would like {X-WhatsForDinner} with a cherry on top."