@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE RecordWildCards #-}
23{-# LANGUAGE FlexibleContexts #-}
34{-# LANGUAGE MultiParamTypeClasses #-}
@@ -19,8 +20,11 @@ import Elm.Json (jsonParserForType, jsonSerForType)
1920import qualified Elm.Module as Elm
2021import Elm.TyRep (ETCon(..), EType(..), ETypeDef(..), toElmType)
2122import Elm.TyRender (renderElm)
23+#if MIN_VERSION_elm_bridge(0,6,0)
24+import Elm.Versions (ElmVersion(Elm0p19))
25+#else
2226import Elm.Versions (ElmVersion(Elm0p18))
23−
27+#endif
2428import Servant.Elm.Internal.Foreign (LangElm, getEndpoints)
2529import qualified Servant.Foreign as F
2630import System.Directory (createDirectoryIfMissing)
@@ -49,16 +53,22 @@ data ElmOptions = ElmOptions
4953 argument.
5054 -}
5155 urlPrefix :: UrlPrefix
52− , elmTypeAlterations :: (EType -> EType)
56+ , elmTypeAlterations :: (EType -> EType)
5357 -- ^ Alterations to perform on ETypes before code generation.
5458 , elmAlterations :: (ETypeDef -> ETypeDef)
5559 -- ^ Alterations to perform on ETypeDefs before code generation.
56− , elmToString :: (EType -> Text)
60+ , elmToString :: (EType -> Text)
5761 -- ^ Elm functions creating a string from a given type.
5862 , emptyResponseElmTypes :: [EType]
5963 -- ^ Types that represent an empty Http response.
6064 , stringElmTypes :: [EType]
6165 -- ^ Types that represent a String.
66+ , expectJsonMethod :: Text
67+ -- ^ The function to use for JSON responses.
68+ , expectStringMethod :: Text
69+ -- ^ The function to use for string responses.
70+ , httpErrorType :: Text
71+ -- ^ The type to use for Http errors.
6272 }
6373
6474
@@ -82,6 +92,9 @@ The default options are:
8292> , stringElmTypes =
8393> [ getType (Proxy :: Proxy String)
8494> , getType (Proxy :: Proxy T.Text) ]
95+> , expectJsonMethod = "Http.expectJson"
96+> , expectStringMethod = "Http.expectString"
97+> , httpErrorType = "Http.Error"
8598> }
8699-}
87100defElmOptions :: ElmOptions
@@ -97,6 +110,9 @@ defElmOptions = ElmOptions
97110 [ toElmType (Proxy :: Proxy String)
98111 , toElmType (Proxy :: Proxy T.Text)
99112 ]
113+ , expectJsonMethod = "Http.expectJson"
114+ , expectStringMethod = "Http.expectString"
115+ , httpErrorType = "Http.Error"
100116 }
101117
102118
@@ -115,6 +131,7 @@ The default required imports are:
115131> import Set
116132> import Http
117133> import String
134+> import Url
118135> import Url.Builder
119136-}
120137defElmImports :: Text
@@ -128,14 +145,8 @@ defElmImports =
128145 , "import Set"
129146 , "import Http"
130147 , "import String"
148+ , "import Url"
131149 , "import Url.Builder"
132− , ""
133− , "maybeBoolToIntStr : Maybe Bool -> String"
134− , "maybeBoolToIntStr mx ="
135− , " case mx of"
136− , " Nothing -> \"\""
137− , " Just True -> \"1\""
138− , " Just False -> \"0\""
139150 ]
140151
141152{-|
@@ -156,7 +167,12 @@ generateElmModuleWith ::
156167generateElmModuleWith options namespace imports rootDir typeDefs api = do
157168 let out =
158169 T.unlines $
159− [ T.pack $ Elm.moduleHeader Elm0p18 moduleName
170+ [
171+#if MIN_VERSION_elm_bridge(0,6,0)
172+ T.pack $ Elm.moduleHeader Elm0p19 moduleName
173+#else
174+ T.pack $ Elm.moduleHeader Elm0p18 moduleName
175+#endif
160176 , ""
161177 , imports
162178 , T.pack $ Elm.makeModuleContentWithAlterations (elmAlterations options) typeDefs
@@ -243,7 +259,7 @@ generateElmForRequest opts request =
243259 fnName =
244260 request ^. F.reqFuncName . to (replace . F.camelCase) . to stext
245261
246− replace = T.replace "-" "" . T.replace "." ""
262+ replace = T.replace "-" "" . T.replace "." "" . T.replace " " ""
247263
248264 typeSignature =
249265 mkTypeSignature opts request
@@ -305,7 +321,7 @@ mkTypeSignature opts request =
305321 toMsgType :: Maybe Doc
306322 toMsgType = do
307323 result <- fmap elmTypeRef $ request ^. F.reqReturnType
308− Just ("(Result Http.Error " <+> parens result <+> " -> msg)")
324+ Just ("(Result" <+> stext (httpErrorType opts) <+> parens result <+> "-> msg)")
309325
310326 returnType :: Maybe Doc
311327 returnType = do
@@ -323,7 +339,7 @@ elmCaptureArg segment =
323339 "capture_" <>
324340 F.captureArg segment ^. F.argName . to (stext . replace . F.unPathSegment)
325341 where
326− replace = T.replace "-" "_"
342+ replace = T.replace "-" "_" . T.replace " " "_"
327343
328344
329345elmQueryArg :: F.QueryArg EType -> Doc
@@ -396,7 +412,7 @@ mkLetParams opts request =
396412 argType = qarg ^. F.queryArgName . F.argType
397413 wrapped = isElmMaybeType argType
398414 toStringSrc =
399− toString opts argType
415+ toString opts (maybeOf argType)
400416 in
401417 "[" <+> (if wrapped then elmName else "Just" <+> elmName) <> line <>
402418 (indent 4 ("|> Maybe.map" <+> composeRight [toStringSrc, "Url.Builder.string" <+> dquotes name]))
@@ -416,18 +432,18 @@ mkLetParams opts request =
416432 F.List ->
417433 let
418434 argType = qarg ^. F.queryArgName . F.argType
419− convertedVal =
420− if isElmListOfMaybeBoolType argType then
421− parens ("maybeBoolToIntStr" <+> "val")
422− else
423− "val"
435+ toStringSrc =
436+ toString opts (listOf (maybeOf argType))
424437 in
425438 elmName <$>
426439 indent 4 ("|> List.map"
427− <+> parens (backslash <> "val ->" <+> "Just"
428− <+> parens ("Url.Builder.string"
429− <+> dquotes (name <> "[]")
430− <+> convertedVal)))
440+ <+> composeRight
441+ [ toStringSrc
442+ , "Url.Builder.string" <+> dquotes (name <> "[]")
443+ , "Just"
444+ ]
445+ )
446+
431447 where
432448 elmName = elmQueryArg qarg
433449 name = qarg ^. F.queryArgName . F.argName . to (stext . F.unPathSegment)
@@ -463,9 +479,9 @@ mkRequest opts request =
463479 headerArgName = elmHeaderArg header
464480 argType = header ^. F.headerArg . F.argType
465481 wrapped = isElmMaybeType argType
466− toStringSrc = toString opts argType
482+ toStringSrc = toString opts (maybeOf argType)
467483 in
468− "Maybe.map" <+> parens (("Http.header" <+> composeLeft [dquotes headerName, toStringSrc]))
484+ "Maybe.map" <+> composeLeft ["Http.header" <+> dquotes headerName, toStringSrc]
469485 <+>
470486 (if wrapped then headerArgName else parens ("Just" <+> headerArgName))
471487
@@ -494,14 +510,14 @@ mkRequest opts request =
494510 expect =
495511 case request ^. F.reqReturnType of
496512 Just elmTypeExpr
497− | isEmptyType opts elmTypeExpr
513+ | isEmptyType opts $ (elmTypeAlterations opts) elmTypeExpr
498514 -- let elmConstructor = T.pack (renderElm elmTypeExpr)
499515 ->
500− "Http.expectString " <> line <+> indent i "(\\x -> case x of" <> line <+>
516+ stext (expectStringMethod opts) <> line <+> indent i "(\\x -> case x of" <> line <+>
501517 indent i "Err e -> toMsg (Err e)" <> line <+>
502518 indent i "Ok _ -> toMsg (Ok ()))"
503519 Just elmTypeExpr ->
504− "Http.expectJson toMsg" <+> renderDecoderName elmTypeExpr
520+ stext (expectJsonMethod opts) <+> "toMsg" <+> renderDecoderName ((elmTypeAlterations opts) elmTypeExpr)
505521 Nothing -> error "mkHttpRequest: no reqReturnType?"
506522 -- case request ^. F.reqReturnType of
507523 -- Just elmTypeExpr | isEmptyType opts elmTypeExpr ->
@@ -529,6 +545,8 @@ renderDecoderName elmTypeExpr =
529545 parens ("Json.Decode.list " <> parens (renderDecoderName t))
530546 ETyApp (ETyCon (ETCon "Maybe")) t ->
531547 parens ("Json.Decode.maybe " <> parens (renderDecoderName t))
548+ ETyApp x y ->
549+ parens (renderDecoderName x <+> renderDecoderName y)
532550 ETyCon (ETCon "Int") -> "Json.Decode.int"
533551 ETyCon (ETCon "String") -> "Json.Decode.string"
534552 _ -> ("jsonDec" <> stext (T.pack (renderElm elmTypeExpr)))
@@ -546,7 +564,7 @@ mkUrl opts segments =
546564 where
547565 urlBuilder :: Doc
548566 urlBuilder = case urlPrefix opts of
549− Dynamic -> "Url.Builder.absolute" :: Doc
567+ Dynamic -> "Url.Builder.crossOrigin urlBase" :: Doc
550568 Static url -> "Url.Builder.crossOrigin" <+> dquotes (stext url)
551569
552570 segmentToDoc :: F.Segment EType -> Doc
@@ -556,10 +574,10 @@ mkUrl opts segments =
556574 dquotes (stext (F.unPathSegment path))
557575 F.Cap arg ->
558576 let
559− toStringSrc =
560− toString opts (arg ^. F.argType)
577+ toStringSrc =
578+ toString opts (elmTypeAlterations opts (maybeOf (arg ^. F.argType)))
561579 in
562− pipeRight [elmCaptureArg s, toStringSrc]
580+ "Url.percentEncode " <> pipeRight [elmCaptureArg s, toStringSrc]
563581
564582
565583mkQueryParams
@@ -577,7 +595,7 @@ response body.
577595-}
578596isEmptyType :: ElmOptions -> EType -> Bool
579597isEmptyType opts elmTypeExpr =
580− elmTypeExpr `elem` emptyResponseElmTypes opts
598+ (elmTypeAlterations opts elmTypeExpr) `elem` emptyResponseElmTypes opts
581599
582600
583601{- | Determines whether we call `toString` on URL captures and query params of
@@ -585,7 +603,7 @@ this type in Elm.
585603-}
586604isElmStringType :: ElmOptions -> EType -> Bool
587605isElmStringType opts elmTypeExpr =
588− elmTypeExpr `elem` stringElmTypes opts
606+ (elmTypeAlterations opts elmTypeExpr) `elem` stringElmTypes opts
589607
590608{- | Determines whether a type is 'Maybe a' where 'a' is something akin to a 'String'.
591609-}
@@ -627,14 +645,24 @@ elmListOfMaybes ds = "List.filterMap identity" <$> indent 4 (elmList ds)
627645defaultElmToString :: EType -> Text
628646defaultElmToString argType =
629647 case argType of
630− ETyCon (ETCon "Bool") -> "(\\value -> if value then \"1\" else \"0\")"
631− ETyCon (ETCon "Posix") -> "Time.posixToMillis >> String.fromInt)"
632− ETyApp (ETyCon (ETCon "Maybe")) v -> defaultElmToString v
648+ ETyCon (ETCon "Bool") -> "(\\value -> if value then \"true\" else \"false\")"
649+ ETyCon (ETCon "Float") -> "String.fromFloat"
650+ ETyCon (ETCon "Char") -> "String.fromChar"
651+ ETyApp (ETyCon (ETCon "Maybe")) v -> "(Maybe.map " <> defaultElmToString v <> " >> Maybe.withDefault \"\")"
633652 _ -> "String.fromInt"
634653
654+
655+maybeOf :: EType -> EType
656+maybeOf (ETyApp (ETyCon (ETCon "Maybe")) v) = v
657+maybeOf v = v
658+
659+listOf :: EType -> EType
660+listOf (ETyApp (ETyCon (ETCon "List")) v) = v
661+listOf v = v
662+
635663toString :: ElmOptions -> EType -> Doc
636664toString opts argType =
637− if isElmStringType opts argType || isElmMaybeStringType opts argType then
665+ if isElmStringType opts argType then
638666 mempty
639667 else
640668 stext $ elmToString opts argType