From 8932cb242cfad24ca5f61059e2aef823f1f40ff5 Mon Sep 17 00:00:00 2001 From: Maksymilian Owsianny Date: Sat, 28 Nov 2015 08:13:26 +0000 Subject: [PATCH 01/10] Add access to types in servant-foreign. --- servant-foreign/src/Servant/Foreign.hs | 2 + .../src/Servant/Foreign/Internal.hs | 99 ++++++++++++------- 2 files changed, 67 insertions(+), 34 deletions(-) diff --git a/servant-foreign/src/Servant/Foreign.hs b/servant-foreign/src/Servant/Foreign.hs index 3baa9887..087284ce 100644 --- a/servant-foreign/src/Servant/Foreign.hs +++ b/servant-foreign/src/Servant/Foreign.hs @@ -2,6 +2,7 @@ -- arbitrary programming languages. module Servant.Foreign ( HasForeign(..) + , HasForeignType(..) , Segment(..) , SegmentType(..) , FunctionName @@ -24,6 +25,7 @@ module Servant.Foreign , reqBody , reqHeaders , reqMethod + , reqReturnType , segment , queryStr -- re-exports diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs index 1aa92af4..c6ae80a4 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/servant-foreign/src/Servant/Foreign/Internal.hs @@ -45,7 +45,8 @@ camelCase = camelCase' . Prelude.map (replace "-" "") capitalize "" = "" capitalize name = C.toUpper (Data.Text.head name) `cons` Data.Text.tail name -type Arg = Text +type ForeignType = Text +type Arg = (Text, ForeignType) newtype Segment = Segment { _segment :: SegmentType } deriving (Eq, Show) @@ -68,10 +69,10 @@ data QueryArg = QueryArg } deriving (Eq, Show) data HeaderArg = HeaderArg - { headerArgName :: Text + { headerArg :: Arg } | ReplaceHeaderArg - { headerArgName :: Text + { headerArg :: Arg , headerPattern :: Text } deriving (Eq, Show) @@ -88,11 +89,12 @@ type FunctionName = [Text] type Method = Text data Req = Req - { _reqUrl :: Url - , _reqMethod :: Method - , _reqHeaders :: [HeaderArg] - , _reqBody :: Bool - , _funcName :: FunctionName + { _reqUrl :: Url + , _reqMethod :: Method + , _reqHeaders :: [HeaderArg] + , _reqBody :: Maybe ForeignType + , _reqReturnType :: ForeignType + , _funcName :: FunctionName } deriving (Eq, Show) makeLenses ''QueryArg @@ -109,7 +111,7 @@ captureArg (Segment (Cap s)) = s captureArg _ = error "captureArg called on non capture" defReq :: Req -defReq = Req defUrl "GET" [] False [] +defReq = Req defUrl "GET" [] Nothing "" [] -- | To be used exclusively as a "negative" return type/constraint -- by @'Elem`@ type family. @@ -120,6 +122,9 @@ 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 HasForeign (layout :: *) where type Foreign layout :: * foreignFor :: Proxy layout -> Req -> Foreign layout @@ -132,84 +137,107 @@ instance (HasForeign a, HasForeign b) foreignFor (Proxy :: Proxy a) req :<|> foreignFor (Proxy :: Proxy b) req -instance (KnownSymbol sym, HasForeign sublayout) +instance (KnownSymbol sym, HasForeignType a, HasForeign sublayout) => HasForeign (Capture sym a :> sublayout) where type Foreign (Capture sym a :> sublayout) = Foreign sublayout foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ - req & reqUrl.path <>~ [Segment (Cap str)] + req & reqUrl.path <>~ [Segment (Cap arg)] & funcName %~ (++ ["by", str]) - where str = pack . symbolVal $ (Proxy :: Proxy sym) + where + str = pack . symbolVal $ (Proxy :: Proxy sym) + arg = (str, typeFor (Proxy :: Proxy a)) -instance Elem JSON list => HasForeign (Delete list a) where +instance (Elem JSON list, HasForeignType a) => HasForeign (Delete list a) where type Foreign (Delete list a) = Req foreignFor Proxy req = - req & funcName %~ ("delete" :) - & reqMethod .~ "DELETE" + req & funcName %~ ("delete" :) + & reqMethod .~ "DELETE" + & reqReturnType .~ retType + where + retType = typeFor (Proxy :: Proxy a) -instance Elem JSON list => HasForeign (Get list a) where +instance (Elem JSON list, HasForeignType a) => HasForeign (Get list a) where type Foreign (Get list a) = Req foreignFor Proxy req = req & funcName %~ ("get" :) & reqMethod .~ "GET" + & reqReturnType .~ retType + where + retType = typeFor (Proxy :: Proxy a) -instance (KnownSymbol sym, HasForeign sublayout) +instance (KnownSymbol sym, HasForeignType a, HasForeign sublayout) => HasForeign (Header sym a :> sublayout) where type Foreign (Header sym a :> sublayout) = Foreign sublayout foreignFor Proxy req = - foreignFor subP (req & reqHeaders <>~ [HeaderArg hname]) + foreignFor subP $ req + & reqHeaders <>~ [HeaderArg arg] - where hname = pack . symbolVal $ (Proxy :: Proxy sym) - subP = Proxy :: Proxy sublayout + where + hname = pack . symbolVal $ (Proxy :: Proxy sym) + arg = (hname, typeFor (Proxy :: Proxy a)) + subP = Proxy :: Proxy sublayout -instance Elem JSON list => HasForeign (Post list a) where +instance (Elem JSON list, HasForeignType a) => HasForeign (Post list a) where type Foreign (Post list a) = Req foreignFor Proxy req = req & funcName %~ ("post" :) & reqMethod .~ "POST" + & reqReturnType .~ retType + where + retType = typeFor (Proxy :: Proxy a) -instance Elem JSON list => HasForeign (Put list a) where +instance (Elem JSON list, HasForeignType a) => HasForeign (Put list a) where type Foreign (Put list a) = Req foreignFor Proxy req = req & funcName %~ ("put" :) & reqMethod .~ "PUT" + & reqReturnType .~ retType + where + retType = typeFor (Proxy :: Proxy a) -instance (KnownSymbol sym, HasForeign sublayout) +instance (KnownSymbol sym, HasForeignType a, HasForeign sublayout) => HasForeign (QueryParam sym a :> sublayout) where type Foreign (QueryParam sym a :> sublayout) = Foreign sublayout foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ - req & reqUrl.queryStr <>~ [QueryArg str Normal] + req & reqUrl.queryStr <>~ [QueryArg arg Normal] - where str = pack . symbolVal $ (Proxy :: Proxy sym) + where + str = pack . symbolVal $ (Proxy :: Proxy sym) + arg = (str, typeFor (Proxy :: Proxy a)) -instance (KnownSymbol sym, HasForeign sublayout) +instance (KnownSymbol sym, HasForeignType a, HasForeign sublayout) => HasForeign (QueryParams sym a :> sublayout) where type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ - req & reqUrl.queryStr <>~ [QueryArg str List] + req & reqUrl.queryStr <>~ [QueryArg arg List] - where str = pack . symbolVal $ (Proxy :: Proxy sym) + where + str = pack . symbolVal $ (Proxy :: Proxy sym) + arg = (str, typeFor (Proxy :: Proxy a)) -instance (KnownSymbol sym, HasForeign sublayout) +instance (KnownSymbol sym, HasForeignType a, a ~ Bool, HasForeign sublayout) => HasForeign (QueryFlag sym :> sublayout) where type Foreign (QueryFlag sym :> sublayout) = Foreign sublayout foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ - req & reqUrl.queryStr <>~ [QueryArg str Flag] + req & reqUrl.queryStr <>~ [QueryArg arg Flag] - where str = pack . symbolVal $ (Proxy :: Proxy sym) + where + str = pack . symbolVal $ (Proxy :: Proxy sym) + arg = (str, typeFor (Proxy :: Proxy a)) instance HasForeign Raw where type Foreign Raw = Method -> Req @@ -218,12 +246,13 @@ instance HasForeign Raw where req & funcName %~ ((toLower method) :) & reqMethod .~ method -instance (Elem JSON list, HasForeign sublayout) => HasForeign (ReqBody list a :> sublayout) where +instance (Elem JSON list, HasForeignType a, HasForeign sublayout) + => HasForeign (ReqBody list a :> sublayout) where type Foreign (ReqBody list a :> sublayout) = Foreign sublayout foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ - req & reqBody .~ True + req & reqBody .~ (Just $ typeFor (Proxy :: Proxy a)) instance (KnownSymbol path, HasForeign sublayout) => HasForeign (path :> sublayout) where @@ -234,7 +263,9 @@ instance (KnownSymbol path, HasForeign sublayout) req & reqUrl.path <>~ [Segment (Static str)] & funcName %~ (++ [str]) - where str = Data.Text.map (\c -> if c == '.' then '_' else c) . pack . symbolVal $ (Proxy :: Proxy path) + where + str = Data.Text.map (\c -> if c == '.' then '_' else c) + . pack . symbolVal $ (Proxy :: Proxy path) instance HasForeign sublayout => HasForeign (RemoteHost :> sublayout) where type Foreign (RemoteHost :> sublayout) = Foreign sublayout From 0b37222733eab874b98900af3e788716a3d9efec Mon Sep 17 00:00:00 2001 From: Maksymilian Owsianny Date: Sat, 28 Nov 2015 08:24:55 +0000 Subject: [PATCH 02/10] Fix servant-js based on changes to servant-foreign. --- servant-js/src/Servant/JS.hs | 4 ++++ servant-js/src/Servant/JS/Angular.hs | 13 +++++++------ servant-js/src/Servant/JS/Axios.hs | 13 +++++++------ servant-js/src/Servant/JS/Internal.hs | 13 +++++++------ servant-js/src/Servant/JS/JQuery.hs | 13 +++++++------ servant-js/src/Servant/JS/Vanilla.hs | 13 +++++++------ servant-js/test/Servant/JSSpec/CustomHeaders.hs | 6 +++--- 7 files changed, 42 insertions(+), 33 deletions(-) diff --git a/servant-js/src/Servant/JS.hs b/servant-js/src/Servant/JS.hs index db821ffe..77002552 100644 --- a/servant-js/src/Servant/JS.hs +++ b/servant-js/src/Servant/JS.hs @@ -147,6 +147,10 @@ writeJSForAPI :: (HasForeign api, GenerateList (Foreign api)) -> IO () writeJSForAPI p gen fp = writeFile fp (jsForAPI p gen) +-- A catch all instance since JavaScript has no types. +instance HasForeignType a where + typeFor _ = empty + -- | Utility class used by 'jsForAPI' which computes -- the data needed to generate a function for each endpoint -- and hands it all back in a list. diff --git a/servant-js/src/Servant/JS/Angular.hs b/servant-js/src/Servant/JS/Angular.hs index da520cb7..2f1b42fb 100644 --- a/servant-js/src/Servant/JS/Angular.hs +++ b/servant-js/src/Servant/JS/Angular.hs @@ -2,6 +2,7 @@ module Servant.JS.Angular where import Control.Lens +import Data.Maybe (isJust) import Data.Monoid import qualified Data.Text as T import Data.Text (Text) @@ -74,9 +75,9 @@ generateAngularJSWith ngOptions opts req = "\n" <> where argsStr = T.intercalate ", " args args = http ++ captures - ++ map (view argName) queryparams + ++ map (view $ argName._1) queryparams ++ body - ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs + ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs -- If we want to generate Top Level Function, they must depend on -- the $http service, if we generate a service, the functions will @@ -85,7 +86,7 @@ generateAngularJSWith ngOptions opts req = "\n" <> 0 -> ["$http"] _ -> [] - captures = map captureArg + captures = map (fst . captureArg) . filter isCapture $ req ^. reqUrl.path @@ -93,12 +94,12 @@ generateAngularJSWith ngOptions opts req = "\n" <> queryparams = req ^.. reqUrl.queryStr.traverse - body = if req ^. reqBody + body = if isJust (req ^. reqBody) then [requestBody opts] else [] dataBody = - if req ^. reqBody + if isJust (req ^. reqBody) then " , data: JSON.stringify(body)\n" <> " , contentType: 'application/json'\n" else "" @@ -110,7 +111,7 @@ generateAngularJSWith ngOptions opts req = "\n" <> where headersStr = T.intercalate ", " $ map headerStr hs headerStr header = "\"" <> - headerArgName header <> + fst (headerArg header) <> "\": " <> toJSHeader header namespace = diff --git a/servant-js/src/Servant/JS/Axios.hs b/servant-js/src/Servant/JS/Axios.hs index 8a118769..50bed9eb 100644 --- a/servant-js/src/Servant/JS/Axios.hs +++ b/servant-js/src/Servant/JS/Axios.hs @@ -2,6 +2,7 @@ module Servant.JS.Axios where import Control.Lens +import Data.Maybe (isJust) import Data.Monoid import Data.Text (Text) import qualified Data.Text as T @@ -60,11 +61,11 @@ generateAxiosJSWith aopts opts req = "\n" <> where argsStr = T.intercalate ", " args args = captures - ++ map (view argName) queryparams + ++ map (view $ argName._1) queryparams ++ body - ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs + ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs - captures = map captureArg + captures = map (fst . captureArg) . filter isCapture $ req ^. reqUrl.path @@ -72,12 +73,12 @@ generateAxiosJSWith aopts opts req = "\n" <> queryparams = req ^.. reqUrl.queryStr.traverse - body = if req ^. reqBody + body = if isJust (req ^. reqBody) then [requestBody opts] else [] dataBody = - if req ^. reqBody + if isJust (req ^. reqBody) then " , data: body\n" <> " , responseType: 'json'\n" else "" @@ -104,7 +105,7 @@ generateAxiosJSWith aopts opts req = "\n" <> where headersStr = T.intercalate ", " $ map headerStr hs headerStr header = "\"" <> - headerArgName header <> + fst (headerArg header) <> "\": " <> toJSHeader header namespace = diff --git a/servant-js/src/Servant/JS/Internal.hs b/servant-js/src/Servant/JS/Internal.hs index a5cb527c..481536ad 100644 --- a/servant-js/src/Servant/JS/Internal.hs +++ b/servant-js/src/Servant/JS/Internal.hs @@ -18,6 +18,7 @@ module Servant.JS.Internal , defReq , reqHeaders , HasForeign(..) + , HasForeignType(..) , HeaderArg(..) , concatCase , snakeCase @@ -31,7 +32,7 @@ module Servant.JS.Internal , Header ) where -import Control.Lens ((^.)) +import Control.Lens ((^.), _1) import qualified Data.CharSet as Set import qualified Data.CharSet.Unicode.Category as Set import Data.Monoid @@ -115,7 +116,7 @@ toValidFunctionName t = ] toJSHeader :: HeaderArg -> Text -toJSHeader (HeaderArg n) = toValidFunctionName ("header" <> n) +toJSHeader (HeaderArg n) = toValidFunctionName ("header" <> fst n) toJSHeader (ReplaceHeaderArg n p) | pn `T.isPrefixOf` p = pv <> " + \"" <> rp <> "\"" | pn `T.isSuffixOf` p = "\"" <> rp <> "\" + " <> pv @@ -123,8 +124,8 @@ toJSHeader (ReplaceHeaderArg n p) <> "\"" | otherwise = p where - pv = toValidFunctionName ("header" <> n) - pn = "{" <> n <> "}" + pv = toValidFunctionName ("header" <> fst n) + pn = "{" <> fst n <> "}" rp = T.replace pn "" p jsSegments :: [Segment] -> Text @@ -138,7 +139,7 @@ segmentToStr (Segment st) notTheEnd = segmentTypeToStr :: SegmentType -> Text segmentTypeToStr (Static s) = s -segmentTypeToStr (Cap s) = "' + encodeURIComponent(" <> s <> ") + '" +segmentTypeToStr (Cap s) = "' + encodeURIComponent(" <> fst s <> ") + '" jsGParams :: Text -> [QueryArg] -> Text jsGParams _ [] = "" @@ -160,4 +161,4 @@ paramToStr qarg notTheEnd = <> "[]=' + encodeURIComponent(" <> name <> if notTheEnd then ") + '" else ")" - where name = qarg ^. argName + where name = qarg ^. argName . _1 diff --git a/servant-js/src/Servant/JS/JQuery.hs b/servant-js/src/Servant/JS/JQuery.hs index e3a6ee29..722d9c07 100644 --- a/servant-js/src/Servant/JS/JQuery.hs +++ b/servant-js/src/Servant/JS/JQuery.hs @@ -2,6 +2,7 @@ module Servant.JS.JQuery where import Control.Lens +import Data.Maybe (isJust) import Data.Monoid import qualified Data.Text as T import Data.Text (Text) @@ -40,12 +41,12 @@ generateJQueryJSWith opts req = "\n" <> where argsStr = T.intercalate ", " args args = captures - ++ map (view argName) queryparams + ++ map (view $ argName._1) queryparams ++ body - ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs + ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs ++ [onSuccess, onError] - captures = map captureArg + captures = map (fst . captureArg) . filter isCapture $ req ^. reqUrl.path @@ -53,7 +54,7 @@ generateJQueryJSWith opts req = "\n" <> queryparams = req ^.. reqUrl.queryStr.traverse - body = if req ^. reqBody + body = if isJust (req ^. reqBody) then [requestBody opts] else [] @@ -61,7 +62,7 @@ generateJQueryJSWith opts req = "\n" <> onError = errorCallback opts dataBody = - if req ^. reqBody + if isJust $ req ^. reqBody then " , data: JSON.stringify(body)\n" <> " , contentType: 'application/json'\n" else "" @@ -73,7 +74,7 @@ generateJQueryJSWith opts req = "\n" <> where headersStr = T.intercalate ", " $ map headerStr hs headerStr header = "\"" <> - headerArgName header <> + fst (headerArg header) <> "\": " <> toJSHeader header namespace = if (moduleName opts) == "" diff --git a/servant-js/src/Servant/JS/Vanilla.hs b/servant-js/src/Servant/JS/Vanilla.hs index 7a6d6da5..7313f540 100644 --- a/servant-js/src/Servant/JS/Vanilla.hs +++ b/servant-js/src/Servant/JS/Vanilla.hs @@ -2,6 +2,7 @@ module Servant.JS.Vanilla where import Control.Lens +import Data.Maybe (isJust) import Data.Text (Text) import qualified Data.Text as T import Data.Monoid @@ -47,12 +48,12 @@ generateVanillaJSWith opts req = "\n" <> where argsStr = T.intercalate ", " args args = captures - ++ map (view argName) queryparams + ++ map (view $ argName._1) queryparams ++ body - ++ map (toValidFunctionName . (<>) "header" . headerArgName) hs + ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs ++ [onSuccess, onError] - captures = map captureArg + captures = map (fst . captureArg) . filter isCapture $ req ^. reqUrl.path @@ -60,7 +61,7 @@ generateVanillaJSWith opts req = "\n" <> queryparams = req ^.. reqUrl.queryStr.traverse - body = if req ^. reqBody + body = if isJust(req ^. reqBody) then [requestBody opts] else [] @@ -68,7 +69,7 @@ generateVanillaJSWith opts req = "\n" <> onError = errorCallback opts dataBody = - if req ^. reqBody + if isJust (req ^. reqBody) then "JSON.stringify(body)\n" else "null" @@ -80,7 +81,7 @@ generateVanillaJSWith opts req = "\n" <> where headersStr = T.intercalate "\n" $ map headerStr hs headerStr header = " xhr.setRequestHeader(\"" <> - headerArgName header <> + fst (headerArg header) <> "\", " <> toJSHeader header <> ");" namespace = if moduleName opts == "" diff --git a/servant-js/test/Servant/JSSpec/CustomHeaders.hs b/servant-js/test/Servant/JSSpec/CustomHeaders.hs index fd72672e..862eb09b 100644 --- a/servant-js/test/Servant/JSSpec/CustomHeaders.hs +++ b/servant-js/test/Servant/JSSpec/CustomHeaders.hs @@ -26,7 +26,7 @@ instance (KnownSymbol sym, HasForeign sublayout) type Foreign (Authorization sym a :> sublayout) = Foreign sublayout foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ - req & reqHeaders <>~ [ ReplaceHeaderArg "Authorization" $ + req & reqHeaders <>~ [ ReplaceHeaderArg ("Authorization", "") $ tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ] where tokenType t = t <> " {Authorization}" @@ -39,7 +39,7 @@ instance (HasForeign sublayout) type Foreign (MyLovelyHorse a :> sublayout) = Foreign sublayout foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ - req & reqHeaders <>~ [ ReplaceHeaderArg "X-MyLovelyHorse" tpl ] + req & reqHeaders <>~ [ ReplaceHeaderArg ("X-MyLovelyHorse", "") tpl ] where tpl = "I am good friends with {X-MyLovelyHorse}" @@ -51,6 +51,6 @@ instance (HasForeign sublayout) type Foreign (WhatsForDinner a :> sublayout) = Foreign sublayout foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ - req & reqHeaders <>~ [ ReplaceHeaderArg "X-WhatsForDinner" tpl ] + req & reqHeaders <>~ [ ReplaceHeaderArg ("X-WhatsForDinner", "") tpl ] where tpl = "I would like {X-WhatsForDinner} with a cherry on top." From 69f09f26222014124d0c40a31faf1cfab317fa64 Mon Sep 17 00:00:00 2001 From: Maksymilian Owsianny Date: Sun, 29 Nov 2015 04:53:50 +0000 Subject: [PATCH 03/10] Added lang parameter. --- .../src/Servant/Foreign/Internal.hs | 142 +++++++++--------- servant-js/src/Servant/JS.hs | 18 ++- .../test/Servant/JSSpec/CustomHeaders.hs | 19 +-- 3 files changed, 94 insertions(+), 85 deletions(-) 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." From 2d8db459077df2915e19de41690561bcf51f9b74 Mon Sep 17 00:00:00 2001 From: Maksymilian Owsianny Date: Wed, 2 Dec 2015 11:21:37 +0000 Subject: [PATCH 04/10] Moved GenerateList to servant-foreign. --- servant-foreign/src/Servant/Foreign.hs | 2 ++ .../src/Servant/Foreign/Internal.hs | 18 +++++++++++++++++ servant-js/src/Servant/JS.hs | 20 ++----------------- 3 files changed, 22 insertions(+), 18 deletions(-) diff --git a/servant-foreign/src/Servant/Foreign.hs b/servant-foreign/src/Servant/Foreign.hs index 087284ce..cfa1acba 100644 --- a/servant-foreign/src/Servant/Foreign.hs +++ b/servant-foreign/src/Servant/Foreign.hs @@ -28,6 +28,8 @@ module Servant.Foreign , reqReturnType , segment , queryStr + , listFromAPI + , GenerateList(..) -- re-exports , module Servant.API ) where diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs index 25f6c35f..349b0c71 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/servant-foreign/src/Servant/Foreign/Internal.hs @@ -294,3 +294,21 @@ instance HasForeign lang sublayout => HasForeign lang (HttpVersion :> sublayout) foreignFor lang Proxy req = foreignFor lang (Proxy :: Proxy sublayout) req + +-- | Utility class used by 'listFromAPI' which computes +-- the data needed to generate a function for each endpoint +-- and hands it all back in a list. +class GenerateList reqs where + generateList :: reqs -> [Req] + +instance GenerateList Req where + generateList r = [r] + +instance (GenerateList start, GenerateList rest) => GenerateList (start :<|> rest) where + generateList (start :<|> rest) = (generateList start) ++ (generateList rest) + +-- | Generate the necessary data for codegen as a list, each 'Req' +-- describing one endpoint from your API type. +listFromAPI :: (HasForeign lang api, GenerateList (Foreign api)) => Proxy lang -> Proxy api -> [Req] +listFromAPI lang p = generateList (foreignFor lang p defReq) + diff --git a/servant-js/src/Servant/JS.hs b/servant-js/src/Servant/JS.hs index d25706ec..b2e63ca3 100644 --- a/servant-js/src/Servant/JS.hs +++ b/servant-js/src/Servant/JS.hs @@ -122,6 +122,7 @@ import Servant.JS.Axios import Servant.JS.Internal import Servant.JS.JQuery import Servant.JS.Vanilla +import Servant.Foreign (GenerateList(..), listFromAPI) -- Dummy type specifying target language data LangJS @@ -139,7 +140,7 @@ 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 -jsForAPI p gen = gen (listFromAPI p) +jsForAPI p gen = gen (listFromAPI (Proxy :: Proxy LangJS) p) -- | Directly generate all the javascript functions for your API -- from a 'Proxy' for your API type using the given generator @@ -155,20 +156,3 @@ writeJSForAPI p gen fp = writeFile fp (jsForAPI p gen) instance HasForeignType LangJS a where typeFor _ _ = empty --- | Utility class used by 'jsForAPI' which computes --- the data needed to generate a function for each endpoint --- and hands it all back in a list. -class GenerateList reqs where - generateList :: reqs -> [AjaxReq] - -instance GenerateList AjaxReq where - generateList r = [r] - -instance (GenerateList start, GenerateList rest) => GenerateList (start :<|> rest) where - generateList (start :<|> rest) = (generateList start) ++ (generateList rest) - --- | Generate the necessary data for JS codegen as a list, each 'AjaxReq' --- describing one endpoint from your API type. -listFromAPI :: (HasForeign LangJS api, GenerateList (Foreign api)) => Proxy api -> [AjaxReq] -listFromAPI p = generateList (javascript p) - From e56fc650c2a42cfe1a2d61657aee253307b98a54 Mon Sep 17 00:00:00 2001 From: Maksymilian Owsianny Date: Wed, 2 Dec 2015 12:28:04 +0000 Subject: [PATCH 05/10] Added test spec for servant-foreign. --- .../src/Servant/Foreign/Internal.hs | 4 +- servant-foreign/test/Servant/ForeignSpec.hs | 95 ++++++++++++++++++- 2 files changed, 96 insertions(+), 3 deletions(-) diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs index 349b0c71..f9db7bb3 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/servant-foreign/src/Servant/Foreign/Internal.hs @@ -219,7 +219,7 @@ instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout) str = pack . symbolVal $ (Proxy :: Proxy sym) arg = (str, typeFor lang (Proxy :: Proxy a)) -instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout) +instance (KnownSymbol sym, HasForeignType lang [a], HasForeign lang sublayout) => HasForeign lang (QueryParams sym a :> sublayout) where type Foreign (QueryParams sym a :> sublayout) = Foreign sublayout @@ -229,7 +229,7 @@ instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout) where str = pack . symbolVal $ (Proxy :: Proxy sym) - arg = (str, typeFor lang (Proxy :: Proxy a)) + arg = (str, typeFor lang (Proxy :: Proxy [a])) instance (KnownSymbol sym, HasForeignType lang a, a ~ Bool, HasForeign lang sublayout) => HasForeign lang (QueryFlag sym :> sublayout) where diff --git a/servant-foreign/test/Servant/ForeignSpec.hs b/servant-foreign/test/Servant/ForeignSpec.hs index 0b94991a..ec8b1dce 100644 --- a/servant-foreign/test/Servant/ForeignSpec.hs +++ b/servant-foreign/test/Servant/ForeignSpec.hs @@ -1,17 +1,110 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} module Servant.ForeignSpec where -import Servant.Foreign (camelCase) +import Data.Monoid ((<>)) +import Data.Proxy +import Servant.Foreign +import Servant.Foreign.Internal import Test.Hspec spec :: Spec spec = describe "Servant.Foreign" $ do camelCaseSpec + listFromAPISpec camelCaseSpec :: Spec camelCaseSpec = describe "camelCase" $ do it "converts FunctionNames to camelCase" $ do camelCase ["post", "counter", "inc"] `shouldBe` "postCounterInc" camelCase ["get", "hyphen-ated", "counter"] `shouldBe` "getHyphenatedCounter" + +---------------------------------------------------------------------- + +data LangX + +instance HasForeignType LangX () where + typeFor _ _ = "voidX" +instance HasForeignType LangX Int where + typeFor _ _ = "intX" +instance HasForeignType LangX Bool where + typeFor _ _ = "boolX" +instance {-# Overlapping #-} HasForeignType LangX String where + typeFor _ _ = "stringX" +instance {-# Overlapable #-} HasForeignType LangX a => HasForeignType LangX [a] where + typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a) + +type TestApi + = "test" :> Header "header" [String] :> QueryFlag "flag" :> Get '[JSON] Int + :<|> "test" :> QueryParam "param" Int :> ReqBody '[JSON] [String] :> Post '[JSON] () + :<|> "test" :> QueryParams "params" Int :> ReqBody '[JSON] String :> Put '[JSON] () + :<|> "test" :> Capture "id" Int :> Delete '[JSON] () + +testApi :: [Req] +testApi = listFromAPI (Proxy :: Proxy LangX) (Proxy :: Proxy TestApi) + +listFromAPISpec :: Spec +listFromAPISpec = describe "listFromAPI" $ do + it "generates 4 endpoints for TestApi" $ do + length testApi `shouldBe` 4 + + let [getReq, postReq, putReq, deleteReq] = testApi + + it "collects all info for get request" $ do + shouldBe getReq $ defReq + { _reqUrl = Url + [ Segment $ Static "test" ] + [ QueryArg ("flag", "boolX") Flag ] + , _reqMethod = "GET" + , _reqHeaders = [HeaderArg ("header", "listX of stringX")] + , _reqBody = Nothing + , _reqReturnType = "intX" + , _funcName = ["get", "test"] + } + + it "collects all info for post request" $ do + shouldBe postReq $ defReq + { _reqUrl = Url + [ Segment $ Static "test" ] + [ QueryArg ("param", "intX") Normal ] + , _reqMethod = "POST" + , _reqHeaders = [] + , _reqBody = Just "listX of stringX" + , _reqReturnType = "voidX" + , _funcName = ["post", "test"] + } + + it "collects all info for put request" $ do + shouldBe putReq $ defReq + { _reqUrl = Url + [ Segment $ Static "test" ] + -- Shoud this be |intX| or |listX of intX| ? + [ QueryArg ("params", "listX of intX") List ] + , _reqMethod = "PUT" + , _reqHeaders = [] + , _reqBody = Just "stringX" + , _reqReturnType = "voidX" + , _funcName = ["put", "test"] + } + + it "collects all info for delete request" $ do + shouldBe deleteReq $ defReq + { _reqUrl = Url + [ Segment $ Static "test" + , Segment $ Cap ("id", "intX") ] + [] + , _reqMethod = "DELETE" + , _reqHeaders = [] + , _reqBody = Nothing + , _reqReturnType = "voidX" + , _funcName = ["delete", "test", "by", "id"] + } + From b6ee20dfe01aa82997b7d2623a698d7ef1eb2b32 Mon Sep 17 00:00:00 2001 From: Maksymilian Owsianny Date: Wed, 2 Dec 2015 13:02:05 +0000 Subject: [PATCH 06/10] Fix to support GHC < 710 --- servant-foreign/test/Servant/ForeignSpec.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/servant-foreign/test/Servant/ForeignSpec.hs b/servant-foreign/test/Servant/ForeignSpec.hs index ec8b1dce..a5bad431 100644 --- a/servant-foreign/test/Servant/ForeignSpec.hs +++ b/servant-foreign/test/Servant/ForeignSpec.hs @@ -6,6 +6,10 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ < 710 +{-# LANGUAGE OverlappingInstances #-} +#endif module Servant.ForeignSpec where @@ -39,7 +43,7 @@ instance HasForeignType LangX Bool where typeFor _ _ = "boolX" instance {-# Overlapping #-} HasForeignType LangX String where typeFor _ _ = "stringX" -instance {-# Overlapable #-} HasForeignType LangX a => HasForeignType LangX [a] where +instance {-# Overlappable #-} HasForeignType LangX a => HasForeignType LangX [a] where typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a) type TestApi From 0c0c382ae6f7443bfac78b0d009499f9b47102f3 Mon Sep 17 00:00:00 2001 From: Maksymilian Owsianny Date: Wed, 2 Dec 2015 13:22:01 +0000 Subject: [PATCH 07/10] Fix broken servant-js tests. --- servant-js/src/Servant/JS.hs | 1 + servant-js/test/Servant/JSSpec.hs | 14 ++++++++------ 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/servant-js/src/Servant/JS.hs b/servant-js/src/Servant/JS.hs index b2e63ca3..691a21ff 100644 --- a/servant-js/src/Servant/JS.hs +++ b/servant-js/src/Servant/JS.hs @@ -110,6 +110,7 @@ module Servant.JS , -- * Misc. listFromAPI , javascript + , LangJS , GenerateList(..) ) where diff --git a/servant-js/test/Servant/JSSpec.hs b/servant-js/test/Servant/JSSpec.hs index 5e692e59..ae3039ab 100644 --- a/servant-js/test/Servant/JSSpec.hs +++ b/servant-js/test/Servant/JSSpec.hs @@ -98,16 +98,17 @@ a `shouldNotContain` b = shouldNotSatisfy a (T.isInfixOf b) axiosSpec :: Spec axiosSpec = describe specLabel $ do + let reqList = listFromAPI (Proxy :: Proxy LangJS) (Proxy :: Proxy TestAPI) it "should add withCredentials when needed" $ do - let jsText = genJS withCredOpts $ listFromAPI (Proxy :: Proxy TestAPI) + let jsText = genJS withCredOpts $ reqList output jsText jsText `shouldContain` "withCredentials: true" it "should add xsrfCookieName when needed" $ do - let jsText = genJS cookieOpts $ listFromAPI (Proxy :: Proxy TestAPI) + let jsText = genJS cookieOpts $ reqList output jsText jsText `shouldContain` ("xsrfCookieName: 'MyXSRFcookie'") it "should add withCredentials when needed" $ do - let jsText = genJS headerOpts $ listFromAPI (Proxy :: Proxy TestAPI) + let jsText = genJS headerOpts $ reqList output jsText jsText `shouldContain` ("xsrfHeaderName: 'MyXSRFheader'") where @@ -121,18 +122,19 @@ axiosSpec = describe specLabel $ do angularSpec :: TestNames -> Spec angularSpec test = describe specLabel $ do + let reqList = listFromAPI (Proxy :: Proxy LangJS) (Proxy :: Proxy TestAPI) it "should implement a service globally" $ do - let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI) + let jsText = genJS reqList output jsText jsText `shouldContain` (".service('" <> testName <> "'") it "should depend on $http service globally" $ do - let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI) + let jsText = genJS reqList output jsText jsText `shouldContain` ("('" <> testName <> "', function($http) {") it "should not depend on $http service in handlers" $ do - let jsText = genJS $ listFromAPI (Proxy :: Proxy TestAPI) + let jsText = genJS reqList output jsText jsText `shouldNotContain` "getsomething($http, " where From 0f42e0a7f086961aeb5a392129249a0cb90277af Mon Sep 17 00:00:00 2001 From: Maksymilian Owsianny Date: Wed, 2 Dec 2015 14:10:30 +0000 Subject: [PATCH 08/10] Add documentation of 'HasForeignType'. --- .../src/Servant/Foreign/Internal.hs | 28 +++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs index f9db7bb3..099e04e7 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/servant-foreign/src/Servant/Foreign/Internal.hs @@ -122,6 +122,34 @@ type family Elem (a :: *) (ls::[*]) :: Constraint where Elem a (a ': list) = () Elem a (b ': list) = Elem a list +-- | 'HasForeignType' maps Haskell types with types in the target +-- language of your backend. For example, let's say you're +-- implementing a backend to some language __X__: +-- +-- > -- First you need to create a dummy type to parametrize your +-- > -- instances. +-- > data LangX +-- > +-- > -- If the language __X__ is dynamically typed then you only need +-- > -- a catch all instance of a form +-- > instance HasForeignType LangX a where +-- > typeFor _ _ = empty +-- > +-- > -- Otherwise you define instances for the types you need +-- > instance HasForeignType LangX Int where +-- > typeFor _ _ = "intX" +-- > +-- > -- Or for example in case of lists +-- > instance HasForeignType LangX a => HasForeignType LangX [a] where +-- > typeFor lang _ = "listX of " <> typeFor lang (Proxy :: Proxy a) +-- +-- Finally to generate list of information about all the endpoints for +-- an API you create a function of a form: +-- +-- > getEndpoints :: (HasForeign LangX api, GenerateList (Foreign api)) +-- > => Proxy api -> [Req] +-- > getEndpoints api = listFromAPI (Proxy :: Proxy LangX) api +-- class HasForeignType lang a where typeFor :: Proxy lang -> Proxy a -> ForeignType From 83600d53263956e80212c123687169e16c8f06da Mon Sep 17 00:00:00 2001 From: Maksymilian Owsianny Date: Wed, 2 Dec 2015 14:26:45 +0000 Subject: [PATCH 09/10] Added myself as co-author. --- servant-foreign/servant-foreign.cabal | 4 ++-- servant-js/servant-js.cabal | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/servant-foreign/servant-foreign.cabal b/servant-foreign/servant-foreign.cabal index ebeb3dfe..0ec296ae 100644 --- a/servant-foreign/servant-foreign.cabal +++ b/servant-foreign/servant-foreign.cabal @@ -11,7 +11,7 @@ description: license: BSD3 license-file: LICENSE -author: Denis Redozubov +author: Denis Redozubov, Maksymilian Owsianny maintainer: denis.redozubov@gmail.com copyright: 2015 Denis Redozubov, Alp Mestanogullari category: Web @@ -45,4 +45,4 @@ test-suite spec build-depends: base , hspec >= 2.1.8 , servant-foreign - default-language: Haskell2010 \ No newline at end of file + default-language: Haskell2010 diff --git a/servant-js/servant-js.cabal b/servant-js/servant-js.cabal index d52b5c36..53a74e9d 100644 --- a/servant-js/servant-js.cabal +++ b/servant-js/servant-js.cabal @@ -13,7 +13,7 @@ description: license: BSD3 license-file: LICENSE -author: Alp Mestanogullari +author: Alp Mestanogullari, Maksymilian Owsianny maintainer: alpmestan@gmail.com copyright: 2014 Alp Mestanogullari category: Web From 721151a32d3f2154ee26eb33e16fc1269789d00a Mon Sep 17 00:00:00 2001 From: Maksymilian Owsianny Date: Wed, 2 Dec 2015 15:56:56 +0000 Subject: [PATCH 10/10] Added default NoTypes parameter for dynamic languages. --- servant-foreign/src/Servant/Foreign.hs | 1 + .../src/Servant/Foreign/Internal.hs | 17 ++++++++++----- servant-js/src/Servant/JS.hs | 21 +++++++------------ servant-js/test/Servant/JSSpec.hs | 4 ++-- 4 files changed, 22 insertions(+), 21 deletions(-) diff --git a/servant-foreign/src/Servant/Foreign.hs b/servant-foreign/src/Servant/Foreign.hs index cfa1acba..5054e69f 100644 --- a/servant-foreign/src/Servant/Foreign.hs +++ b/servant-foreign/src/Servant/Foreign.hs @@ -30,6 +30,7 @@ module Servant.Foreign , queryStr , listFromAPI , GenerateList(..) + , NoTypes -- re-exports , module Servant.API ) where diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs index 099e04e7..27f0e411 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/servant-foreign/src/Servant/Foreign/Internal.hs @@ -130,11 +130,6 @@ type family Elem (a :: *) (ls::[*]) :: Constraint where -- > -- instances. -- > data LangX -- > --- > -- If the language __X__ is dynamically typed then you only need --- > -- a catch all instance of a form --- > instance HasForeignType LangX a where --- > typeFor _ _ = empty --- > -- > -- Otherwise you define instances for the types you need -- > instance HasForeignType LangX Int where -- > typeFor _ _ = "intX" @@ -150,9 +145,21 @@ type family Elem (a :: *) (ls::[*]) :: Constraint where -- > => Proxy api -> [Req] -- > getEndpoints api = listFromAPI (Proxy :: Proxy LangX) api -- +-- > -- If language __X__ is dynamically typed then you can use +-- > -- a predefined NoTypes parameter +-- > getEndpoints :: (HasForeign NoTypes api, GenerateList (Foreign api)) +-- > => Proxy api -> [Req] +-- > getEndpoints api = listFromAPI (Proxy :: Proxy NoTypes) api +-- > +-- class HasForeignType lang a where typeFor :: Proxy lang -> Proxy a -> ForeignType +data NoTypes + +instance HasForeignType NoTypes a where + typeFor _ _ = empty + class HasForeign lang (layout :: *) where type Foreign layout :: * foreignFor :: Proxy lang -> Proxy layout -> Req -> Foreign layout diff --git a/servant-js/src/Servant/JS.hs b/servant-js/src/Servant/JS.hs index 691a21ff..443b758b 100644 --- a/servant-js/src/Servant/JS.hs +++ b/servant-js/src/Servant/JS.hs @@ -110,7 +110,7 @@ module Servant.JS , -- * Misc. listFromAPI , javascript - , LangJS + , NoTypes , GenerateList(..) ) where @@ -123,37 +123,30 @@ import Servant.JS.Axios import Servant.JS.Internal import Servant.JS.JQuery import Servant.JS.Vanilla -import Servant.Foreign (GenerateList(..), listFromAPI) - --- Dummy type specifying target language -data LangJS +import Servant.Foreign (GenerateList(..), listFromAPI, NoTypes) -- | Generate the data necessary to generate javascript code -- for all the endpoints of an API, as ':<|>'-separated values -- of type 'AjaxReq'. -javascript :: HasForeign LangJS layout => Proxy layout -> Foreign layout -javascript p = foreignFor (Proxy :: Proxy LangJS) p defReq +javascript :: HasForeign NoTypes layout => Proxy layout -> Foreign layout +javascript p = foreignFor (Proxy :: Proxy NoTypes) 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 LangJS api, GenerateList (Foreign api)) +jsForAPI :: (HasForeign NoTypes 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 -jsForAPI p gen = gen (listFromAPI (Proxy :: Proxy LangJS) p) +jsForAPI p gen = gen (listFromAPI (Proxy :: Proxy NoTypes) 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 LangJS api, GenerateList (Foreign api)) +writeJSForAPI :: (HasForeign NoTypes 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 -> IO () writeJSForAPI p gen fp = writeFile fp (jsForAPI p gen) --- A catch all instance since JavaScript has no types. -instance HasForeignType LangJS a where - typeFor _ _ = empty - diff --git a/servant-js/test/Servant/JSSpec.hs b/servant-js/test/Servant/JSSpec.hs index ae3039ab..23fe4326 100644 --- a/servant-js/test/Servant/JSSpec.hs +++ b/servant-js/test/Servant/JSSpec.hs @@ -98,7 +98,7 @@ a `shouldNotContain` b = shouldNotSatisfy a (T.isInfixOf b) axiosSpec :: Spec axiosSpec = describe specLabel $ do - let reqList = listFromAPI (Proxy :: Proxy LangJS) (Proxy :: Proxy TestAPI) + let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy TestAPI) it "should add withCredentials when needed" $ do let jsText = genJS withCredOpts $ reqList output jsText @@ -122,7 +122,7 @@ axiosSpec = describe specLabel $ do angularSpec :: TestNames -> Spec angularSpec test = describe specLabel $ do - let reqList = listFromAPI (Proxy :: Proxy LangJS) (Proxy :: Proxy TestAPI) + let reqList = listFromAPI (Proxy :: Proxy NoTypes) (Proxy :: Proxy TestAPI) it "should implement a service globally" $ do let jsText = genJS reqList output jsText