From 3ef0daabfe0dcdfd80c88f0cd0b89d43dcf5841c Mon Sep 17 00:00:00 2001 From: Matt Bray Date: Sun, 26 Nov 2017 20:15:38 +0000 Subject: [PATCH 1/2] Generate argument lists in the order defined by the API type. --- src/Servant/Elm/Internal/Generate.hs | 87 +++++++++++----------------- stack.yaml | 9 ++- 2 files changed, 41 insertions(+), 55 deletions(-) diff --git a/src/Servant/Elm/Internal/Generate.hs b/src/Servant/Elm/Internal/Generate.hs index cf99500..0489dc8 100644 --- a/src/Servant/Elm/Internal/Generate.hs +++ b/src/Servant/Elm/Internal/Generate.hs @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -423,7 +402,7 @@ mkUrl opts segments = else " |> toString" in - (elmCaptureArg s) <> toStringSrc <> " |> Http.encodeUri" + (elmCaptureArg arg) <> toStringSrc <> " |> Http.encodeUri" mkQueryParams diff --git a/stack.yaml b/stack.yaml index 05d0071..924f40c 100644 --- a/stack.yaml +++ b/stack.yaml @@ -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: From dec33a1ced5e77b9d9b0199c99c28c1e32ed6c2a Mon Sep 17 00:00:00 2001 From: Matt Bray Date: Sun, 26 Nov 2017 20:26:53 +0000 Subject: [PATCH 2/2] Update CHANGELOG. --- CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index b0d6618..732ec78 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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