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(..) , FunctionName(..)
, PathSegment(..) , PathSegment(..)
-- lenses -- lenses
, aName , argName
, aType , argType
, aPath , argPath
, reqUrl , reqUrl
, reqMethod , reqMethod
, reqHeaders , reqHeaders
@ -26,8 +26,8 @@ module Servant.Foreign
, reqFuncName , reqFuncName
, path , path
, queryStr , queryStr
, argName , queryArgName
, argType , queryArgType
, headerArg , headerArg
-- prisms -- prisms
, _PathSegment , _PathSegment

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

@ -38,14 +38,14 @@ newtype PathSegment = PathSegment { unPathSegment :: Text }
makePrisms ''PathSegment makePrisms ''PathSegment
data Arg = Arg data Arg = Arg
{ _aName :: PathSegment { _argName :: PathSegment
, _aType :: ForeignType } , _argType :: ForeignType }
deriving (Show, Eq) deriving (Show, Eq)
makeLenses ''Arg makeLenses ''Arg
aPath :: Getter Arg Text argPath :: Getter Arg Text
aPath = aName . _PathSegment argPath = argName . _PathSegment
data SegmentType data SegmentType
= Static PathSegment = Static PathSegment
@ -80,8 +80,8 @@ data ArgType
makePrisms ''ArgType makePrisms ''ArgType
data QueryArg = QueryArg data QueryArg = QueryArg
{ _argName :: Arg { _queryArgName :: Arg
, _argType :: ArgType , _queryArgType :: ArgType
} deriving (Eq, Show) } deriving (Eq, Show)
makeLenses ''QueryArg makeLenses ''QueryArg
@ -194,8 +194,8 @@ instance (KnownSymbol sym, HasForeignType lang ftype, HasForeign lang sublayout)
str = pack . symbolVal $ (Proxy :: Proxy sym) str = pack . symbolVal $ (Proxy :: Proxy sym)
ftype = typeFor lang (Proxy :: Proxy ftype) ftype = typeFor lang (Proxy :: Proxy ftype)
arg = Arg arg = Arg
{ _aName = PathSegment str { _argName = PathSegment str
, _aType = ftype } , _argType = ftype }
instance (Elem JSON list, HasForeignType lang a, ReflectMethod method) instance (Elem JSON list, HasForeignType lang a, ReflectMethod method)
=> HasForeign lang (Verb method status list a) where => HasForeign lang (Verb method status list a) where
@ -219,8 +219,8 @@ instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
where where
hname = pack . symbolVal $ (Proxy :: Proxy sym) hname = pack . symbolVal $ (Proxy :: Proxy sym)
arg = Arg arg = Arg
{ _aName = PathSegment hname { _argName = PathSegment hname
, _aType = typeFor lang (Proxy :: Proxy a) } , _argType = typeFor lang (Proxy :: Proxy a) }
subP = Proxy :: Proxy sublayout subP = Proxy :: Proxy sublayout
instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout) instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
@ -233,8 +233,8 @@ instance (KnownSymbol sym, HasForeignType lang a, HasForeign lang sublayout)
where where
str = pack . symbolVal $ (Proxy :: Proxy sym) str = pack . symbolVal $ (Proxy :: Proxy sym)
arg = Arg arg = Arg
{ _aName = PathSegment str { _argName = PathSegment str
, _aType = typeFor lang (Proxy :: Proxy a) } , _argType = typeFor lang (Proxy :: Proxy a) }
instance instance
(KnownSymbol sym, HasForeignType lang [a], HasForeign lang sublayout) (KnownSymbol sym, HasForeignType lang [a], HasForeign lang sublayout)
@ -246,8 +246,8 @@ instance
where where
str = pack . symbolVal $ (Proxy :: Proxy sym) str = pack . symbolVal $ (Proxy :: Proxy sym)
arg = Arg arg = Arg
{ _aName = PathSegment str { _argName = PathSegment str
, _aType = typeFor lang (Proxy :: Proxy [a]) } , _argType = typeFor lang (Proxy :: Proxy [a]) }
instance instance
(KnownSymbol sym, HasForeignType lang Bool, HasForeign lang sublayout) (KnownSymbol sym, HasForeignType lang Bool, HasForeign lang sublayout)
@ -260,8 +260,8 @@ instance
where where
str = pack . symbolVal $ (Proxy :: Proxy sym) str = pack . symbolVal $ (Proxy :: Proxy sym)
arg = Arg arg = Arg
{ _aName = PathSegment str { _argName = PathSegment str
, _aType = typeFor lang (Proxy :: Proxy Bool) } , _argType = typeFor lang (Proxy :: Proxy Bool) }
instance HasForeign lang Raw where instance HasForeign lang Raw where
type Foreign Raw = HTTP.Method -> Req 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 where argsStr = T.intercalate ", " args
args = http args = http
++ captures ++ captures
++ map (view $ argName . aPath) queryparams ++ map (view $ queryArgName . argPath) queryparams
++ body ++ body
++ map ( toValidFunctionName ++ map ( toValidFunctionName
. (<>) "header" . (<>) "header"
. view (headerArg . aPath) . view (headerArg . argPath)
) hs ) 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
@ -90,7 +90,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
0 -> ["$http"] 0 -> ["$http"]
_ -> [] _ -> []
captures = map (view aPath . captureArg) captures = map (view argPath . captureArg)
. filter isCapture . filter isCapture
$ req ^. reqUrl . path $ req ^. reqUrl . path
@ -116,7 +116,7 @@ generateAngularJSWith ngOptions opts req = "\n" <>
where where
headersStr = T.intercalate ", " $ map headerStr hs headersStr = T.intercalate ", " $ map headerStr hs
headerStr header = "\"" <> headerStr header = "\"" <>
header ^. headerArg . aPath <> header ^. headerArg . argPath <>
"\": " <> toJSHeader header "\": " <> toJSHeader header
namespace = 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 where argsStr = T.intercalate ", " args
args = captures args = captures
++ map (view $ argName . aPath) queryparams ++ map (view $ queryArgName . argPath) queryparams
++ body ++ body
++ map ( toValidFunctionName ++ map ( toValidFunctionName
. (<>) "header" . (<>) "header"
. view (headerArg . aPath) . view (headerArg . argPath)
) hs ) hs
captures = map (view aPath . captureArg) captures = map (view argPath . captureArg)
. filter isCapture . filter isCapture
$ req ^. reqUrl.path $ req ^. reqUrl.path
@ -110,7 +110,7 @@ generateAxiosJSWith aopts opts req = "\n" <>
where where
headersStr = T.intercalate ", " $ map headerStr hs headersStr = T.intercalate ", " $ map headerStr hs
headerStr header = "\"" <> headerStr header = "\"" <>
header ^. headerArg . aPath <> header ^. headerArg . argPath <>
"\": " <> toJSHeader header "\": " <> toJSHeader header
namespace = namespace =

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

