3faa94c...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

CHANGELOG.md+10

@@ -1,3 +1,13 @@

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+

10.7.0

110.7.0

2-----

12-----

3

13

servant-elm.cabal+2−2

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

1name: servant-elm

2−version: 0.7.0

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

src/Servant/Elm/Internal/Generate.hs+37−14

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

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

@@ -552,9 +575,9 @@ mkUrl opts segments =

552 F.Cap arg ->

575 F.Cap arg ->

553 let

576 let

554 toStringSrc =

577 toStringSrc =

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

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

556 in

579 in

557− pipeRight [elmCaptureArg s, toStringSrc]

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

558

581

559

582

560mkQueryParams

583mkQueryParams

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

572-}

595-}

573isEmptyType :: ElmOptions -> EType -> Bool

596isEmptyType :: ElmOptions -> EType -> Bool

574isEmptyType opts elmTypeExpr =

597isEmptyType opts elmTypeExpr =

575− elmTypeExpr `elem` emptyResponseElmTypes opts

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

576

599

577

600

578{- | 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

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

580-}

603-}

581isElmStringType :: ElmOptions -> EType -> Bool

604isElmStringType :: ElmOptions -> EType -> Bool

582isElmStringType opts elmTypeExpr =

605isElmStringType opts elmTypeExpr =

583− elmTypeExpr `elem` stringElmTypes opts

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

584

607

585{- | 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'.

586-}

609-}

stack.yaml+5−3

@@ -1,7 +1,9 @@

1−resolver: lts-14.6

1+resolver: lts-20.11

2packages:

3- '.'

4−extra-deps:

5−- elm-bridge-0.5.2

6flags: {}

4flags: {}

7extra-package-dbs: []

5extra-package-dbs: []

6+nix:

7+ enable: true

8+ packages:

9+ - zlib

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/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+1−1

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

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+1−1

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

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

@@ -14,7 +14,7 @@ jsonDecSomeRecord : Json.Decode.Decoder SomeRecord

14jsonDecSomeRecord = Debug.todo "finish"

15

16

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

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

18getPolymorphicData toMsg =

19 let

20 params =

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