eeva/servant
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fix servant-js based on changes to servant-foreign.

Browse Source
This commit is contained in:
Maksymilian Owsianny 2015-11-28 08:24:55 +00:00
parent 8932cb242c
commit 0b37222733
7 changed files with 42 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
servant-js/src/Servant/JS.hs
View File

@ -147,6 +147,10 @@ writeJSForAPI :: (HasForeign api, GenerateList (Foreign api))
-> IO () -> IO ()
writeJSForAPI p gen fp = writeFile fp (jsForAPI p gen) 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 -- | Utility class used by 'jsForAPI' which computes
-- the data needed to generate a function for each endpoint -- the data needed to generate a function for each endpoint
-- and hands it all back in a list. -- and hands it all back in a list.

13
servant-js/src/Servant/JS/Angular.hs
View File

@ -2,6 +2,7 @@
module Servant.JS.Angular where module Servant.JS.Angular where
import Control.Lens import Control.Lens
import Data.Maybe (isJust)
import Data.Monoid import Data.Monoid
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text (Text) import Data.Text (Text)
@ -74,9 +75,9 @@ generateAngularJSWith ngOptions opts req = "\n" <>
where argsStr = T.intercalate ", " args where argsStr = T.intercalate ", " args
args = http args = http
++ captures ++ captures
++ map (view argName) queryparams ++ map (view $ argName._1) queryparams
++ body ++ body
++ map (toValidFunctionName . (<>) "header" . headerArgName) hs ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
-- If we want to generate Top Level Function, they must depend on -- If we want to generate Top Level Function, they must depend on
-- the $http service, if we generate a service, the functions will -- the $http service, if we generate a service, the functions will
@ -85,7 +86,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
0 -> ["$http"] 0 -> ["$http"]
_ -> [] _ -> []
captures = map captureArg captures = map (fst . captureArg)
. filter isCapture . filter isCapture
$ req ^. reqUrl.path $ req ^. reqUrl.path
@ -93,12 +94,12 @@ generateAngularJSWith ngOptions opts req = "\n" <>
queryparams = req ^.. reqUrl.queryStr.traverse queryparams = req ^.. reqUrl.queryStr.traverse
body = if req ^. reqBody body = if isJust (req ^. reqBody)
then [requestBody opts] then [requestBody opts]
else [] else []
dataBody = dataBody =
if req ^. reqBody if isJust (req ^. reqBody)
then " , data: JSON.stringify(body)\n" <> then " , data: JSON.stringify(body)\n" <>
" , contentType: 'application/json'\n" " , contentType: 'application/json'\n"
else "" else ""
@ -110,7 +111,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
where headersStr = T.intercalate ", " $ map headerStr hs where headersStr = T.intercalate ", " $ map headerStr hs
headerStr header = "\"" <> headerStr header = "\"" <>
headerArgName header <> fst (headerArg header) <>
"\": " <> toJSHeader header "\": " <> toJSHeader header
namespace = namespace =

13
servant-js/src/Servant/JS/Axios.hs
View File

@ -2,6 +2,7 @@
module Servant.JS.Axios where module Servant.JS.Axios where
import Control.Lens import Control.Lens
import Data.Maybe (isJust)
import Data.Monoid import Data.Monoid
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
@ -60,11 +61,11 @@ generateAxiosJSWith aopts opts req = "\n" <>
where argsStr = T.intercalate ", " args where argsStr = T.intercalate ", " args
args = captures args = captures
++ map (view argName) queryparams ++ map (view $ argName._1) queryparams
++ body ++ body
++ map (toValidFunctionName . (<>) "header" . headerArgName) hs ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
captures = map captureArg captures = map (fst . captureArg)
. filter isCapture . filter isCapture
$ req ^. reqUrl.path $ req ^. reqUrl.path
@ -72,12 +73,12 @@ generateAxiosJSWith aopts opts req = "\n" <>
queryparams = req ^.. reqUrl.queryStr.traverse queryparams = req ^.. reqUrl.queryStr.traverse
body = if req ^. reqBody body = if isJust (req ^. reqBody)
then [requestBody opts] then [requestBody opts]
else [] else []
dataBody = dataBody =
if req ^. reqBody if isJust (req ^. reqBody)
then " , data: body\n" <> then " , data: body\n" <>
" , responseType: 'json'\n" " , responseType: 'json'\n"
else "" else ""
@ -104,7 +105,7 @@ generateAxiosJSWith aopts opts req = "\n" <>
where headersStr = T.intercalate ", " $ map headerStr hs where headersStr = T.intercalate ", " $ map headerStr hs
headerStr header = "\"" <> headerStr header = "\"" <>
headerArgName header <> fst (headerArg header) <>
"\": " <> toJSHeader header "\": " <> toJSHeader header
namespace = namespace =

