Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Generate argument lists in the order defined by the API type. #34

Closed
wants to merge 2 commits into from
Closed

Generate argument lists in the order defined by the API type. #34

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
3ef0daa
Generate argument lists in the order defined by the API type.
mattjbray Nov 26, 2017
dec33a1
Update CHANGELOG.
mattjbray Nov 26, 2017
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions CHANGELOG.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,7 @@
0.4.0.2
-------
* Generate argument lists in the order defined by the API type. (#34)

0.4.0.1
-------
* Remove hyphens from generated function names. (servant-foreign-0.10 no longer
Expand Down
87 changes: 33 additions & 54 deletions src/Servant/Elm/Internal/Generate.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@ module Servant.Elm.Internal.Generate where
import Prelude hiding ((<$>))
import Control.Lens (to, (^.))
import Data.List (nub)
import Data.Maybe (catMaybes)
import Data.Maybe (catMaybes, mapMaybe)
import Data.Proxy (Proxy)
import Data.Text (Text)
import qualified Data.Text as T
Expand Down Expand Up @@ -178,10 +178,8 @@ mkTypeSignature :: ElmOptions -> F.Req ElmDatatype -> Doc
mkTypeSignature opts request =
(hsep . punctuate " ->" . concat)
[ catMaybes [urlPrefixType]
, headerTypes
, urlCaptureTypes
, queryTypes
, catMaybes [bodyType, returnType]
, mapMaybe (fmap elmTypeRef . reqPartToElmDatatype) (request ^. F.reqParts)
, catMaybes [returnType]
]
where
urlPrefixType :: Maybe Doc
Expand All @@ -190,40 +188,28 @@ mkTypeSignature opts request =
Dynamic -> Just "String"
Static _ -> Nothing

reqPartToElmDatatype :: F.ReqPart ElmDatatype -> Maybe ElmDatatype
reqPartToElmDatatype (F.ReqSegment (F.Segment (F.Static _))) = Nothing
reqPartToElmDatatype (F.ReqSegment (F.Segment (F.Cap capture))) =
Just $ capture ^. F.argType
reqPartToElmDatatype (F.ReqQueryArg queryArg) =
let wrapper =
case queryArg ^. F.queryArgType of
F.Normal ->
Elm.ElmPrimitive . Elm.EMaybe
_ ->
id
in
Just $ queryArg ^. F.queryArgName . F.argType . to wrapper
reqPartToElmDatatype (F.ReqHeaderArg headerArg) =
Just $ headerArg ^. F.headerArg . F.argType
reqPartToElmDatatype (F.ReqBody body) = Just body


elmTypeRef :: ElmDatatype -> Doc
elmTypeRef eType =
stext (Elm.toElmTypeRefWith (elmExportOptions opts) eType)

headerTypes :: [Doc]
headerTypes =
[ header ^. F.headerArg . F.argType . to elmTypeRef
| header <- request ^. F.reqHeaders
]

urlCaptureTypes :: [Doc]
urlCaptureTypes =
[ F.captureArg capture ^. F.argType . to elmTypeRef
| capture <- request ^. F.reqUrl . F.path
, F.isCapture capture
]

queryTypes :: [Doc]
queryTypes =
[ arg ^. F.queryArgName . F.argType . to (elmTypeRef . wrapper)
| arg <- request ^. F.reqUrl . F.queryStr
, wrapper <- [
case arg ^. F.queryArgType of
F.Normal ->
Elm.ElmPrimitive . Elm.EMaybe
_ ->
id
]
]

bodyType :: Maybe Doc
bodyType =
fmap elmTypeRef $ request ^. F.reqBody

returnType :: Maybe Doc
returnType = do
result <- fmap elmTypeRef $ request ^. F.reqReturnType
Expand All @@ -236,10 +222,10 @@ elmHeaderArg header =
header ^. F.headerArg . F.argName . to (stext . T.replace "-" "_" . F.unPathSegment)


elmCaptureArg :: F.Segment ElmDatatype -> Doc
elmCaptureArg segment =
elmCaptureArg :: F.Arg ElmDatatype -> Doc
elmCaptureArg arg =
"capture_" <>
F.captureArg segment ^. F.argName . to (stext . F.unPathSegment)
arg ^. F.argName . to (stext . F.unPathSegment)


elmQueryArg :: F.QueryArg ElmDatatype -> Doc
Expand All @@ -263,22 +249,15 @@ mkArgs opts request =
case urlPrefix opts of
Dynamic -> ["urlBase"]
Static _ -> []
, -- Headers
[ elmHeaderArg header
| header <- request ^. F.reqHeaders
]
, -- URL Captures
[ elmCaptureArg segment
| segment <- request ^. F.reqUrl . F.path
, F.isCapture segment
]
, -- Query params
[ elmQueryArg arg
| arg <- request ^. F.reqUrl . F.queryStr
]
, -- Request body
maybe [] (const [elmBodyArg]) (request ^. F.reqBody)
, mapMaybe reqPartToElmArg (request ^. F.reqParts)
]
where
reqPartToElmArg :: F.ReqPart ElmDatatype -> Maybe Doc
reqPartToElmArg (F.ReqSegment (F.Segment (F.Static _))) = Nothing
reqPartToElmArg (F.ReqSegment (F.Segment (F.Cap capture))) = Just $ elmCaptureArg capture
reqPartToElmArg (F.ReqQueryArg queryArg) = Just $ elmQueryArg queryArg
reqPartToElmArg (F.ReqHeaderArg headerArg) = Just $ elmHeaderArg headerArg
reqPartToElmArg (F.ReqBody _) = Just $ elmBodyArg


mkLetParams :: ElmOptions -> F.Req ElmDatatype -> Maybe Doc
Expand Down Expand Up @@ -423,7 +402,7 @@ mkUrl opts segments =
else
" |> toString"
in
(elmCaptureArg s) <> toStringSrc <> " |> Http.encodeUri"
(elmCaptureArg arg) <> toStringSrc <> " |> Http.encodeUri"


mkQueryParams
Expand Down
9 changes: 8 additions & 1 deletion stack.yaml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,11 +1,18 @@
# For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md

# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
resolver: lts-8.0
resolver: lts-9.10

# Local packages, usually specified by relative directory name
packages:
- '.'
- location:
git: https://github.com/mattjbray/servant
commit: acc1945d60531a0e74d5f1e959c0a150e1e974bb
subdirs:
- servant
- servant-foreign
extra-dep: true

# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)
extra-deps:
Expand Down