Merge pull request #74 from cachix/feat-http-type

Allow overriding the `Http.Error` type

src/Servant/Elm/Internal/Generate.hs

@@ -53,17 +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.
   }
 
 
@@ -87,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
@@ -103,6 +111,8 @@ defElmOptions = ElmOptions
       , toElmType (Proxy :: Proxy T.Text)
       ]
   , expectJsonMethod = "Http.expectJson"
+  , expectStringMethod = "Http.expectString"
+  , httpErrorType = "Http.Error"
   }
 
 
@@ -311,7 +321,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
@@ -503,11 +513,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 ->

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 =

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 =

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 =

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 ()))

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 =

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 =

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 =

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 =

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 =

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 ()))

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 =

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 ()))