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

[servant-foreign] Normalise names of arg field accessors

Browse Source
This commit is contained in:
Steve Purcell 2016-03-13 17:02:00 +13:00
parent e34003e9af
commit bfe812f5d9
7 changed files with 43 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
servant-foreign/src/Servant/Foreign.hs
View File

@ -15,9 +15,9 @@ module Servant.Foreign
, FunctionName(..)
, PathSegment(..)
-- lenses
, aName
, aType
, aPath
, argName
, argType
, argPath
, reqUrl
, reqMethod
, reqHeaders
@ -26,8 +26,8 @@ module Servant.Foreign
, reqFuncName
, path
, queryStr
, argName
, argType
, queryArgName
, queryArgType
, headerArg
-- prisms
, _PathSegment

32
servant-foreign/src/Servant/Foreign/Internal.hs
View File

@ -38,14 +38,14 @@ newtype PathSegment = PathSegment { unPathSegment :: Text }
makePrisms ''PathSegment
data Arg = Arg
{ _aName :: PathSegment
, _aType :: ForeignType }
{ _argName :: PathSegment
, _argType :: ForeignType }
deriving (Show, Eq)
makeLenses ''Arg
aPath :: Getter Arg Text
aPath = aName . _PathSegment
argPath :: Getter Arg Text
argPath = argName . _PathSegment
data SegmentType
= Static PathSegment
@ -80,8 +80,8 @@ data ArgType
makePrisms ''ArgType
data QueryArg = QueryArg
{ _argName :: Arg
, _argType :: ArgType
{ _queryArgName :: Arg
, _queryArgType :: ArgType
} deriving (Eq, Show)
makeLenses ''QueryArg
@ -194,8 +194,8 @@ instance (KnownSymbol sym, HasForeignType lang ftype, HasForeign lang sublayout)
str = pack . symbolVal $ (Proxy :: Proxy sym)
ftype = typeFor lang (Proxy :: Proxy ftype)
arg = Arg
{ _aName = PathSegment str
, _aType = ftype }
{ _argName = PathSegment str
, _argType = ftype }
instance (Elem JSON list, HasForeignType lang a, ReflectMethod method)
=> HasForeign lang (Verb method status list a) where
@ -219,8 +219,8 @@ instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
where
hname = pack . symbolVal $ (Proxy :: Proxy sym)
arg = Arg
{ _aName = PathSegment hname
, _aType = typeFor lang (Proxy :: Proxy a) }
{ _argName = PathSegment hname
, _argType = typeFor lang (Proxy :: Proxy a) }
subP = Proxy :: Proxy sublayout
instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
@ -233,8 +233,8 @@ instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
where
str = pack . symbolVal $ (Proxy :: Proxy sym)
arg = Arg
{ _aName = PathSegment str
, _aType = typeFor lang (Proxy :: Proxy a) }
{ _argName = PathSegment str
, _argType = typeFor lang (Proxy :: Proxy a) }
instance
(KnownSymbol sym, HasForeignType lang [a], HasForeign lang sublayout)
@ -246,8 +246,8 @@ instance
where
str = pack . symbolVal $ (Proxy :: Proxy sym)
arg = Arg
{ _aName = PathSegment str
, _aType = typeFor lang (Proxy :: Proxy [a]) }
{ _argName = PathSegment str
, _argType = typeFor lang (Proxy :: Proxy [a]) }
instance
(KnownSymbol sym, HasForeignType lang Bool, HasForeign lang sublayout)
@ -260,8 +260,8 @@ instance
where
str = pack . symbolVal $ (Proxy :: Proxy sym)
arg = Arg
{ _aName = PathSegment str
, _aType = typeFor lang (Proxy :: Proxy Bool) }
{ _argName = PathSegment str
, _argType = typeFor lang (Proxy :: Proxy Bool) }
instance HasForeign lang Raw where
type Foreign Raw = HTTP.Method -> Req

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

@ -76,11 +76,11 @@ generateAngularJSWith ngOptions opts req = "\n" <>
where argsStr = T.intercalate ", " args
args = http
++ captures
++ map (view $ argName . aPath) queryparams
++ map (view $ queryArgName . argPath) queryparams
++ body
++ map ( toValidFunctionName
. (<>) "header"
. view (headerArg . aPath)
. view (headerArg . argPath)
) hs
-- If we want to generate Top Level Function, they must depend on
@ -90,7 +90,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
0 -> ["$http"]
_ -> []
captures = map (view aPath . captureArg)
captures = map (view argPath . captureArg)
. filter isCapture
$ req ^. reqUrl . path
@ -116,7 +116,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
where
headersStr = T.intercalate ", " $ map headerStr hs
headerStr header = "\"" <>
header ^. headerArg . aPath <>
header ^. headerArg . argPath <>
"\": " <> toJSHeader header
namespace =

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

@ -62,14 +62,14 @@ generateAxiosJSWith aopts opts req = "\n" <>
where argsStr = T.intercalate ", " args
args = captures
++ map (view $ argName . aPath) queryparams
++ map (view $ queryArgName . argPath) queryparams
++ body
++ map ( toValidFunctionName
. (<>) "header"
. view (headerArg . aPath)
. view (headerArg . argPath)
) hs
captures = map (view aPath . captureArg)
captures = map (view argPath . captureArg)
. filter isCapture
$ req ^. reqUrl.path
@ -110,7 +110,7 @@ generateAxiosJSWith aopts opts req = "\n" <>
where
headersStr = T.intercalate ", " $ map headerStr hs
headerStr header = "\"" <>
header ^. headerArg . aPath <>
header ^. headerArg . argPath <>
"\": " <> toJSHeader header
namespace =

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

@ -141,7 +141,7 @@ toValidFunctionName t =
toJSHeader :: HeaderArg -> Text
toJSHeader (HeaderArg n)
= toValidFunctionName ("header" <> n ^. aName . _PathSegment)
= toValidFunctionName ("header" <> n ^. argName . _PathSegment)
toJSHeader (ReplaceHeaderArg n p)
| pn `T.isPrefixOf` p = pv <> " + \"" <> rp <> "\""
| pn `T.isSuffixOf` p = "\"" <> rp <> "\" + " <> pv
@ -149,8 +149,8 @@ toJSHeader (ReplaceHeaderArg n p)
<> "\""
| otherwise = p
where
pv = toValidFunctionName ("header" <> n ^. aName . _PathSegment)
pn = "{" <> n ^. aName . _PathSegment <> "}"
pv = toValidFunctionName ("header" <> n ^. argName . _PathSegment)
pn = "{" <> n ^. argName . _PathSegment <> "}"
rp = T.replace pn "" p
jsSegments :: [Segment] -> Text
@ -165,7 +165,7 @@ segmentToStr (Segment st) notTheEnd =
segmentTypeToStr :: SegmentType -> Text
segmentTypeToStr (Static s) = s ^. _PathSegment
segmentTypeToStr (Cap s) =
"' + encodeURIComponent(" <> s ^. aName . _PathSegment <> ") + '"
"' + encodeURIComponent(" <> s ^. argName . _PathSegment <> ") + '"
jsGParams :: Text -> [QueryArg] -> Text
jsGParams _ [] = ""
@ -177,7 +177,7 @@ jsParams = jsGParams "&"
paramToStr :: QueryArg -> Bool -> Text
paramToStr qarg notTheEnd =
case qarg ^. argType of
case qarg ^. queryArgType of
Normal -> name
<> "=' + encodeURIComponent("
<> name
@ -187,4 +187,4 @@ paramToStr qarg notTheEnd =
<> "[]=' + encodeURIComponent("
<> name
<> if notTheEnd then ") + '" else ")"
where name = qarg ^. argName . aName . _PathSegment
where name = qarg ^. queryArgName . argName . _PathSegment

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

@ -43,15 +43,15 @@ generateJQueryJSWith opts req = "\n" <>
where argsStr = T.intercalate ", " args
args = captures
++ map (view $ argName . aPath) queryparams
++ map (view $ queryArgName . argPath) queryparams
++ body
++ map (toValidFunctionName
. (<>) "header"
. view (headerArg . aPath)
. view (headerArg . argPath)
) hs
++ [onSuccess, onError]
captures = map (view aPath . captureArg)
captures = map (view argPath . captureArg)
. filter isCapture
$ req ^. reqUrl.path
@ -80,7 +80,7 @@ generateJQueryJSWith opts req = "\n" <>
where
headersStr = T.intercalate ", " $ map headerStr hs
headerStr header = "\"" <>
header ^. headerArg . aPath <>
header ^. headerArg . argPath <>
"\": " <> toJSHeader header
namespace = if (moduleName opts) == ""

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

@ -54,15 +54,15 @@ generateVanillaJSWith opts req = "\n" <>
where argsStr = T.intercalate ", " args
args = captures
++ map (view $ argName . aPath) queryparams
++ map (view $ queryArgName . argPath) queryparams
++ body
++ map ( toValidFunctionName
. (<>) "header"
. view (headerArg . aPath)
. view (headerArg . argPath)
) hs
++ [onSuccess, onError]
captures = map (view aPath . captureArg)
captures = map (view argPath . captureArg)
. filter isCapture
$ req ^. reqUrl.path
@ -91,7 +91,7 @@ generateVanillaJSWith opts req = "\n" <>
where
headersStr = T.intercalate "\n" $ map headerStr hs
headerStr header = " xhr.setRequestHeader(\"" <>
header ^. headerArg . aPath <>
header ^. headerArg . argPath <>
"\", " <> toJSHeader header <> ");"
namespace = if moduleName opts == ""