From eee0564758b337c3dd9a6122b89dac74303a4844 Mon Sep 17 00:00:00 2001 From: sandydoo Date: Mon, 13 Feb 2023 14:15:35 +0000 Subject: [PATCH 1/4] Allow changing the HTTP error type --- src/Servant/Elm/Internal/Generate.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Servant/Elm/Internal/Generate.hs b/src/Servant/Elm/Internal/Generate.hs index d481e44..53d61ab 100644 --- a/src/Servant/Elm/Internal/Generate.hs +++ b/src/Servant/Elm/Internal/Generate.hs @@ -64,6 +64,7 @@ data ElmOptions = ElmOptions , stringElmTypes :: [EType] -- ^ Types that represent a String. , expectJsonMethod :: Text + , httpErrorType :: Text } @@ -103,6 +104,7 @@ defElmOptions = ElmOptions , toElmType (Proxy :: Proxy T.Text) ] , expectJsonMethod = "Http.expectJson" + , httpErrorType = "Http.Error" } @@ -311,7 +313,7 @@ mkTypeSignature opts request = toMsgType :: Maybe Doc toMsgType = do result <- fmap elmTypeRef $ request ^. F.reqReturnType - Just ("(Result Http.Error " <+> parens result <+> " -> msg)") + Just ("(Result" <+> stext (httpErrorType opts) <+> parens result <+> " -> msg)") returnType :: Maybe Doc returnType = do From 5faec7e3827317b9d887063f24ad83e8d9687543 Mon Sep 17 00:00:00 2001 From: sandydoo Date: Mon, 13 Feb 2023 14:22:23 +0000 Subject: [PATCH 2/4] Allow to modify the default expectString method --- src/Servant/Elm/Internal/Generate.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Servant/Elm/Internal/Generate.hs b/src/Servant/Elm/Internal/Generate.hs index 53d61ab..70fe12c 100644 --- a/src/Servant/Elm/Internal/Generate.hs +++ b/src/Servant/Elm/Internal/Generate.hs @@ -64,6 +64,7 @@ data ElmOptions = ElmOptions , stringElmTypes :: [EType] -- ^ Types that represent a String. , expectJsonMethod :: Text + , expectStringMethod :: Text , httpErrorType :: Text } @@ -104,6 +105,7 @@ defElmOptions = ElmOptions , toElmType (Proxy :: Proxy T.Text) ] , expectJsonMethod = "Http.expectJson" + , expectStringMethod = "Http.expectString" , httpErrorType = "Http.Error" } @@ -313,7 +315,7 @@ mkTypeSignature opts request = toMsgType :: Maybe Doc toMsgType = do result <- fmap elmTypeRef $ request ^. F.reqReturnType - Just ("(Result" <+> stext (httpErrorType opts) <+> parens result <+> " -> msg)") + Just ("(Result" <+> stext (httpErrorType opts) <+> parens result <+> "-> msg)") returnType :: Maybe Doc returnType = do @@ -505,11 +507,11 @@ mkRequest opts request = | isEmptyType opts $ (elmTypeAlterations opts) elmTypeExpr -- let elmConstructor = T.pack (renderElm elmTypeExpr) -> - "Http.expectString " <> line <+> indent i "(\\x -> case x of" <> line <+> + stext (expectStringMethod opts) <> line <+> indent i "(\\x -> case x of" <> line <+> indent i "Err e -> toMsg (Err e)" <> line <+> indent i "Ok _ -> toMsg (Ok ()))" Just elmTypeExpr -> - stext (expectJsonMethod opts) <+> " toMsg" <+> renderDecoderName ((elmTypeAlterations opts) elmTypeExpr) + stext (expectJsonMethod opts) <+> "toMsg" <+> renderDecoderName ((elmTypeAlterations opts) elmTypeExpr) Nothing -> error "mkHttpRequest: no reqReturnType?" -- case request ^. F.reqReturnType of -- Just elmTypeExpr | isEmptyType opts elmTypeExpr -> From 54754b6a3e96ec4daded11bf84d5b9bc1f7b9052 Mon Sep 17 00:00:00 2001 From: Sander Date: Fri, 12 Jan 2024 20:59:33 +0000 Subject: [PATCH 3/4] Update docs --- src/Servant/Elm/Internal/Generate.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/Servant/Elm/Internal/Generate.hs b/src/Servant/Elm/Internal/Generate.hs index 70fe12c..ceb4d74 100644 --- a/src/Servant/Elm/Internal/Generate.hs +++ b/src/Servant/Elm/Internal/Generate.hs @@ -53,19 +53,22 @@ data ElmOptions = ElmOptions argument. -} urlPrefix :: UrlPrefix - , elmTypeAlterations :: (EType -> EType) + , elmTypeAlterations :: (EType -> EType) -- ^ Alterations to perform on ETypes before code generation. , elmAlterations :: (ETypeDef -> ETypeDef) -- ^ Alterations to perform on ETypeDefs before code generation. - , elmToString :: (EType -> Text) + , elmToString :: (EType -> Text) -- ^ Elm functions creating a string from a given type. , emptyResponseElmTypes :: [EType] -- ^ Types that represent an empty Http response. , stringElmTypes :: [EType] -- ^ Types that represent a String. , expectJsonMethod :: Text + -- ^ The function to use for JSON responses. , expectStringMethod :: Text + -- ^ The function to use for string responses. , httpErrorType :: Text + -- ^ The type to use for Http errors. } @@ -89,6 +92,9 @@ The default options are: > , stringElmTypes = > [ getType (Proxy :: Proxy String) > , getType (Proxy :: Proxy T.Text) ] +> , expectJsonMethod = "Http.expectJson" +> , expectStringMethod = "Http.expectString" +> , httpErrorType = "Http.Error" > } -} defElmOptions :: ElmOptions From 6955f4527a42eb0a441ee25166ac82186a8ebb4e Mon Sep 17 00:00:00 2001 From: Sander Date: Fri, 12 Jan 2024 22:01:10 +0000 Subject: [PATCH 4/4] Update golden tests Removed extraneous spaces. --- test/elm-sources/getBooksByIdSource.elm | 2 +- test/elm-sources/getBooksByTitleSource.elm | 2 +- test/elm-sources/getBooksSource.elm | 2 +- test/elm-sources/getNothingSource.elm | 4 ++-- test/elm-sources/getOneSource.elm | 2 +- test/elm-sources/getOneWithDynamicUrlSource.elm | 2 +- test/elm-sources/getPolymorphicData.elm | 2 +- test/elm-sources/getWithaheaderSource.elm | 2 +- test/elm-sources/getWitharesponseheaderSource.elm | 2 +- test/elm-sources/postBooksSource.elm | 4 ++-- test/elm-sources/postTwoSource.elm | 2 +- test/elm-sources/putNothingSource.elm | 4 ++-- 12 files changed, 15 insertions(+), 15 deletions(-) diff --git a/test/elm-sources/getBooksByIdSource.elm b/test/elm-sources/getBooksByIdSource.elm index 3ace861..dee5363 100644 --- a/test/elm-sources/getBooksByIdSource.elm +++ b/test/elm-sources/getBooksByIdSource.elm @@ -8,7 +8,7 @@ type Book = Book jsonDecBook : Json.Decode.Decoder Book jsonDecBook = Debug.todo "" -getBooksById : Int -> (Result Http.Error (Book) -> msg) -> Cmd msg +getBooksById : Int -> (Result Http.Error (Book) -> msg) -> Cmd msg getBooksById capture_id toMsg = let params = diff --git a/test/elm-sources/getBooksByTitleSource.elm b/test/elm-sources/getBooksByTitleSource.elm index 01de823..3f23932 100644 --- a/test/elm-sources/getBooksByTitleSource.elm +++ b/test/elm-sources/getBooksByTitleSource.elm @@ -7,7 +7,7 @@ import Json.Decode as J type alias Book = {} jsonDecBook = J.succeed {} -getBooksByTitlespace : String -> (Result Http.Error (Book) -> msg) -> Cmd msg +getBooksByTitlespace : String -> (Result Http.Error (Book) -> msg) -> Cmd msg getBooksByTitlespace capture_title_space toMsg = let params = diff --git a/test/elm-sources/getBooksSource.elm b/test/elm-sources/getBooksSource.elm index 12152a4..6b37fb1 100644 --- a/test/elm-sources/getBooksSource.elm +++ b/test/elm-sources/getBooksSource.elm @@ -9,7 +9,7 @@ type alias Book = {} jsonDecBook = J.succeed {} -getBooks : Bool -> (Maybe String) -> (Maybe Int) -> String -> (List (Maybe Bool)) -> (Result Http.Error ((List Book)) -> msg) -> Cmd msg +getBooks : Bool -> (Maybe String) -> (Maybe Int) -> String -> (List (Maybe Bool)) -> (Result Http.Error ((List Book)) -> msg) -> Cmd msg getBooks query_published query_sort query_year query_category query_filters toMsg = let params = diff --git a/test/elm-sources/getNothingSource.elm b/test/elm-sources/getNothingSource.elm index e763ead..a4942ef 100644 --- a/test/elm-sources/getNothingSource.elm +++ b/test/elm-sources/getNothingSource.elm @@ -4,7 +4,7 @@ import Http import Url.Builder -getNothing : (Result Http.Error (()) -> msg) -> Cmd msg +getNothing : (Result Http.Error (()) -> msg) -> Cmd msg getNothing toMsg = let params = @@ -25,7 +25,7 @@ getNothing toMsg = , body = Http.emptyBody , expect = - Http.expectString + Http.expectString (\x -> case x of Err e -> toMsg (Err e) Ok _ -> toMsg (Ok ())) diff --git a/test/elm-sources/getOneSource.elm b/test/elm-sources/getOneSource.elm index e5e4786..fa9cc4e 100644 --- a/test/elm-sources/getOneSource.elm +++ b/test/elm-sources/getOneSource.elm @@ -5,7 +5,7 @@ import Json.Decode exposing (..) import Url.Builder -getOne : (Result Http.Error (Int) -> msg) -> Cmd msg +getOne : (Result Http.Error (Int) -> msg) -> Cmd msg getOne toMsg = let params = diff --git a/test/elm-sources/getOneWithDynamicUrlSource.elm b/test/elm-sources/getOneWithDynamicUrlSource.elm index b7ab5c6..557ccdc 100644 --- a/test/elm-sources/getOneWithDynamicUrlSource.elm +++ b/test/elm-sources/getOneWithDynamicUrlSource.elm @@ -5,7 +5,7 @@ import Url.Builder import Json.Decode exposing (..) -getOne : String -> (Result Http.Error (Int) -> msg) -> Cmd msg +getOne : String -> (Result Http.Error (Int) -> msg) -> Cmd msg getOne urlBase toMsg = let params = diff --git a/test/elm-sources/getPolymorphicData.elm b/test/elm-sources/getPolymorphicData.elm index c264b33..591f900 100644 --- a/test/elm-sources/getPolymorphicData.elm +++ b/test/elm-sources/getPolymorphicData.elm @@ -14,7 +14,7 @@ jsonDecSomeRecord : Json.Decode.Decoder SomeRecord jsonDecSomeRecord = Debug.todo "finish" -getPolymorphicData : (Result Http.Error ((PolymorphicData (List String) SomeRecord)) -> msg) -> Cmd msg +getPolymorphicData : (Result Http.Error ((PolymorphicData (List String) SomeRecord)) -> msg) -> Cmd msg getPolymorphicData toMsg = let params = diff --git a/test/elm-sources/getWithaheaderSource.elm b/test/elm-sources/getWithaheaderSource.elm index 789bc47..b42406b 100644 --- a/test/elm-sources/getWithaheaderSource.elm +++ b/test/elm-sources/getWithaheaderSource.elm @@ -5,7 +5,7 @@ import Url.Builder import Json.Decode exposing (..) -getWithaheader : (Maybe String) -> (Maybe Int) -> String -> Int -> (Result Http.Error (String) -> msg) -> Cmd msg +getWithaheader : (Maybe String) -> (Maybe Int) -> String -> Int -> (Result Http.Error (String) -> msg) -> Cmd msg getWithaheader header_myStringHeader header_MyIntHeader header_MyRequiredStringHeader header_MyRequiredIntHeader toMsg = let params = diff --git a/test/elm-sources/getWitharesponseheaderSource.elm b/test/elm-sources/getWitharesponseheaderSource.elm index 20e1103..2cb33fc 100644 --- a/test/elm-sources/getWitharesponseheaderSource.elm +++ b/test/elm-sources/getWitharesponseheaderSource.elm @@ -5,7 +5,7 @@ import Url.Builder import Json.Decode exposing (..) -getWitharesponseheader : (Result Http.Error (String) -> msg) -> Cmd msg +getWitharesponseheader : (Result Http.Error (String) -> msg) -> Cmd msg getWitharesponseheader toMsg = let params = diff --git a/test/elm-sources/postBooksSource.elm b/test/elm-sources/postBooksSource.elm index 78b164a..6240db1 100644 --- a/test/elm-sources/postBooksSource.elm +++ b/test/elm-sources/postBooksSource.elm @@ -7,7 +7,7 @@ import Json.Encode as Enc type alias Book = {} jsonEncBook = \b -> Enc.object [] -postBooks : Book -> (Result Http.Error (()) -> msg) -> Cmd msg +postBooks : Book -> (Result Http.Error (()) -> msg) -> Cmd msg postBooks body toMsg = let params = @@ -28,7 +28,7 @@ postBooks body toMsg = , body = Http.jsonBody (jsonEncBook body) , expect = - Http.expectString + Http.expectString (\x -> case x of Err e -> toMsg (Err e) Ok _ -> toMsg (Ok ())) diff --git a/test/elm-sources/postTwoSource.elm b/test/elm-sources/postTwoSource.elm index e1aa208..42be1e8 100644 --- a/test/elm-sources/postTwoSource.elm +++ b/test/elm-sources/postTwoSource.elm @@ -6,7 +6,7 @@ import Json.Encode import Url.Builder -postTwo : String -> (Result Http.Error ((Maybe Int)) -> msg) -> Cmd msg +postTwo : String -> (Result Http.Error ((Maybe Int)) -> msg) -> Cmd msg postTwo body toMsg = let params = diff --git a/test/elm-sources/putNothingSource.elm b/test/elm-sources/putNothingSource.elm index b026ba1..d457f90 100644 --- a/test/elm-sources/putNothingSource.elm +++ b/test/elm-sources/putNothingSource.elm @@ -4,7 +4,7 @@ import Http import Url.Builder -putNothing : (Result Http.Error (()) -> msg) -> Cmd msg +putNothing : (Result Http.Error (()) -> msg) -> Cmd msg putNothing toMsg = let params = @@ -25,7 +25,7 @@ putNothing toMsg = , body = Http.emptyBody , expect = - Http.expectString + Http.expectString (\x -> case x of Err e -> toMsg (Err e) Ok _ -> toMsg (Ok ()))