13
servant-js/src/Servant/JS/Internal.hs
View File

@ -18,6 +18,7 @@ module Servant.JS.Internal
, defReq , defReq
, reqHeaders , reqHeaders
, HasForeign(..) , HasForeign(..)
, HasForeignType(..)
, HeaderArg(..) , HeaderArg(..)
, concatCase , concatCase
, snakeCase , snakeCase
@ -31,7 +32,7 @@ module Servant.JS.Internal
, Header , Header
) where ) where
import Control.Lens ((^.)) import Control.Lens ((^.), _1)
import qualified Data.CharSet as Set import qualified Data.CharSet as Set
import qualified Data.CharSet.Unicode.Category as Set import qualified Data.CharSet.Unicode.Category as Set
import Data.Monoid import Data.Monoid
@ -115,7 +116,7 @@ toValidFunctionName t =
] ]
toJSHeader :: HeaderArg -> Text toJSHeader :: HeaderArg -> Text
toJSHeader (HeaderArg n) = toValidFunctionName ("header" <> n) toJSHeader (HeaderArg n) = toValidFunctionName ("header" <> fst n)
toJSHeader (ReplaceHeaderArg n p) toJSHeader (ReplaceHeaderArg n p)
| pn `T.isPrefixOf` p = pv <> " + \"" <> rp <> "\"" | pn `T.isPrefixOf` p = pv <> " + \"" <> rp <> "\""
| pn `T.isSuffixOf` p = "\"" <> rp <> "\" + " <> pv | pn `T.isSuffixOf` p = "\"" <> rp <> "\" + " <> pv
@ -123,8 +124,8 @@ toJSHeader (ReplaceHeaderArg n p)
<> "\"" <> "\""
| otherwise = p | otherwise = p
where where
pv = toValidFunctionName ("header" <> n) pv = toValidFunctionName ("header" <> fst n)
pn = "{" <> n <> "}" pn = "{" <> fst n <> "}"
rp = T.replace pn "" p rp = T.replace pn "" p
jsSegments :: [Segment] -> Text jsSegments :: [Segment] -> Text
@ -138,7 +139,7 @@ segmentToStr (Segment st) notTheEnd =
segmentTypeToStr :: SegmentType -> Text segmentTypeToStr :: SegmentType -> Text
segmentTypeToStr (Static s) = s segmentTypeToStr (Static s) = s
segmentTypeToStr (Cap s) = "' + encodeURIComponent(" <> s <> ") + '" segmentTypeToStr (Cap s) = "' + encodeURIComponent(" <> fst s <> ") + '"
jsGParams :: Text -> [QueryArg] -> Text jsGParams :: Text -> [QueryArg] -> Text
jsGParams _ [] = "" jsGParams _ [] = ""
@ -160,4 +161,4 @@ paramToStr qarg notTheEnd =
<> "[]=' + encodeURIComponent(" <> "[]=' + encodeURIComponent("
<> name <> name
<> if notTheEnd then ") + '" else ")" <> if notTheEnd then ") + '" else ")"
where name = qarg ^. argName where name = qarg ^. argName . _1

13
servant-js/src/Servant/JS/JQuery.hs
View File

@ -2,6 +2,7 @@
module Servant.JS.JQuery where module Servant.JS.JQuery where
import Control.Lens import Control.Lens
import Data.Maybe (isJust)
import Data.Monoid import Data.Monoid
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text (Text) import Data.Text (Text)
@ -40,12 +41,12 @@ generateJQueryJSWith opts req = "\n" <>
where argsStr = T.intercalate ", " args where argsStr = T.intercalate ", " args
args = captures args = captures
++ map (view argName) queryparams ++ map (view $ argName._1) queryparams
++ body ++ body
++ map (toValidFunctionName . (<>) "header" . headerArgName) hs ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
++ [onSuccess, onError] ++ [onSuccess, onError]
captures = map captureArg captures = map (fst . captureArg)
. filter isCapture . filter isCapture
$ req ^. reqUrl.path $ req ^. reqUrl.path
@ -53,7 +54,7 @@ generateJQueryJSWith opts req = "\n" <>
queryparams = req ^.. reqUrl.queryStr.traverse queryparams = req ^.. reqUrl.queryStr.traverse
body = if req ^. reqBody body = if isJust (req ^. reqBody)
then [requestBody opts] then [requestBody opts]
else [] else []
@ -61,7 +62,7 @@ generateJQueryJSWith opts req = "\n" <>
onError = errorCallback opts onError = errorCallback opts
dataBody = dataBody =
if req ^. reqBody if isJust $ req ^. reqBody
then " , data: JSON.stringify(body)\n" <> then " , data: JSON.stringify(body)\n" <>
" , contentType: 'application/json'\n" " , contentType: 'application/json'\n"
else "" else ""
@ -73,7 +74,7 @@ generateJQueryJSWith opts req = "\n" <>
where headersStr = T.intercalate ", " $ map headerStr hs where headersStr = T.intercalate ", " $ map headerStr hs
headerStr header = "\"" <> headerStr header = "\"" <>
headerArgName header <> fst (headerArg header) <>
"\": " <> toJSHeader header "\": " <> toJSHeader header
namespace = if (moduleName opts) == "" namespace = if (moduleName opts) == ""

