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."