a98cff5..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

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+

1110.7.0

212-----

313

servant-elm.cabal+3−2

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

11name: servant-elm

2−version: 0.7.0

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/Internal/Generate.hs+37−14

@@ -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,6 +145,7 @@ defElmImports =

128145 , "import Set"

129146 , "import Http"

130147 , "import String"

148+ , "import Url"

131149 , "import Url.Builder"

132150 ]

133151

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

149167generateElmModuleWith options namespace imports rootDir typeDefs api = do

150168 let out =

151169 T.unlines $

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

153176 , ""

154177 , imports

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

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

236259 fnName =

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

238261

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

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

240263

241264 typeSignature =

242265 mkTypeSignature opts request

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

298321 toMsgType :: Maybe Doc

299322 toMsgType = do

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

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

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

302325

303326 returnType :: Maybe Doc

304327 returnType = do

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

316339 "capture_" <>

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

318341 where

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

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

320343

321344

322345elmQueryArg :: F.QueryArg EType -> Doc

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

487510 expect =

488511 case request ^. F.reqReturnType of

489512 Just elmTypeExpr

490− | isEmptyType opts elmTypeExpr

513+ | isEmptyType opts $ (elmTypeAlterations opts) elmTypeExpr

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

492515 ->

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

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

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

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

496519 Just elmTypeExpr ->

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

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

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

499522 -- case request ^. F.reqReturnType of

500523 -- Just elmTypeExpr | isEmptyType opts elmTypeExpr ->

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

552575 F.Cap arg ->

553576 let

554577 toStringSrc =

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

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

556579 in

557− pipeRight [elmCaptureArg s, toStringSrc]

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

558581

559582

560583mkQueryParams

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

572595-}

573596isEmptyType :: ElmOptions -> EType -> Bool

574597isEmptyType opts elmTypeExpr =

575− elmTypeExpr `elem` emptyResponseElmTypes opts

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

576599

577600

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

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

580603-}

581604isElmStringType :: ElmOptions -> EType -> Bool

582605isElmStringType opts elmTypeExpr =

583− elmTypeExpr `elem` stringElmTypes opts

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

584607

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

586609-}

stack.yaml+5−3

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

1−resolver: lts-14.6

1+resolver: lts-20.11

22packages:

33- '.'

4−extra-deps:

5−- elm-bridge-0.5.2

64flags: {}

75extra-package-dbs: []

6+nix:

7+ enable: true

8+ packages:

9+ - zlib

test/Common.hs+7−13

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

@@ -15,15 +15,7 @@ data Book = Book

1515 { title :: String

1616 }

1717

18−data PolymorphicData a b = PolymorphicData a b deriving (Show, Eq)

19−data SomeRecord = SomeRecord

20− { recordId :: Int

21− , recordName :: String

22− } deriving (Show, Eq)

23−

2418deriveBoth defaultOptions ''Book

25−deriveBoth defaultOptions ''PolymorphicData

26−deriveBoth defaultOptions ''SomeRecord

2719

2820type TestApi =

2921 "one"

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

3527 :> Capture "id" Int

3628 :> Get '[JSON] Book

3729 :<|> "books"

38− :> Capture "title" Text

30+ :> Capture "title space" Text

3931 :> Get '[JSON] Book

4032 :<|> "books"

4133 :> QueryFlag "published"

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

4638 :> Get '[JSON] [Book]

4739 :<|> "books"

4840 :> ReqBody '[JSON] Book

49− :> PostNoContent '[JSON] ()

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

42+ :> Post '[JSON] ()

5043 :<|> "nothing"

51− :> GetNoContent '[JSON] ()

44+ :> Get '[JSON] ()

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

5246 :<|> "nothing"

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

5448 :<|> "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+2−1

@@ -17,7 +17,8 @@ import Servant.Elm

1717import Test.Hspec (Spec, describe, hspec, it)

1818import Test.HUnit (Assertion, assertEqual)

1919

20−import Common (testApi, SomeRecord(..), PolymorphicData(..))

20+import Common (testApi)

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

2122

2223

2324main :: IO ()

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

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

99

1010jsonDecBook = J.succeed {}

1111

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

1313getBooks query_published query_sort query_year query_category query_filters toMsg =

1414 let

1515 params =

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

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

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

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

1414jsonDecSomeRecord = Debug.todo "finish"

1515

1616

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

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

1818getPolymorphicData toMsg =

1919 let

2020 params =

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

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

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