13
servant-js/src/Servant/JS/Vanilla.hs
View File

@ -2,6 +2,7 @@
module Servant.JS.Vanilla where module Servant.JS.Vanilla where
import Control.Lens import Control.Lens
import Data.Maybe (isJust)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Monoid import Data.Monoid
@ -47,12 +48,12 @@ generateVanillaJSWith opts req = "\n" <>
where argsStr = T.intercalate ", " args where argsStr = T.intercalate ", " args
args = captures args = captures
++ map (view argName) queryparams ++ map (view $ argName._1) queryparams
++ body ++ body
++ map (toValidFunctionName . (<>) "header" . headerArgName) hs ++ map (toValidFunctionName . (<>) "header" . fst . headerArg) hs
++ [onSuccess, onError] ++ [onSuccess, onError]
captures = map captureArg captures = map (fst . captureArg)
. filter isCapture . filter isCapture
$ req ^. reqUrl.path $ req ^. reqUrl.path
@ -60,7 +61,7 @@ generateVanillaJSWith opts req = "\n" <>
queryparams = req ^.. reqUrl.queryStr.traverse queryparams = req ^.. reqUrl.queryStr.traverse
body = if req ^. reqBody body = if isJust(req ^. reqBody)
then [requestBody opts] then [requestBody opts]
else [] else []
@ -68,7 +69,7 @@ generateVanillaJSWith opts req = "\n" <>
onError = errorCallback opts onError = errorCallback opts
dataBody = dataBody =
if req ^. reqBody if isJust (req ^. reqBody)
then "JSON.stringify(body)\n" then "JSON.stringify(body)\n"
else "null" else "null"
@ -80,7 +81,7 @@ generateVanillaJSWith opts req = "\n" <>
where headersStr = T.intercalate "\n" $ map headerStr hs where headersStr = T.intercalate "\n" $ map headerStr hs
headerStr header = " xhr.setRequestHeader(\"" <> headerStr header = " xhr.setRequestHeader(\"" <>
headerArgName header <> fst (headerArg header) <>
"\", " <> toJSHeader header <> ");" "\", " <> toJSHeader header <> ");"
namespace = if moduleName opts == "" namespace = if moduleName opts == ""

6
servant-js/test/Servant/JSSpec/CustomHeaders.hs
View File

@ -26,7 +26,7 @@ instance (KnownSymbol sym, HasForeign sublayout)
type Foreign (Authorization sym a :> sublayout) = Foreign sublayout type Foreign (Authorization sym a :> sublayout) = Foreign sublayout
foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
req & reqHeaders <>~ [ ReplaceHeaderArg "Authorization" $ req & reqHeaders <>~ [ ReplaceHeaderArg ("Authorization", "") $
tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ] tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
where where
tokenType t = t <> " {Authorization}" tokenType t = t <> " {Authorization}"
@ -39,7 +39,7 @@ instance (HasForeign sublayout)
type Foreign (MyLovelyHorse a :> sublayout) = Foreign sublayout type Foreign (MyLovelyHorse a :> sublayout) = Foreign sublayout
foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
req & reqHeaders <>~ [ ReplaceHeaderArg "X-MyLovelyHorse" tpl ] req & reqHeaders <>~ [ ReplaceHeaderArg ("X-MyLovelyHorse", "") tpl ]
where where
tpl = "I am good friends with {X-MyLovelyHorse}" tpl = "I am good friends with {X-MyLovelyHorse}"
@ -51,6 +51,6 @@ instance (HasForeign sublayout)
type Foreign (WhatsForDinner a :> sublayout) = Foreign sublayout type Foreign (WhatsForDinner a :> sublayout) = Foreign sublayout
foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $ foreignFor Proxy req = foreignFor (Proxy :: Proxy sublayout) $
req & reqHeaders <>~ [ ReplaceHeaderArg "X-WhatsForDinner" tpl ] req & reqHeaders <>~ [ ReplaceHeaderArg ("X-WhatsForDinner", "") tpl ]
where where
tpl = "I would like {X-WhatsForDinner} with a cherry on top." tpl = "I would like {X-WhatsForDinner} with a cherry on top."