diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +0.5.0.0 +------- +* Fix generation for APIs with response headers. +* Support Servant's `Optional` and `Required` modifiers for + `Header`s and `QueryParam`s (`Header` arguments are now `Maybe`s + by default). (phaazon) (#31) +* Filter out forbidden Cookie header. (xilnocas) (#37) + 0.4.0.1 ------- * Remove hyphens from generated function names. (servant-foreign-0.10 no longer diff --git a/servant-elm.cabal b/servant-elm.cabal --- a/servant-elm.cabal +++ b/servant-elm.cabal @@ -1,5 +1,5 @@ name: servant-elm -version: 0.4.0.1 +version: 0.5.0.0 synopsis: Automatically derive Elm functions to query servant webservices. description: Please see README.md homepage: http://github.com/mattjbray/servant-elm#readme diff --git a/src/Servant/Elm/Internal/Generate.hs b/src/Servant/Elm/Internal/Generate.hs --- a/src/Servant/Elm/Internal/Generate.hs +++ b/src/Servant/Elm/Internal/Generate.hs @@ -12,7 +12,7 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as L import qualified Data.Text.Encoding as T -import Elm (ElmDatatype) +import Elm (ElmDatatype(..), ElmPrimitive(..)) import qualified Elm import Servant.API (NoContent (..)) import Servant.Elm.Internal.Foreign (LangElm, getEndpoints) @@ -198,6 +198,7 @@ headerTypes = [ header ^. F.headerArg . F.argType . to elmTypeRef | header <- request ^. F.reqHeaders + , isNotCookie header ] urlCaptureTypes :: [Doc] @@ -209,15 +210,8 @@ queryTypes :: [Doc] queryTypes = - [ arg ^. F.queryArgName . F.argType . to (elmTypeRef . wrapper) + [ arg ^. F.queryArgName . F.argType . to elmTypeRef | arg <- request ^. F.reqUrl . F.queryStr - , wrapper <- [ - case arg ^. F.queryArgType of - F.Normal -> - Elm.ElmPrimitive . Elm.EMaybe - _ -> - id - ] ] bodyType :: Maybe Doc @@ -233,7 +227,7 @@ elmHeaderArg :: F.HeaderArg ElmDatatype -> Doc elmHeaderArg header = "header_" <> - header ^. F.headerArg . F.argName . to (stext . F.unPathSegment) + header ^. F.headerArg . F.argName . to (stext . T.replace "-" "_" . F.unPathSegment) elmCaptureArg :: F.Segment ElmDatatype -> Doc @@ -253,6 +247,14 @@ "body" +isNotCookie :: F.HeaderArg f -> Bool +isNotCookie header = + header + ^. F.headerArg + . F.argName + . to ((/= "cookie") . T.toLower . F.unPathSegment) + + mkArgs :: ElmOptions -> F.Req ElmDatatype @@ -266,6 +268,7 @@ , -- Headers [ elmHeaderArg header | header <- request ^. F.reqHeaders + , isNotCookie header ] , -- URL Captures [ elmCaptureArg segment @@ -299,14 +302,16 @@ case qarg ^. F.queryArgType of F.Normal -> let + argType = qarg ^. F.queryArgName . F.argType + wrapped = isElmMaybeType argType -- Don't use "toString" on Elm Strings, otherwise we get extraneous quotes. toStringSrc = - if isElmStringType opts (qarg ^. F.queryArgName . F.argType) then + if isElmStringType opts argType || isElmMaybeStringType opts argType then "" else "toString >> " in - name <$> + (if wrapped then name else "Just" <+> name) <$> indent 4 ("|> Maybe.map" <+> parens (toStringSrc <> "Http.encodeUri >> (++)" <+> dquotes (elmName <> equals)) <$> "|> Maybe.withDefault" <+> dquotes empty) @@ -334,7 +339,7 @@ indent i (dquotes method) , "headers =" <$> indent i - (elmList headers) + (elmListOfMaybes headers) , "url =" <$> indent i url , "body =" <$> @@ -350,17 +355,26 @@ method = request ^. F.reqMethod . to (stext . T.decodeUtf8) + mkHeader header = + let headerName = header ^. F.headerArg . F.argName . to (stext . F.unPathSegment) + headerArgName = elmHeaderArg header + argType = header ^. F.headerArg . F.argType + wrapped = isElmMaybeType argType + toStringSrc = + if isElmMaybeStringType opts argType || isElmStringType opts argType then + mempty + else + " << toString" + in + "Maybe.map" <+> parens (("Http.header" <+> dquotes headerName <> toStringSrc)) + <+> + (if wrapped then headerArgName else parens ("Just" <+> headerArgName)) + headers = - [("Http.header" <+> dquotes headerName <+> - (if isElmStringType opts (header ^. F.headerArg . F.argType) then - headerArgName - else - parens ("toString " <> headerArgName) - )) - | header <- request ^. F.reqHeaders - , headerName <- [header ^. F.headerArg . F.argName . to (stext . F.unPathSegment)] - , headerArgName <- [elmHeaderArg header] - ] + [ mkHeader header + | header <- request ^. F.reqHeaders + , isNotCookie header + ] url = mkUrl opts (request ^. F.reqUrl . F.path) @@ -454,7 +468,17 @@ isElmStringType opts elmTypeExpr = elmTypeExpr `elem` stringElmTypes opts +{- | Determines whether a type is 'Maybe a' where 'a' is something akin to a 'String'. +-} +isElmMaybeStringType :: ElmOptions -> ElmDatatype -> Bool +isElmMaybeStringType opts (ElmPrimitive (EMaybe elmTypeExpr)) = elmTypeExpr `elem` stringElmTypes opts +isElmMaybeStringType _ _ = False +isElmMaybeType :: ElmDatatype -> Bool +isElmMaybeType (ElmPrimitive (EMaybe _)) = True +isElmMaybeType _ = False + + -- Doc helpers @@ -471,3 +495,7 @@ elmList :: [Doc] -> Doc elmList [] = lbracket <> rbracket elmList ds = lbracket <+> hsep (punctuate (line <> comma) ds) <$> rbracket + +elmListOfMaybes :: [Doc] -> Doc +elmListOfMaybes [] = lbracket <> rbracket +elmListOfMaybes ds = "List.filterMap identity" <$> indent 4 (elmList ds) diff --git a/src/Servant/Elm/Internal/Orphans.hs b/src/Servant/Elm/Internal/Orphans.hs --- a/src/Servant/Elm/Internal/Orphans.hs +++ b/src/Servant/Elm/Internal/Orphans.hs @@ -1,10 +1,11 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Servant.Elm.Internal.Orphans where import Elm (ElmDatatype, ElmType, toElmType) -import Servant.API (NoContent) +import Servant.API (NoContent, Headers, getResponse) instance ElmType ElmDatatype where @@ -12,3 +13,9 @@ instance ElmType NoContent + + +-- TODO: Generate Elm functions that can handle the response headers. PRs +-- welcome! +instance (ElmType a) => ElmType (Headers ls a) where + toElmType = toElmType . getResponse diff --git a/test/Common.hs b/test/Common.hs --- a/test/Common.hs +++ b/test/Common.hs @@ -3,14 +3,15 @@ {-# LANGUAGE TypeOperators #-} module Common where -import Data.Text (Text) import Data.Aeson (ToJSON) -import Data.Proxy (Proxy(Proxy)) +import Data.Proxy (Proxy (Proxy)) +import Data.Text (Text) import Elm (ElmType) import GHC.Generics (Generic) import Servant.API ((:<|>), (:>), Capture, Get, GetNoContent, Header, - JSON, NoContent, Post, PostNoContent, Put, - QueryFlag, QueryParam, QueryParams, ReqBody) + Header', Headers, JSON, NoContent, Post, + PostNoContent, Put, QueryFlag, QueryParam, + QueryParam', QueryParams, ReqBody, Required) data Book = Book { title :: String @@ -35,6 +36,7 @@ :> QueryFlag "published" :> QueryParam "sort" String :> QueryParam "year" Int + :> QueryParam' '[Required] "category" String :> QueryParams "filters" (Maybe Bool) :> Get '[JSON] [Book] :<|> "books" @@ -45,9 +47,14 @@ :<|> "nothing" :> Put '[JSON] () -- old way to specify no content :<|> "with-a-header" + :> Header "Cookie" String :> Header "myStringHeader" String :> Header "MyIntHeader" Int + :> Header' '[Required] "MyRequiredStringHeader" String + :> Header' '[Required] "MyRequiredIntHeader" Int :> Get '[JSON] String + :<|> "with-a-response-header" + :> Get '[JSON] (Headers '[Header "myResponse" String] String) testApi :: Proxy TestApi testApi = Proxy diff --git a/test/GenerateSpec.hs b/test/GenerateSpec.hs --- a/test/GenerateSpec.hs +++ b/test/GenerateSpec.hs @@ -63,6 +63,10 @@ , ( "test/elm-sources/getWithaheaderSource.elm" , "module GetWithAHeaderSource exposing (..)\n\n" <> "import Http\n" <> + "import Json.Decode exposing (..)\n\n\n") + , ( "test/elm-sources/getWitharesponseheaderSource.elm" + , "module GetWithAResponseHeaderSource exposing (..)\n\n" <> + "import Http\n" <> "import Json.Decode exposing (..)\n\n\n")] let generated = map (<> "\n") (generateElmForAPI testApi) generated `itemsShouldBe` expected diff --git a/test/elm-sources/getBooksSource.elm b/test/elm-sources/getBooksSource.elm --- a/test/elm-sources/getBooksSource.elm +++ b/test/elm-sources/getBooksSource.elm @@ -4,8 +4,8 @@ import Json.Decode exposing (..) -getBooks : Bool -> Maybe (String) -> Maybe (Int) -> List (Maybe (Bool)) -> Http.Request (List (Book)) -getBooks query_published query_sort query_year query_filters = +getBooks : Bool -> Maybe (String) -> Maybe (Int) -> String -> List (Maybe (Bool)) -> Http.Request (List (Book)) +getBooks query_published query_sort query_year query_category query_filters = let params = List.filter (not << String.isEmpty) @@ -18,6 +18,9 @@ |> Maybe.withDefault "" , query_year |> Maybe.map (toString >> Http.encodeUri >> (++) "year=") + |> Maybe.withDefault "" + , Just query_category + |> Maybe.map (Http.encodeUri >> (++) "category=") |> Maybe.withDefault "" , query_filters |> List.map (\val -> "query_filters[]=" ++ (val |> toString |> Http.encodeUri)) diff --git a/test/elm-sources/getWithaheaderSource.elm b/test/elm-sources/getWithaheaderSource.elm --- a/test/elm-sources/getWithaheaderSource.elm +++ b/test/elm-sources/getWithaheaderSource.elm @@ -4,15 +4,18 @@ import Json.Decode exposing (..) -getWithaheader : String -> Int -> Http.Request (String) -getWithaheader header_myStringHeader header_MyIntHeader = +getWithaheader : Maybe (String) -> Maybe (Int) -> String -> Int -> Http.Request (String) +getWithaheader header_myStringHeader header_MyIntHeader header_MyRequiredStringHeader header_MyRequiredIntHeader = Http.request { method = "GET" , headers = - [ Http.header "myStringHeader" header_myStringHeader - , Http.header "MyIntHeader" (toString header_MyIntHeader) - ] + List.filterMap identity + [ Maybe.map (Http.header "myStringHeader") header_myStringHeader + , Maybe.map (Http.header "MyIntHeader" << toString) header_MyIntHeader + , Maybe.map (Http.header "MyRequiredStringHeader") (Just header_MyRequiredStringHeader) + , Maybe.map (Http.header "MyRequiredIntHeader" << toString) (Just header_MyRequiredIntHeader) + ] , url = String.join "/" [ "" diff --git a/test/elm-sources/getWitharesponseheaderSource.elm b/test/elm-sources/getWitharesponseheaderSource.elm new file mode 100644 --- /dev/null +++ b/test/elm-sources/getWitharesponseheaderSource.elm @@ -0,0 +1,27 @@ +module GetWithAResponseHeaderSource exposing (..) + +import Http +import Json.Decode exposing (..) + + +getWitharesponseheader : Http.Request (String) +getWitharesponseheader = + Http.request + { method = + "GET" + , headers = + [] + , url = + String.join "/" + [ "" + , "with-a-response-header" + ] + , body = + Http.emptyBody + , expect = + Http.expectJson string + , timeout = + Nothing + , withCredentials = + False + }