98097b2...master · haskell-servant/servant-elm

.github/workflows/build.yamlnew file+41

since splitsnapshots

unifiedsplit

@@ -0,0 +1,41 @@

1+name: Haskell CI

2+

3+on:

4+ push:

5+ branches: [ "master" ]

6+ pull_request:

7+ branches: [ "master" ]

8+

9+permissions:

10+ contents: read

11+

12+jobs:

13+ build:

14+

15+ runs-on: ubuntu-latest

16+

17+ steps:

18+ - uses: actions/checkout@v3

19+

20+ - name: Install Nix

21+ uses: cachix/install-nix-action@v20

22+ with:

23+ nix_path: nixpkgs=channel:nixos-unstable

24+

25+ - name: Cache

26+ uses: actions/cache@v3

27+ env:

28+ cache-name: cache-cabal

29+ with:

30+ path: ~/.stack

31+ key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/stack.yaml') }}

32+ restore-keys: |

33+ ${{ runner.os }}-build-${{ env.cache-name }}-

34+ ${{ runner.os }}-build-

35+ ${{ runner.os }}-

36+

37+ - name: Build

38+ run: stack build --test --no-run-tests

39+

40+ - name: Run tests

41+ run: stack test

.gitignore+1

@@ -3,3 +3,4 @@ elm-stuff

3/_test-cache/

4TAGS

5.dir-locals.el

6+stack.yaml.lock

CHANGELOG.md+20

@@ -1,3 +1,23 @@

1+0.7.2

2+-----

3+

4+* Commit a80f8b41d37d11778d2c27e6b38e881a71e85343. Fix for elm-bridge-0.6.0

5+

6+0.7.1

7+-----

8+

9+* PR #61. Improving support for polymorphic data types

10+

11+0.7.0

12+-----

13+

14+* PR #59. Using the appropriate toString functions for different types

15+

16+0.6.1

17+-----

18+

19+* PR #57. mkUrl: Use urlBase for Dynamic case

20+

10.6.0.2

210.6.0.2

2-------

22-------

3

23

README.md−8

@@ -61,7 +61,6 @@ Let's save this as `example.hs` and run it:

61```

62$ stack runghc example.hs

63Writing: my-elm-dir/Generated/MyApi.elm

64−$

65```