@ -141,7 +141,7 @@ toValidFunctionName t =
toJSHeader :: HeaderArg -> Text toJSHeader :: HeaderArg -> Text
toJSHeader (HeaderArg n) toJSHeader (HeaderArg n)
= toValidFunctionName ("header" <> n ^. aName . _PathSegment) = toValidFunctionName ("header" <> n ^. argName . _PathSegment)
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
@ -149,8 +149,8 @@ toJSHeader (ReplaceHeaderArg n p)
<> "\"" <> "\""
| otherwise = p | otherwise = p
where where
pv = toValidFunctionName ("header" <> n ^. aName . _PathSegment) pv = toValidFunctionName ("header" <> n ^. argName . _PathSegment)
pn = "{" <> n ^. aName . _PathSegment <> "}" pn = "{" <> n ^. argName . _PathSegment <> "}"
rp = T.replace pn "" p rp = T.replace pn "" p
jsSegments :: [Segment] -> Text jsSegments :: [Segment] -> Text
@ -165,7 +165,7 @@ segmentToStr (Segment st) notTheEnd =
segmentTypeToStr :: SegmentType -> Text segmentTypeToStr :: SegmentType -> Text
segmentTypeToStr (Static s) = s ^. _PathSegment segmentTypeToStr (Static s) = s ^. _PathSegment
segmentTypeToStr (Cap s) = segmentTypeToStr (Cap s) =
"' + encodeURIComponent(" <> s ^. aName . _PathSegment <> ") + '" "' + encodeURIComponent(" <> s ^. argName . _PathSegment <> ") + '"
jsGParams :: Text -> [QueryArg] -> Text jsGParams :: Text -> [QueryArg] -> Text
jsGParams _ [] = "" jsGParams _ [] = ""
@ -177,7 +177,7 @@ jsParams = jsGParams "&"
paramToStr :: QueryArg -> Bool -> Text paramToStr :: QueryArg -> Bool -> Text
paramToStr qarg notTheEnd = paramToStr qarg notTheEnd =
case qarg ^. argType of case qarg ^. queryArgType of
Normal -> name Normal -> name
<> "=' + encodeURIComponent(" <> "=' + encodeURIComponent("
<> name <> name
@ -187,4 +187,4 @@ paramToStr qarg notTheEnd =
<> "[]=' + encodeURIComponent(" <> "[]=' + encodeURIComponent("
<> name <> name
<> if notTheEnd then ") + '" else ")" <> 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 where argsStr = T.intercalate ", " args
args = captures args = captures
++ map (view $ argName . aPath) queryparams ++ map (view $ queryArgName . argPath) queryparams
++ body ++ body
++ map (toValidFunctionName ++ map (toValidFunctionName
. (<>) "header" . (<>) "header"
. view (headerArg . aPath) . view (headerArg . argPath)
) hs ) hs
++ [onSuccess, onError] ++ [onSuccess, onError]
captures = map (view aPath . captureArg) captures = map (view argPath . captureArg)
. filter isCapture . filter isCapture
$ req ^. reqUrl.path $ req ^. reqUrl.path
@ -80,7 +80,7 @@ generateJQueryJSWith opts req = "\n" <>
where where
headersStr = T.intercalate ", " $ map headerStr hs headersStr = T.intercalate ", " $ map headerStr hs
headerStr header = "\"" <> headerStr header = "\"" <>
header ^. headerArg . aPath <> header ^. headerArg . argPath <>
"\": " <> toJSHeader header "\": " <> toJSHeader header
namespace = if (moduleName opts) == "" 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 where argsStr = T.intercalate ", " args
args = captures args = captures
++ map (view $ argName . aPath) queryparams ++ map (view $ queryArgName . argPath) queryparams
++ body ++ body
++ map ( toValidFunctionName ++ map ( toValidFunctionName
. (<>) "header" . (<>) "header"
. view (headerArg . aPath) . view (headerArg . argPath)
) hs ) hs
++ [onSuccess, onError] ++ [onSuccess, onError]
captures = map (view aPath . captureArg) captures = map (view argPath . captureArg)
. filter isCapture . filter isCapture
$ req ^. reqUrl.path $ req ^. reqUrl.path
@ -91,7 +91,7 @@ generateVanillaJSWith opts req = "\n" <>
where where
headersStr = T.intercalate "\n" $ map headerStr hs headersStr = T.intercalate "\n" $ map headerStr hs
headerStr header = " xhr.setRequestHeader(\"" <> headerStr header = " xhr.setRequestHeader(\"" <>
header ^. headerArg . aPath <> header ^. headerArg . argPath <>
"\", " <> toJSHeader header <> ");" "\", " <> toJSHeader header <> ");"
namespace = if moduleName opts == "" namespace = if moduleName opts == ""