30f13f4..master · haskell-servant/servant-elm

.github/workflows/build.yamlnew file+41

@@ -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

33/_test-cache/

44TAGS

55.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+

1210.6.0.2

222-------

323

README.md+1−10

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

6161```

6262$ stack runghc example.hs

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

64−$

6564```

6665

6766Here's what was generated:

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

7978import String

8079import Url.Builder

8180

82−maybeBoolToIntStr : Maybe Bool -> String

83−maybeBoolToIntStr mx =

84− case mx of

85− Nothing -> ""

86− Just True -> "1"

87− Just False -> "0"

88−

8981type alias Book =

9082 { name: String

9183 }

@@ -133,8 +125,7 @@ getBooksByBookId capture_bookId =

133125```

134126

135127See [`examples`](examples) for a complete usage example, or take a look at

136−[mattjbray/servant-elm-example-app](https://github.com/mattjbray/servant-elm-example-app)

137−for an example project using this library.

128+[`mattjbray/servant-elm-example-app`](https://github.com/mattjbray/servant-elm-example-app) (elm 0.18) or [`haskell-servant/example-servant-elm`](https://github.com/haskell-servant/example-servant-elm) (elm 0.19) for an example project using this library.

138129

139130## Development

140131

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

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

1010import String

1111import Url.Builder

1212

13−maybeBoolToIntStr : Maybe Bool -> String

14−maybeBoolToIntStr mx =

15− case mx of

16− Nothing -> ""

17− Just True -> "1"

18− Just False -> "0"

19−

2013type alias Book =

2114 { name: String

2215 }

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

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

1010import String

1111import Url.Builder

1212

13−maybeBoolToIntStr : Maybe Bool -> String

14−maybeBoolToIntStr mx =

15− case mx of

16− Nothing -> ""

17− Just True -> "1"

18− Just False -> "0"

19−

2013type alias MessageBody =

2114 { message: String

2215 }

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

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

1010import String

1111import Url.Builder

1212

13−maybeBoolToIntStr : Maybe Bool -> String

14−maybeBoolToIntStr mx =

15− case mx of

16− Nothing -> ""

17− Just True -> "1"

18− Just False -> "0"

19−

2013type alias Gif =

2114 { data: GifData

2215 }

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

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

1010import String

1111import Url.Builder

1212

13−maybeBoolToIntStr : Maybe Bool -> String

14−maybeBoolToIntStr mx =

15− case mx of

16− Nothing -> ""

17− Just True -> "1"

18− Just False -> "0"

19−

2013type alias Book =

2114 { name: String

2215 }

servant-elm.cabal+3−2

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

11name: servant-elm

2−version: 0.6.0.2

2+version: 0.7.3

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

44description: Please see README.md

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

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

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

3535 , aeson >= 0.9

3636 , directory

37− , elm-bridge >= 0.4

37+ , elm-bridge >= 0.5.2

3838 , lens

3939 , servant >= 0.8

4040 , servant-foreign >= 0.8

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

4848 hs-source-dirs: test

4949 main-is: GenerateSpec.hs

5050 other-modules: Common

51+ , PolymorphicData

5152 build-depends:

5253 Diff

5354 , HUnit

src/Servant/Elm.hs+2

@@ -21,6 +21,7 @@ module Servant.Elm

2121 , defElmOptions

2222 , defElmImports

2323 , defaultOptions

24+ , defaultElmToString

2425 -- * Convenience re-exports from the "Elm" module

2526 , DefineElm (..)

2627 , EType (..)

@@ -34,6 +35,7 @@ module Servant.Elm

3435

3536import Servant.Elm.Internal.Generate (ElmOptions (..), UrlPrefix (..),

3637 defElmImports, defElmOptions,

38+ defaultElmToString,

3739 generateElmForAPI,

3840 generateElmForAPIWith,

3941 generateElmModule,

src/Servant/Elm/Internal/Generate.hs+96−46

@@ -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,14 +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.

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

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

5662 , emptyResponseElmTypes :: [EType]

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

5864 , stringElmTypes :: [EType]

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

6072 }

6173

6274

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

8092> , stringElmTypes =

8193> [ getType (Proxy :: Proxy String)

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

95+> , expectJsonMethod = "Http.expectJson"

96+> , expectStringMethod = "Http.expectString"

97+> , httpErrorType = "Http.Error"

8398> }

8499-}

85100defElmOptions :: ElmOptions

@@ -87,6 +102,7 @@ defElmOptions = ElmOptions

87102 { urlPrefix = Static ""

88103 , elmTypeAlterations = Elm.defaultTypeAlterations

89104 , elmAlterations = Elm.defaultAlterations

105+ , elmToString = defaultElmToString

90106 , emptyResponseElmTypes =

91107 [ toElmType (Proxy :: Proxy ())

92108 ]

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

94110 [ toElmType (Proxy :: Proxy String)

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

96112 ]

113+ , expectJsonMethod = "Http.expectJson"

114+ , expectStringMethod = "Http.expectString"

115+ , httpErrorType = "Http.Error"

97116 }

98117

99118

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

112131> import Set

113132> import Http

114133> import String

134+> import Url

115135> import Url.Builder

116136-}

117137defElmImports :: Text

@@ -125,14 +145,8 @@ defElmImports =

125145 , "import Set"

126146 , "import Http"

127147 , "import String"

148+ , "import Url"

128149 , "import Url.Builder"

129− , ""

130− , "maybeBoolToIntStr : Maybe Bool -> String"

131− , "maybeBoolToIntStr mx ="

132− , " case mx of"

133− , " Nothing -> \"\""

134− , " Just True -> \"1\""

135− , " Just False -> \"0\""

136150 ]

137151

138152{-|

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

153167generateElmModuleWith options namespace imports rootDir typeDefs api = do

154168 let out =

155169 T.unlines $

156− [ 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

157176 , ""

158177 , imports

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

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

240259 fnName =

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

242261

243− replace = T.replace "-" "" . T.replace "." ""

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

244263

245264 typeSignature =

246265 mkTypeSignature opts request

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

302321 toMsgType :: Maybe Doc

303322 toMsgType = do

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

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

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

306325

307326 returnType :: Maybe Doc

308327 returnType = do

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

320339 "capture_" <>

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

322341 where

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

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

324343

325344

326345elmQueryArg :: F.QueryArg EType -> Doc

@@ -392,15 +411,11 @@ mkLetParams opts request =

392411 let

393412 argType = qarg ^. F.queryArgName . F.argType

394413 wrapped = isElmMaybeType argType

395− -- Don't use "toString" on Elm Strings, otherwise we get extraneous quotes.

396414 toStringSrc =

397− if isElmStringType opts argType || isElmMaybeStringType opts argType then

398− ""

399− else

400− "String.fromInt >> "

415+ toString opts (maybeOf argType)

401416 in

402417 "[" <+> (if wrapped then elmName else "Just" <+> elmName) <> line <>

403− (indent 4 ("|> Maybe.map" <+> parens (toStringSrc <> "Url.Builder.string" <+> dquotes name)))

418+ (indent 4 ("|> Maybe.map" <+> composeRight [toStringSrc, "Url.Builder.string" <+> dquotes name]))

404419 <+> "]"

405420 -- (if wrapped then name else "Just" <+> name) <$>

406421 -- indent 4 ("|> Maybe.map" <+> parens (toStringSrc <> "Http.encodeUri >> (++)" <+> dquotes (elmName <> equals)) <$>

@@ -417,18 +432,18 @@ mkLetParams opts request =

417432 F.List ->

418433 let

419434 argType = qarg ^. F.queryArgName . F.argType

420− convertedVal =

421− if isElmListOfMaybeBoolType argType then

422− parens ("maybeBoolToIntStr" <+> "val")

423− else

424− "val"

435+ toStringSrc =

436+ toString opts (listOf (maybeOf argType))

425437 in

426438 elmName <$>

427439 indent 4 ("|> List.map"

428− <+> parens (backslash <> "val ->" <+> "Just"

429− <+> parens ("Url.Builder.string"

430− <+> dquotes (name <> "[]")

431− <+> convertedVal)))

440+ <+> composeRight

441+ [ toStringSrc

442+ , "Url.Builder.string" <+> dquotes (name <> "[]")

443+ , "Just"

444+ ]

445+ )

446+

432447 where

433448 elmName = elmQueryArg qarg

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

@@ -464,13 +479,9 @@ mkRequest opts request =

464479 headerArgName = elmHeaderArg header

465480 argType = header ^. F.headerArg . F.argType

466481 wrapped = isElmMaybeType argType

467− toStringSrc =

468− if isElmMaybeStringType opts argType || isElmStringType opts argType then

469− mempty

470− else

471− " << String.fromInt"

482+ toStringSrc = toString opts (maybeOf argType)

472483 in

473− "Maybe.map" <+> parens (("Http.header" <+> dquotes headerName <> toStringSrc))

484+ "Maybe.map" <+> composeLeft ["Http.header" <+> dquotes headerName, toStringSrc]

474485 <+>

475486 (if wrapped then headerArgName else parens ("Just" <+> headerArgName))

476487

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

499510 expect =

500511 case request ^. F.reqReturnType of

501512 Just elmTypeExpr

502− | isEmptyType opts elmTypeExpr

513+ | isEmptyType opts $ (elmTypeAlterations opts) elmTypeExpr

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

504515 ->

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

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

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

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

508519 Just elmTypeExpr ->

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

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

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

511522 -- case request ^. F.reqReturnType of

512523 -- Just elmTypeExpr | isEmptyType opts elmTypeExpr ->

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

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

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

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

548+ ETyApp x y ->

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

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

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

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

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

551564 where

552565 urlBuilder :: Doc

553566 urlBuilder = case urlPrefix opts of

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

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

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

556569

557570 segmentToDoc :: F.Segment EType -> Doc

@@ -561,14 +574,10 @@ mkUrl opts segments =

561574 dquotes (stext (F.unPathSegment path))

562575 F.Cap arg ->

563576 let

564− -- Don't use "toString" on Elm Strings, otherwise we get extraneous quotes.

565577 toStringSrc =

566− if isElmStringType opts (arg ^. F.argType) then

567− empty

568− else

569− " |> String.fromInt"

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

570579 in

571− (elmCaptureArg s) <> toStringSrc

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

572581

573582

574583mkQueryParams

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

586595-}

587596isEmptyType :: ElmOptions -> EType -> Bool

588597isEmptyType opts elmTypeExpr =

589− elmTypeExpr `elem` emptyResponseElmTypes opts

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

590599

591600

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

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

594603-}

595604isElmStringType :: ElmOptions -> EType -> Bool

596605isElmStringType opts elmTypeExpr =

597− elmTypeExpr `elem` stringElmTypes opts

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

598607

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

600609-}

@@ -632,3 +641,44 @@ elmList ds = lbracket <+> hsep (punctuate (line <> comma) ds) <$> rbracket

632641elmListOfMaybes :: [Doc] -> Doc

633642elmListOfMaybes [] = lbracket <> rbracket

634643elmListOfMaybes ds = "List.filterMap identity" <$> indent 4 (elmList ds)

644+

645+defaultElmToString :: EType -> Text

646+defaultElmToString argType =

647+ case argType of

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 \"\")"

652+ _ -> "String.fromInt"

653+

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+

663+toString :: ElmOptions -> EType -> Doc

664+toString opts argType =

665+ if isElmStringType opts argType then

666+ mempty

667+ else

668+ stext $ elmToString opts argType

669+

670+pipeLeft :: [Doc] -> Doc

671+pipeLeft =

672+ encloseSep lparen rparen " <| " . filter (not . isEmpty)

673+

674+pipeRight :: [Doc] -> Doc

675+pipeRight =

676+ encloseSep lparen rparen " |> " . filter (not . isEmpty)

677+

678+composeLeft :: [Doc] -> Doc

679+composeLeft =

680+ encloseSep lparen rparen " << " . filter (not . isEmpty)

681+

682+composeRight :: [Doc] -> Doc

683+composeRight =

684+ encloseSep lparen rparen " >> " . filter (not . isEmpty)

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

5−

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

1+resolver: lts-20.11

72packages:

83- '.'

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

154flags: {}

16−

17−# Extra package databases containing global packages

185extra-package-dbs: []

19−

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

21−# system-ghc: true

22−

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]

6+nix:

7+ enable: true

8+ packages:

9+ - zlib

test/Common.hs+7−5

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

55

66import Data.Proxy (Proxy (Proxy))

77import Data.Text (Text)

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

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

99 Header', Headers, JSON, Post,

10− PostNoContent, Put, QueryFlag, QueryParam,

10+ Put, QueryFlag, QueryParam,

1111 QueryParam', QueryParams, ReqBody, Required)

1212import Servant.Elm (deriveBoth, defaultOptions)

1313

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

2727 :> Capture "id" Int

2828 :> Get '[JSON] Book

2929 :<|> "books"

30− :> Capture "title" Text

30+ :> Capture "title space" Text

3131 :> Get '[JSON] Book

3232 :<|> "books"

3333 :> QueryFlag "published"

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

3838 :> Get '[JSON] [Book]

3939 :<|> "books"

4040 :> ReqBody '[JSON] Book

41− :> PostNoContent '[JSON] ()

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

42+ :> Post '[JSON] ()

4243 :<|> "nothing"

43− :> GetNoContent '[JSON] ()

44+ :> Get '[JSON] ()

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

4446 :<|> "nothing"

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

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

test/CompileSpec.hs+1−1

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

4545 api = (Proxy :: Proxy TestApi)

4646 let out =

4747 T.unlines $

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

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

4949 , ""

5050 , imports

5151 , ""

test/GenerateSpec.hs+27−8

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

1818import Test.HUnit (Assertion, assertEqual)

1919

2020import Common (testApi)

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

2122

2223

2324main :: IO ()

2425main = hspec spec

2526

2627spec :: Test.Hspec.Spec

27−spec = do

28+spec =

2829 describe "encoding a simple api" $

2930 do it "does it" $

3031 do expected <-

@@ -70,12 +71,6 @@ spec = do

7071 "import Url.Builder\n" <>

7172 "import Json.Decode as J\n\n" <>

7273 "type alias Book = {}\n\n" <>

73− "maybeBoolToIntStr : Maybe Bool -> String\n" <>

74− "maybeBoolToIntStr mx =\n" <>

75− " case mx of\n" <>

76− " Nothing -> \"\"\n" <>

77− " Just True -> \"1\"\n" <>

78− " Just False -> \"0\"\n\n" <>

7974 "jsonDecBook = J.succeed {}\n\n"

8075 )

8176 , ( "test/elm-sources/postBooksSource.elm"

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

128123 })

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

130125 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

131150

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

133152itemsShouldBe actual expected =

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

144163 (Diff.getGroupedDiff

145164 (lines (T.unpack actual))

146165 (lines (T.unpack expected))))

147− actual expected

166+ expected actual

148167 where

149168 actual = T.strip $ header <> a

150169 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

88jsonDecBook : Json.Decode.Decoder Book

99jsonDecBook = Debug.todo ""

1010

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

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

1212getBooksById capture_id toMsg =

1313 let

1414 params =

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

2424 , url =

2525 Url.Builder.crossOrigin ""

2626 [ "books"

27− , capture_id |> String.fromInt

27+ , Url.percentEncode (capture_id

28+ |> String.fromInt)

2829 ]

2930 params

3031 , body =

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

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

77type alias Book = {}

88jsonDecBook = J.succeed {}

99

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

11−getBooksByTitle capture_title toMsg =

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

11+getBooksByTitlespace capture_title_space toMsg =

1212 let

1313 params =

1414 List.filterMap identity

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

2323 , url =

2424 Url.Builder.crossOrigin ""

2525 [ "books"

26− , capture_title

26+ , Url.percentEncode (capture_title_space)

2727 ]

2828 params

2929 , body =

test/elm-sources/getBooksSource.elm+6−10

@@ -7,16 +7,9 @@ import Json.Decode as J

77

88type alias Book = {}

99

10−maybeBoolToIntStr : Maybe Bool -> String

11−maybeBoolToIntStr mx =

12− case mx of

13− Nothing -> ""

14− Just True -> "1"

15− Just False -> "0"

16−

1710jsonDecBook = J.succeed {}

1811

19−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

2013getBooks query_published query_sort query_year query_category query_filters toMsg =

2114 let

2215 params =

@@ -29,11 +22,14 @@ getBooks query_published query_sort query_year query_category query_filters toMs

2922 , [ query_sort

3023 |> Maybe.map (Url.Builder.string "sort") ]

3124 , [ query_year

32− |> Maybe.map (String.fromInt >> Url.Builder.string "year") ]

25+ |> Maybe.map (String.fromInt

26+ >> Url.Builder.string "year") ]

3327 , [ Just query_category

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

3529 , query_filters

36− |> List.map (\val -> Just (Url.Builder.string "filters[]" (maybeBoolToIntStr val)))

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

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

32+ >> Just)

3733 ])

3834 in

3935 Http.request

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

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

44import Url.Builder

55

66

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

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

88getNothing toMsg =

99 let

1010 params =

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

2525 , body =

2626 Http.emptyBody

2727 , expect =

28− Http.expectString

28+ Http.expectString

2929 (\x -> case x of

3030 Err e -> toMsg (Err e)

3131 Ok _ -> toMsg (Ok ()))

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

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

55import Url.Builder

66

77

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

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

99getOne toMsg =

1010 let

1111 params =

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

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

55import Json.Decode exposing (..)

66

77

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

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

99getOne urlBase toMsg =

1010 let

1111 params =

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

1919 , headers =

2020 []

2121 , url =

22− Url.Builder.absolute

22+ Url.Builder.crossOrigin urlBase

2323 [ "one"

2424 ]

2525 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+5−3

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

55import Json.Decode exposing (..)

66

77

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

99getWithaheader header_myStringHeader header_MyIntHeader header_MyRequiredStringHeader header_MyRequiredIntHeader toMsg =

1010 let

1111 params =

@@ -19,9 +19,11 @@ getWithaheader header_myStringHeader header_MyIntHeader header_MyRequiredStringH

1919 , headers =

2020 List.filterMap identity

2121 [ Maybe.map (Http.header "myStringHeader") header_myStringHeader

22− , Maybe.map (Http.header "MyIntHeader" << String.fromInt) header_MyIntHeader

22+ , Maybe.map (Http.header "MyIntHeader"

23+ << String.fromInt) header_MyIntHeader

2324 , Maybe.map (Http.header "MyRequiredStringHeader") (Just header_MyRequiredStringHeader)

24− , Maybe.map (Http.header "MyRequiredIntHeader" << String.fromInt) (Just header_MyRequiredIntHeader)

25+ , Maybe.map (Http.header "MyRequiredIntHeader"

26+ << String.fromInt) (Just header_MyRequiredIntHeader)

2527 ]

2628 , url =

2729 Url.Builder.crossOrigin ""

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

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

55import Json.Decode exposing (..)

66

77

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

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

99getWitharesponseheader toMsg =

1010 let

1111 params =

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

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

77type alias Book = {}

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

99

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

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

1111postBooks body toMsg =

1212 let

1313 params =

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

2828 , body =

2929 Http.jsonBody (jsonEncBook body)

3030 , expect =

31− Http.expectString

31+ Http.expectString

3232 (\x -> case x of

3333 Err e -> toMsg (Err e)

3434 Ok _ -> toMsg (Ok ()))

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

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

66import Url.Builder

77

88

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

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

1010postTwo body toMsg =

1111 let

1212 params =

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

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

44import Url.Builder

55

66

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

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

88putNothing toMsg =

99 let

1010 params =

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

2525 , body =

2626 Http.emptyBody

2727 , expect =

28− Http.expectString

28+ Http.expectString

2929 (\x -> case x of

3030 Err e -> toMsg (Err e)

3131 Ok _ -> toMsg (Ok ()))