64```

66

65

67Here's what was generated:

66Here's what was generated:

@@ -79,13 +78,6 @@ import Http

79import String

78import String

80import Url.Builder

79import Url.Builder

81

80

82−maybeBoolToIntStr : Maybe Bool -> String

83−maybeBoolToIntStr mx =

84− case mx of

85− Nothing -> ""

86− Just True -> "1"

87− Just False -> "0"

88−

89type alias Book =

81type alias Book =

90 { name: String

82 { name: String

91 }

83 }

examples/books/elm/Generated/BooksApi.elm−7

@@ -10,13 +10,6 @@ import Http

10import String

11import Url.Builder

12

13−maybeBoolToIntStr : Maybe Bool -> String

14−maybeBoolToIntStr mx =

15− case mx of

16− Nothing -> ""

17− Just True -> "1"

18− Just False -> "0"

19−

20type alias Book =

13type alias Book =

21 { name: String

14 { name: String

22 }

15 }

examples/e2e-tests/elm/Generated/Api.elm−7

@@ -10,13 +10,6 @@ import Http

10import String

11import Url.Builder

12

13−maybeBoolToIntStr : Maybe Bool -> String

14−maybeBoolToIntStr mx =

15− case mx of

16− Nothing -> ""

17− Just True -> "1"

18− Just False -> "0"

19−

20type alias MessageBody =

13type alias MessageBody =

21 { message: String

14 { message: String

22 }

15 }

examples/giphy/elm/Generated/GiphyApi.elm−7

@@ -10,13 +10,6 @@ import Http

10import String

11import Url.Builder

12

13−maybeBoolToIntStr : Maybe Bool -> String

14−maybeBoolToIntStr mx =

15− case mx of

16− Nothing -> ""

17− Just True -> "1"

18− Just False -> "0"

19−

20type alias Gif =

13type alias Gif =

21 { data: GifData

14 { data: GifData

22 }

15 }

examples/readme-example/my-elm-dir/Generated/MyApi.elm−7

@@ -10,13 +10,6 @@ import Http

10import String

11import Url.Builder

12

13−maybeBoolToIntStr : Maybe Bool -> String

14−maybeBoolToIntStr mx =

15− case mx of

16− Nothing -> ""

17− Just True -> "1"

18− Just False -> "0"

19−

20type alias Book =

13type alias Book =

21 { name: String

14 { name: String

22 }

15 }

servant-elm.cabal+3−2

@@ -1,5 +1,5 @@

1name: servant-elm

2−version: 0.6.0.2

2+version: 0.7.3

3synopsis: Automatically derive Elm functions to query servant webservices.

4description: Please see README.md

5homepage: http://github.com/mattjbray/servant-elm#readme

@@ -34,7 +34,7 @@ library

34 build-depends: base >= 4.7 && < 5

35 , aeson >= 0.9

36 , directory

37− , elm-bridge >= 0.4

37+ , elm-bridge >= 0.5.2

38 , lens

39 , servant >= 0.8

40 , servant-foreign >= 0.8

@@ -48,6 +48,7 @@ test-suite servant-elm-test

48 hs-source-dirs: test

49 main-is: GenerateSpec.hs

50 other-modules: Common

51+ , PolymorphicData

51 build-depends:

52 build-depends:

52 Diff

53 Diff

53 , HUnit

54 , HUnit

src/Servant/Elm/Internal/Generate.hs+43−18

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE RecordWildCards #-}

2{-# LANGUAGE RecordWildCards #-}

2{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE MultiParamTypeClasses #-}

4{-# LANGUAGE MultiParamTypeClasses #-}

@@ -19,8 +20,11 @@ import Elm.Json (jsonParserForType, jsonSerForType)

19import qualified Elm.Module as Elm

20import qualified Elm.Module as Elm

20import Elm.TyRep (ETCon(..), EType(..), ETypeDef(..), toElmType)

21import Elm.TyRep (ETCon(..), EType(..), ETypeDef(..), toElmType)

21import Elm.TyRender (renderElm)

22import Elm.TyRender (renderElm)

23+#if MIN_VERSION_elm_bridge(0,6,0)

24+import Elm.Versions (ElmVersion(Elm0p19))

25+#else

22import Elm.Versions (ElmVersion(Elm0p18))

26import Elm.Versions (ElmVersion(Elm0p18))

23−

27+#endif

24import Servant.Elm.Internal.Foreign (LangElm, getEndpoints)

28import Servant.Elm.Internal.Foreign (LangElm, getEndpoints)

25import qualified Servant.Foreign as F

29import qualified Servant.Foreign as F

26import System.Directory (createDirectoryIfMissing)

30import System.Directory (createDirectoryIfMissing)

@@ -49,16 +53,22 @@ data ElmOptions = ElmOptions

49 argument.

53 argument.

50 -}

54 -}

51 urlPrefix :: UrlPrefix

55 urlPrefix :: UrlPrefix

52− , elmTypeAlterations :: (EType -> EType)

56+ , elmTypeAlterations :: (EType -> EType)

53 -- ^ Alterations to perform on ETypes before code generation.

57 -- ^ Alterations to perform on ETypes before code generation.

54 , elmAlterations :: (ETypeDef -> ETypeDef)

58 , elmAlterations :: (ETypeDef -> ETypeDef)

55 -- ^ Alterations to perform on ETypeDefs before code generation.

59 -- ^ Alterations to perform on ETypeDefs before code generation.

56− , elmToString :: (EType -> Text)

60+ , elmToString :: (EType -> Text)

57 -- ^ Elm functions creating a string from a given type.

61 -- ^ Elm functions creating a string from a given type.

58 , emptyResponseElmTypes :: [EType]

62 , emptyResponseElmTypes :: [EType]

59 -- ^ Types that represent an empty Http response.

63 -- ^ Types that represent an empty Http response.

60 , stringElmTypes :: [EType]

64 , stringElmTypes :: [EType]

61 -- ^ Types that represent a String.

65 -- ^ 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.

62 }

72 }

63

73

64

74

@@ -82,6 +92,9 @@ The default options are:

82> , stringElmTypes =

92> , stringElmTypes =

83> [ getType (Proxy :: Proxy String)

93> [ getType (Proxy :: Proxy String)

84> , getType (Proxy :: Proxy T.Text) ]

94> , getType (Proxy :: Proxy T.Text) ]

95+> , expectJsonMethod = "Http.expectJson"

96+> , expectStringMethod = "Http.expectString"

97+> , httpErrorType = "Http.Error"

85> }

98> }

86-}

99-}

87defElmOptions :: ElmOptions

100defElmOptions :: ElmOptions

@@ -97,6 +110,9 @@ defElmOptions = ElmOptions

97 [ toElmType (Proxy :: Proxy String)

110 [ toElmType (Proxy :: Proxy String)

98 , toElmType (Proxy :: Proxy T.Text)

111 , toElmType (Proxy :: Proxy T.Text)

99 ]

112 ]

113+ , expectJsonMethod = "Http.expectJson"

114+ , expectStringMethod = "Http.expectString"

115+ , httpErrorType = "Http.Error"

100 }

116 }

101

117

102

118

@@ -115,6 +131,7 @@ The default required imports are:

115> import Set

131> import Set

116> import Http

132> import Http

117> import String

133> import String

134+> import Url

118> import Url.Builder

135> import Url.Builder

119-}

136-}

120defElmImports :: Text

137defElmImports :: Text

@@ -128,6 +145,7 @@ defElmImports =

128 , "import Set"

145 , "import Set"

129 , "import Http"

146 , "import Http"

130 , "import String"

147 , "import String"

148+ , "import Url"

131 , "import Url.Builder"

149 , "import Url.Builder"

132 ]

150 ]

133

151

@@ -149,7 +167,12 @@ generateElmModuleWith ::

149generateElmModuleWith options namespace imports rootDir typeDefs api = do

167generateElmModuleWith options namespace imports rootDir typeDefs api = do

150 let out =

168 let out =

151 T.unlines $

169 T.unlines $

170+ [

171+#if MIN_VERSION_elm_bridge(0,6,0)

172+ T.pack $ Elm.moduleHeader Elm0p19 moduleName

173+#else

152− [ T.pack $ Elm.moduleHeader Elm0p18 moduleName

174+ T.pack $ Elm.moduleHeader Elm0p18 moduleName

175+#endif

153 , ""

176 , ""

154 , imports

177 , imports

155 , T.pack $ Elm.makeModuleContentWithAlterations (elmAlterations options) typeDefs

178 , T.pack $ Elm.makeModuleContentWithAlterations (elmAlterations options) typeDefs

@@ -236,7 +259,7 @@ generateElmForRequest opts request =

236 fnName =

259 fnName =

237 request ^. F.reqFuncName . to (replace . F.camelCase) . to stext

260 request ^. F.reqFuncName . to (replace . F.camelCase) . to stext

238

261

239− replace = T.replace "-" "" . T.replace "." ""

262+ replace = T.replace "-" "" . T.replace "." "" . T.replace " " ""

240

263

241 typeSignature =

264 typeSignature =

242 mkTypeSignature opts request

265 mkTypeSignature opts request

@@ -298,7 +321,7 @@ mkTypeSignature opts request =

298 toMsgType :: Maybe Doc

321 toMsgType :: Maybe Doc

299 toMsgType = do

322 toMsgType = do

300 result <- fmap elmTypeRef $ request ^. F.reqReturnType

323 result <- fmap elmTypeRef $ request ^. F.reqReturnType

301− Just ("(Result Http.Error " <+> parens result <+> " -> msg)")

324+ Just ("(Result" <+> stext (httpErrorType opts) <+> parens result <+> "-> msg)")

302

325

303 returnType :: Maybe Doc

326 returnType :: Maybe Doc

304 returnType = do

327 returnType = do

@@ -316,7 +339,7 @@ elmCaptureArg segment =

316 "capture_" <>

339 "capture_" <>

317 F.captureArg segment ^. F.argName . to (stext . replace . F.unPathSegment)

340 F.captureArg segment ^. F.argName . to (stext . replace . F.unPathSegment)

318 where

341 where

319− replace = T.replace "-" "_"

342+ replace = T.replace "-" "_" . T.replace " " "_"

320

343

321

344

322elmQueryArg :: F.QueryArg EType -> Doc

345elmQueryArg :: F.QueryArg EType -> Doc

@@ -420,7 +443,7 @@ mkLetParams opts request =

420 , "Just"

443 , "Just"

421 ]

444 ]

422 )

445 )

423−

446+

424 where

447 where

425 elmName = elmQueryArg qarg

448 elmName = elmQueryArg qarg

426 name = qarg ^. F.queryArgName . F.argName . to (stext . F.unPathSegment)

449 name = qarg ^. F.queryArgName . F.argName . to (stext . F.unPathSegment)

@@ -487,14 +510,14 @@ mkRequest opts request =

487 expect =

510 expect =

488 case request ^. F.reqReturnType of

511 case request ^. F.reqReturnType of

489 Just elmTypeExpr

512 Just elmTypeExpr

490− | isEmptyType opts elmTypeExpr

513+ | isEmptyType opts $ (elmTypeAlterations opts) elmTypeExpr

491 -- let elmConstructor = T.pack (renderElm elmTypeExpr)

514 -- let elmConstructor = T.pack (renderElm elmTypeExpr)

492 ->

515 ->

493− "Http.expectString " <> line <+> indent i "(\\x -> case x of" <> line <+>

516+ stext (expectStringMethod opts) <> line <+> indent i "(\\x -> case x of" <> line <+>

494 indent i "Err e -> toMsg (Err e)" <> line <+>

517 indent i "Err e -> toMsg (Err e)" <> line <+>

495 indent i "Ok _ -> toMsg (Ok ()))"

518 indent i "Ok _ -> toMsg (Ok ()))"

496 Just elmTypeExpr ->

519 Just elmTypeExpr ->

497− "Http.expectJson toMsg" <+> renderDecoderName elmTypeExpr

520+ stext (expectJsonMethod opts) <+> "toMsg" <+> renderDecoderName ((elmTypeAlterations opts) elmTypeExpr)

498 Nothing -> error "mkHttpRequest: no reqReturnType?"

521 Nothing -> error "mkHttpRequest: no reqReturnType?"

499 -- case request ^. F.reqReturnType of

522 -- case request ^. F.reqReturnType of

500 -- Just elmTypeExpr | isEmptyType opts elmTypeExpr ->

523 -- Just elmTypeExpr | isEmptyType opts elmTypeExpr ->

@@ -522,6 +545,8 @@ renderDecoderName elmTypeExpr =

522 parens ("Json.Decode.list " <> parens (renderDecoderName t))

545 parens ("Json.Decode.list " <> parens (renderDecoderName t))

523 ETyApp (ETyCon (ETCon "Maybe")) t ->

546 ETyApp (ETyCon (ETCon "Maybe")) t ->

524 parens ("Json.Decode.maybe " <> parens (renderDecoderName t))

547 parens ("Json.Decode.maybe " <> parens (renderDecoderName t))

548+ ETyApp x y ->

549+ parens (renderDecoderName x <+> renderDecoderName y)

525 ETyCon (ETCon "Int") -> "Json.Decode.int"

550 ETyCon (ETCon "Int") -> "Json.Decode.int"

526 ETyCon (ETCon "String") -> "Json.Decode.string"

551 ETyCon (ETCon "String") -> "Json.Decode.string"

527 _ -> ("jsonDec" <> stext (T.pack (renderElm elmTypeExpr)))

552 _ -> ("jsonDec" <> stext (T.pack (renderElm elmTypeExpr)))

@@ -539,7 +564,7 @@ mkUrl opts segments =

539 where

564 where

540 urlBuilder :: Doc

565 urlBuilder :: Doc

541 urlBuilder = case urlPrefix opts of

566 urlBuilder = case urlPrefix opts of

542− Dynamic -> "Url.Builder.absolute" :: Doc

567+ Dynamic -> "Url.Builder.crossOrigin urlBase" :: Doc

543 Static url -> "Url.Builder.crossOrigin" <+> dquotes (stext url)

568 Static url -> "Url.Builder.crossOrigin" <+> dquotes (stext url)

544

569

545 segmentToDoc :: F.Segment EType -> Doc

570 segmentToDoc :: F.Segment EType -> Doc

@@ -549,10 +574,10 @@ mkUrl opts segments =

549 dquotes (stext (F.unPathSegment path))

574 dquotes (stext (F.unPathSegment path))

550 F.Cap arg ->

575 F.Cap arg ->

551 let

576 let

552− toStringSrc =

577+ toStringSrc =

553− toString opts (maybeOf (arg ^. F.argType))

578+ toString opts (elmTypeAlterations opts (maybeOf (arg ^. F.argType)))

554 in

579 in

555− pipeRight [elmCaptureArg s, toStringSrc]

580+ "Url.percentEncode " <> pipeRight [elmCaptureArg s, toStringSrc]

556

581

557

582

558mkQueryParams

583mkQueryParams

@@ -570,7 +595,7 @@ response body.

570-}

595-}

571isEmptyType :: ElmOptions -> EType -> Bool

596isEmptyType :: ElmOptions -> EType -> Bool

572isEmptyType opts elmTypeExpr =

597isEmptyType opts elmTypeExpr =

573− elmTypeExpr `elem` emptyResponseElmTypes opts

598+ (elmTypeAlterations opts elmTypeExpr) `elem` emptyResponseElmTypes opts

574

599

575

600

576{- | Determines whether we call `toString` on URL captures and query params of

601{- | Determines whether we call `toString` on URL captures and query params of

@@ -578,7 +603,7 @@ this type in Elm.

578-}

603-}

579isElmStringType :: ElmOptions -> EType -> Bool

604isElmStringType :: ElmOptions -> EType -> Bool

580isElmStringType opts elmTypeExpr =

605isElmStringType opts elmTypeExpr =

581− elmTypeExpr `elem` stringElmTypes opts

606+ (elmTypeAlterations opts elmTypeExpr) `elem` stringElmTypes opts

582

607

583{- | Determines whether a type is 'Maybe a' where 'a' is something akin to a 'String'.

608{- | Determines whether a type is 'Maybe a' where 'a' is something akin to a 'String'.

584-}

609-}

@@ -620,7 +645,7 @@ elmListOfMaybes ds = "List.filterMap identity" <$> indent 4 (elmList ds)

620defaultElmToString :: EType -> Text

645defaultElmToString :: EType -> Text

621defaultElmToString argType =

646defaultElmToString argType =

622 case argType of

647 case argType of

623− ETyCon (ETCon "Bool") -> "(\\value -> if value then \"1\" else \"0\")"

648+ ETyCon (ETCon "Bool") -> "(\\value -> if value then \"true\" else \"false\")"

624 ETyCon (ETCon "Float") -> "String.fromFloat"

649 ETyCon (ETCon "Float") -> "String.fromFloat"

625 ETyCon (ETCon "Char") -> "String.fromChar"

650 ETyCon (ETCon "Char") -> "String.fromChar"

626 ETyApp (ETyCon (ETCon "Maybe")) v -> "(Maybe.map " <> defaultElmToString v <> " >> Maybe.withDefault \"\")"

651 ETyApp (ETyCon (ETCon "Maybe")) v -> "(Maybe.map " <> defaultElmToString v <> " >> Maybe.withDefault \"\")"

stack.yaml+5−29

@@ -1,33 +1,9 @@

1−# For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md

2−

3−# Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)

4−resolver: lts-13.15

1+resolver: lts-20.11

5−

6−# Local packages, usually specified by relative directory name

7packages:

2packages:

8- '.'

3- '.'

9−

10−# Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)

11−extra-deps:

12−- elm-bridge-0.5.1@sha256:e38bfb9dcd1e2cd119a280072f2f99ed718120c21f37f102b8318156645f06da

13−

14−# Override default flag values for local packages and extra-deps

15flags: {}

4flags: {}

16−

17−# Extra package databases containing global packages

18extra-package-dbs: []

5extra-package-dbs: []

19−

6+nix:

20−# Control whether we use the GHC we find on the path

7+ enable: true

21−# system-ghc: true

8+ packages:

22−

9+ - zlib

23−# Require a specific version of stack, using version ranges

24−# require-stack-version: -any # Default

25−# require-stack-version: >= 0.1.4.0

26−

27−# Override the architecture used by stack, especially useful on Windows

28−# arch: i386

29−# arch: x86_64

30−

31−# Extra directories used by stack for building

32−# extra-include-dirs: [/path/to/dir]

33−# extra-lib-dirs: [/path/to/dir]

test/Common.hs+7−5

@@ -5,9 +5,9 @@ module Common where

5

6import Data.Proxy (Proxy (Proxy))

7import Data.Text (Text)

8−import Servant.API ((:<|>), (:>), Capture, Get, GetNoContent, Header,

8+import Servant.API ((:<|>), (:>), Capture, Get, Header,

9 Header', Headers, JSON, Post,

10− PostNoContent, Put, QueryFlag, QueryParam,

10+ Put, QueryFlag, QueryParam,

11 QueryParam', QueryParams, ReqBody, Required)

12import Servant.Elm (deriveBoth, defaultOptions)

13

@@ -27,7 +27,7 @@ type TestApi =

27 :> Capture "id" Int

28 :> Get '[JSON] Book

29 :<|> "books"

30− :> Capture "title" Text

30+ :> Capture "title space" Text

31 :> Get '[JSON] Book

32 :<|> "books"

33 :> QueryFlag "published"

@@ -38,9 +38,11 @@ type TestApi =

38 :> Get '[JSON] [Book]

39 :<|> "books"

40 :> ReqBody '[JSON] Book

41− :> PostNoContent '[JSON] ()

41+ -- :> PostNoContent '[JSON] ()

42+ :> Post '[JSON] ()

42 :<|> "nothing"

43 :<|> "nothing"

44+ :> Get '[JSON] ()

43− :> GetNoContent '[JSON] ()

45+ -- :> GetNoContent '[JSON] ()

44 :<|> "nothing"

46 :<|> "nothing"

45 :> Put '[JSON] () -- old way to specify no content

47 :> Put '[JSON] () -- old way to specify no content

46 :<|> "with-a-header"

48 :<|> "with-a-header"

test/CompileSpec.hs+1−1

@@ -45,7 +45,7 @@ spec = do

45 api = (Proxy :: Proxy TestApi)

46 let out =

47 T.unlines $

48− [ T.pack $ Elm.moduleHeader Elm0p18 moduleName

48+ [ T.pack $ Elm.moduleHeader Elm0p19 moduleName

49 , ""

50 , imports

51 , ""

test/GenerateSpec.hs+27−2

@@ -18,13 +18,14 @@ import Test.Hspec (Spec, describe, hspec, it)

18import Test.HUnit (Assertion, assertEqual)

19

20import Common (testApi)

21+import PolymorphicData (SomeRecord(..), PolymorphicData(..))

21

22

23

23main :: IO ()

24main :: IO ()

24main = hspec spec

25main = hspec spec

25

26

26spec :: Test.Hspec.Spec

27spec :: Test.Hspec.Spec

27−spec = do

28+spec =

28 describe "encoding a simple api" $

29 describe "encoding a simple api" $

29 do it "does it" $

30 do it "does it" $

30 do expected <-

31 do expected <-

@@ -122,6 +123,30 @@ spec = do

122 })

123 })

123 (Proxy :: Proxy ("one" :> Get '[JSON] Int)))

124 (Proxy :: Proxy ("one" :> Get '[JSON] Int)))

124 generated `itemsShouldBe` expected

125 generated `itemsShouldBe` expected

126+ it "works with polymorphic data" $

127+ do expected <-

128+ mapM

129+ (\(fpath, header) -> do

130+ source <- T.readFile fpath

131+ return (fpath, header, source))

132+ [ ( "test/elm-sources/getPolymorphicData.elm"

133+ , "module GetPolymorphicData exposing (..)\n\n" <>

134+ "import Http\n" <>

135+ "import Json.Decode exposing (..)\n" <>

136+ "import Url.Builder\n\n" <>

137+ "type PolymorphicData a b = PolymorphicData a b\n" <>

138+ "type SomeRecord = SomeRecord { recordId : Int, recordname : String }\n\n" <>

139+ "jsonDecPolymorphicData : Json.Decode.Decoder a -> Json.Decode.Decoder b -> Json.Decode.Decoder (PolymorphicData a b)\n"<>

140+ "jsonDecPolymorphicData _ _ = Debug.todo \"finish\"\n\n" <>

141+ "jsonDecSomeRecord : Json.Decode.Decoder SomeRecord\n"<>

142+ "jsonDecSomeRecord = Debug.todo \"finish\"\n\n\n")]

143+ let generated =

144+ map

145+ (<> "\n")

146+ (generateElmForAPIWith

147+ defElmOptions

148+ (Proxy :: Proxy ( "polymorphicData" :> Get '[JSON] (PolymorphicData [String] SomeRecord))))

149+ generated `itemsShouldBe` expected

125

150

126itemsShouldBe :: [Text] -> [(String, Text, Text)] -> IO ()

151itemsShouldBe :: [Text] -> [(String, Text, Text)] -> IO ()

127itemsShouldBe actual expected =

152itemsShouldBe actual expected =

@@ -138,7 +163,7 @@ shouldBeDiff a (fpath,header,b) =

138 (Diff.getGroupedDiff

163 (Diff.getGroupedDiff

139 (lines (T.unpack actual))

164 (lines (T.unpack actual))

140 (lines (T.unpack expected))))

165 (lines (T.unpack expected))))

141− actual expected

166+ expected actual

142 where

167 where

143 actual = T.strip $ header <> a

168 actual = T.strip $ header <> a

144 expected = T.strip b

169 expected = T.strip b

test/PolymorphicData.hsnew file+15

@@ -0,0 +1,15 @@

1+{-# LANGUAGE TemplateHaskell #-}

2+

3+module PolymorphicData where

4+

5+import Servant.Elm

6+

7+

8+data PolymorphicData a b = PolymorphicData a b deriving (Show, Eq)

9+data SomeRecord = SomeRecord

10+ { recordId :: Int

11+ , recordName :: String

12+ } deriving (Show, Eq)

13+

14+deriveBoth defaultOptions ''PolymorphicData

15+deriveBoth defaultOptions ''SomeRecord

test/elm-sources/getBooksByIdSource.elm+3−2

@@ -8,7 +8,7 @@ type Book = Book

8jsonDecBook : Json.Decode.Decoder Book

9jsonDecBook = Debug.todo ""

10

11−getBooksById : Int -> (Result Http.Error (Book) -> msg) -> Cmd msg

11+getBooksById : Int -> (Result Http.Error (Book) -> msg) -> Cmd msg

12getBooksById capture_id toMsg =

13 let

14 params =

@@ -24,7 +24,8 @@ getBooksById capture_id toMsg =

24 , url =

25 Url.Builder.crossOrigin ""

26 [ "books"

27+ , Url.percentEncode (capture_id

27− , (capture_id |> String.fromInt)

28+ |> String.fromInt)

28 ]

29 ]

29 params

30 params

30 , body =

31 , body =

test/elm-sources/getBooksByTitleSource.elm+3−3

@@ -7,8 +7,8 @@ import Json.Decode as J

7type alias Book = {}

8jsonDecBook = J.succeed {}

9

10−getBooksByTitle : String -> (Result Http.Error (Book) -> msg) -> Cmd msg

10+getBooksByTitlespace : String -> (Result Http.Error (Book) -> msg) -> Cmd msg

11−getBooksByTitle capture_title toMsg =

11+getBooksByTitlespace capture_title_space toMsg =

12 let

13 params =

14 List.filterMap identity

@@ -23,7 +23,7 @@ getBooksByTitle capture_title toMsg =

23 , url =

24 Url.Builder.crossOrigin ""

25 [ "books"

26− , (capture_title)

26+ , Url.percentEncode (capture_title_space)

27 ]

28 params

29 , body =

test/elm-sources/getBooksSource.elm+2−2

@@ -9,7 +9,7 @@ type alias Book = {}

9

10jsonDecBook = J.succeed {}

11

12−getBooks : Bool -> (Maybe String) -> (Maybe Int) -> String -> (List (Maybe Bool)) -> (Result Http.Error ((List Book)) -> msg) -> Cmd msg

12+getBooks : Bool -> (Maybe String) -> (Maybe Int) -> String -> (List (Maybe Bool)) -> (Result Http.Error ((List Book)) -> msg) -> Cmd msg

13getBooks query_published query_sort query_year query_category query_filters toMsg =

14 let

15 params =

@@ -27,7 +27,7 @@ getBooks query_published query_sort query_year query_category query_filters toMs

27 , [ Just query_category

28 |> Maybe.map (Url.Builder.string "category") ]

29 , query_filters

30− |> List.map ((Maybe.map (\value -> if value then "1" else "0") >> Maybe.withDefault "")

30+ |> List.map ((Maybe.map (\value -> if value then "true" else "false") >> Maybe.withDefault "")

31 >> Url.Builder.string "filters[]"

32 >> Just)

33 ])

test/elm-sources/getNothingSource.elm+2−2

@@ -4,7 +4,7 @@ import Http

4import Url.Builder

5

6

7−getNothing : (Result Http.Error (()) -> msg) -> Cmd msg

7+getNothing : (Result Http.Error (()) -> msg) -> Cmd msg

8getNothing toMsg =

9 let

10 params =

@@ -25,7 +25,7 @@ getNothing toMsg =

25 , body =

26 Http.emptyBody

27 , expect =

28− Http.expectString

28+ Http.expectString

29 (\x -> case x of

30 Err e -> toMsg (Err e)

31 Ok _ -> toMsg (Ok ()))

test/elm-sources/getOneSource.elm+1−1

@@ -5,7 +5,7 @@ import Json.Decode exposing (..)

5import Url.Builder

6

7

8−getOne : (Result Http.Error (Int) -> msg) -> Cmd msg

8+getOne : (Result Http.Error (Int) -> msg) -> Cmd msg

9getOne toMsg =

10 let

11 params =

test/elm-sources/getOneWithDynamicUrlSource.elm+2−2

@@ -5,7 +5,7 @@ import Url.Builder

5import Json.Decode exposing (..)

6

7

8−getOne : String -> (Result Http.Error (Int) -> msg) -> Cmd msg

8+getOne : String -> (Result Http.Error (Int) -> msg) -> Cmd msg

9getOne urlBase toMsg =

10 let

11 params =

@@ -19,7 +19,7 @@ getOne urlBase toMsg =

19 , headers =

20 []

21 , url =

22− Url.Builder.absolute

22+ Url.Builder.crossOrigin urlBase

23 [ "one"

24 ]

25 params

test/elm-sources/getPolymorphicData.elmnew file+43

@@ -0,0 +1,43 @@

1+module GetPolymorphicData exposing (..)

2+

3+import Http

4+import Json.Decode exposing (..)

5+import Url.Builder

6+

7+type PolymorphicData a b = PolymorphicData a b

8+type SomeRecord = SomeRecord { recordId : Int, recordname : String }

9+

10+jsonDecPolymorphicData : Json.Decode.Decoder a -> Json.Decode.Decoder b -> Json.Decode.Decoder (PolymorphicData a b)

11+jsonDecPolymorphicData _ _ = Debug.todo "finish"

12+

13+jsonDecSomeRecord : Json.Decode.Decoder SomeRecord

14+jsonDecSomeRecord = Debug.todo "finish"

15+

16+

17+getPolymorphicData : (Result Http.Error ((PolymorphicData (List String) SomeRecord)) -> msg) -> Cmd msg

18+getPolymorphicData toMsg =

19+ let

20+ params =

21+ List.filterMap identity

22+ (List.concat

23+ [])

24+ in

25+ Http.request

26+ { method =

27+ "GET"

28+ , headers =

29+ []

30+ , url =

31+ Url.Builder.crossOrigin ""

32+ [ "polymorphicData"

33+ ]

34+ params

35+ , body =

36+ Http.emptyBody

37+ , expect =

38+ Http.expectJson toMsg ((jsonDecPolymorphicData (Json.Decode.list (Json.Decode.string))) jsonDecSomeRecord)

39+ , timeout =

40+ Nothing

41+ , tracker =

42+ Nothing

43+ }

test/elm-sources/getWithaheaderSource.elm+1−1

@@ -5,7 +5,7 @@ import Url.Builder

5import Json.Decode exposing (..)

6

7

8−getWithaheader : (Maybe String) -> (Maybe Int) -> String -> Int -> (Result Http.Error (String) -> msg) -> Cmd msg

8+getWithaheader : (Maybe String) -> (Maybe Int) -> String -> Int -> (Result Http.Error (String) -> msg) -> Cmd msg

9getWithaheader header_myStringHeader header_MyIntHeader header_MyRequiredStringHeader header_MyRequiredIntHeader toMsg =

10 let

11 params =

test/elm-sources/getWitharesponseheaderSource.elm+1−1

@@ -5,7 +5,7 @@ import Url.Builder

5import Json.Decode exposing (..)

6

7

8−getWitharesponseheader : (Result Http.Error (String) -> msg) -> Cmd msg

8+getWitharesponseheader : (Result Http.Error (String) -> msg) -> Cmd msg

9getWitharesponseheader toMsg =

10 let

11 params =

test/elm-sources/postBooksSource.elm+2−2

@@ -7,7 +7,7 @@ import Json.Encode as Enc

7type alias Book = {}

8jsonEncBook = \b -> Enc.object []

9

10−postBooks : Book -> (Result Http.Error (()) -> msg) -> Cmd msg

10+postBooks : Book -> (Result Http.Error (()) -> msg) -> Cmd msg

11postBooks body toMsg =

12 let

13 params =

@@ -28,7 +28,7 @@ postBooks body toMsg =

28 , body =

29 Http.jsonBody (jsonEncBook body)

30 , expect =

31− Http.expectString

31+ Http.expectString

32 (\x -> case x of

33 Err e -> toMsg (Err e)

34 Ok _ -> toMsg (Ok ()))

test/elm-sources/postTwoSource.elm+1−1

@@ -6,7 +6,7 @@ import Json.Encode

6import Url.Builder

7

8

9−postTwo : String -> (Result Http.Error ((Maybe Int)) -> msg) -> Cmd msg

9+postTwo : String -> (Result Http.Error ((Maybe Int)) -> msg) -> Cmd msg

10postTwo body toMsg =

11 let

12 params =

test/elm-sources/putNothingSource.elm+2−2

@@ -4,7 +4,7 @@ import Http

4import Url.Builder

5

6

7−putNothing : (Result Http.Error (()) -> msg) -> Cmd msg

7+putNothing : (Result Http.Error (()) -> msg) -> Cmd msg

8putNothing toMsg =

9 let

10 params =

@@ -25,7 +25,7 @@ putNothing toMsg =

25 , body =

26 Http.emptyBody

27 , expect =

28− Http.expectString

28+ Http.expectString

29 (\x -> case x of

30 Err e -> toMsg (Err e)

31 Ok _ -> toMsg (Ok ()))