├── .github └── workflows │ └── build.yaml ├── .gitignore ├── .travis.yml ├── CHANGELOG.md ├── LICENSE ├── Makefile ├── README.md ├── Setup.hs ├── examples ├── books │ ├── README.md │ ├── elm.json │ ├── elm │ │ └── Generated │ │ │ └── BooksApi.elm │ └── generate.hs ├── e2e-tests │ ├── README.md │ ├── elm.json │ ├── elm │ │ ├── Generated │ │ │ └── Api.elm │ │ └── Main.elm │ └── generate.hs ├── giphy │ ├── README.md │ ├── elm.json │ ├── elm │ │ ├── Generated │ │ │ └── GiphyApi.elm │ │ └── Main.elm │ └── generate.hs └── readme-example │ ├── elm.json │ ├── generate.hs │ └── my-elm-dir │ └── Generated │ └── MyApi.elm ├── servant-elm.cabal ├── src └── Servant │ ├── Elm.hs │ └── Elm │ └── Internal │ ├── Foreign.hs │ ├── Generate.hs │ └── Options.hs ├── stack.yaml └── test ├── Common.hs ├── CompileSpec.hs ├── GenerateSpec.hs ├── PolymorphicData.hs └── elm-sources ├── elm.json ├── getBooksByIdSource.elm ├── getBooksByTitleSource.elm ├── getBooksSource.elm ├── getNothingSource.elm ├── getOneSource.elm ├── getOneWithDynamicUrlSource.elm ├── getPolymorphicData.elm ├── getWithaheaderSource.elm ├── getWitharesponseheaderSource.elm ├── postBooksSource.elm ├── postTwoSource.elm └── putNothingSource.elm /.github/workflows/build.yaml: -------------------------------------------------------------------------------- 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 42 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work 2 | elm-stuff 3 | /_test-cache/ 4 | TAGS 5 | .dir-locals.el 6 | stack.yaml.lock 7 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # Use new container infrastructure to enable caching 2 | sudo: false 3 | 4 | # Choose a lightweight base image; we provide our own build tools. 5 | language: c 6 | 7 | # GHC depends on GMP. You can add other dependencies here as well. 8 | addons: 9 | apt: 10 | packages: 11 | - libgmp-dev 12 | 13 | # The different configurations we want to test. You could also do things like 14 | # change flags or use --stack-yaml to point to a different file. 15 | env: 16 | - ARGS="--resolver lts" 17 | 18 | before_install: 19 | # Download and unpack the stack executable 20 | - mkdir -p ~/.local/bin 21 | - export PATH=$HOME/.local/bin:$PATH 22 | - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 23 | # install elm 24 | - npm install -g elm@0.19.0 25 | 26 | # This line does all of the work: installs GHC if necessary, build the library, 27 | # executables, and test suites, and runs the test suites. --no-terminal works 28 | # around some quirks in Travis's terminal implementation. 29 | script: stack $ARGS --no-terminal --install-ghc test --haddock --no-haddock-deps --flag servant-elm:integration 30 | 31 | # Caching so the next build will be fast too. 32 | cache: 33 | directories: 34 | - $HOME/.stack 35 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 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 | 21 | 0.6.0.2 22 | ------- 23 | 24 | * Ticket #53. Don't add a "query_" prefix to query params 25 | 26 | 0.6.0.1 27 | ------- 28 | 29 | * Bug: Replace special symbols in query string param name 30 | 31 | 0.6.0.0 32 | ------- 33 | 34 | * PR #49. Support Elm 0.19, migrate to elm-bridge, support http 2.0.0 35 | 36 | 0.5.0.0 37 | ------- 38 | * Fix generation for APIs with response headers. 39 | * Support Servant's `Optional` and `Required` modifiers for 40 | `Header`s and `QueryParam`s (`Header` arguments are now `Maybe`s 41 | by default). (phaazon) (#31) 42 | * Filter out forbidden Cookie header. (xilnocas) (#37) 43 | 44 | 0.4.0.1 45 | ------- 46 | * Remove hyphens from generated function names. (servant-foreign-0.10 no longer 47 | does this for us.) 48 | 49 | 0.4.0.0 50 | ------- 51 | * Allow passing the base URL dynamically in Elm. (#20) 52 | * Don't use `toString` on `Text` parameters. (domenkozar) (#23, #24) 53 | * Fix query parameter generation. (domenkozar) (#25) 54 | 55 | 0.3.0.1 56 | ------- 57 | * Prefix generated function arguments to ensure valid Elm identifiers (#21) 58 | * Put integration tests behind a Cabal flag. (#22) 59 | 60 | 0.3.0.0 61 | ------- 62 | * Update for Elm 0.18 and the new elm-lang/http library. 63 | * Generated Elm functions now return an `Http.Request` value. 64 | 65 | 0.2.0.0 66 | ------- 67 | * Use Text throughout the API. 68 | * We no longer auto-generate Elm sources for the types, encoders and decoders 69 | used in your API - you must now use `elm-export`'s `toElmTypeSource` functions 70 | explicitly. See the tests and examples for usage. 71 | * Allow setting options to pass to `elm-export`. 72 | * Update to `servant-0.8` (purcell). 73 | * Basic support for custom headers. 74 | * Fix: `String` query params were being wrapped in double-quotes. 75 | * Test: verify that the generated code can be compiled by Elm (soenkehahn) 76 | 77 | 0.1.0.2 78 | ------- 79 | * Fix for API endpoints that return Unit (kantp) 80 | 81 | 0.1.0.1 82 | ------- 83 | * Convenience re-exports from Elm and Data.Proxy. 84 | * Add Haddoc documentation. 85 | 86 | 0.1 87 | --- 88 | * Initial release. 89 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Matt Bray (c) 2015-2016 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Matt Bray nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all 2 | all: test examples 3 | 4 | .PHONY: test 5 | test: 6 | stack test --flag servant-elm:integration 7 | 8 | .PHONY: examples 9 | examples: build-with-examples-flag books-example e2e-tests-example giphy-example readme-example 10 | 11 | .PHONY: build-with-examples-flag 12 | build-with-examples-flag: 13 | stack build --flag servant-elm:examples 14 | 15 | 16 | .PHONY: books-example 17 | books-example: examples/books/elm/Generated/BooksApi.elm 18 | 19 | examples/books/elm/Generated/BooksApi.elm: examples/books/generate.hs 20 | cd examples/books && stack runghc generate.hs 21 | 22 | 23 | .PHONY: e2e-tests-example 24 | e2e-tests-example: examples/e2e-tests/elm/Generated/Api.elm 25 | 26 | examples/e2e-tests/elm/Generated/Api.elm: examples/e2e-tests/generate.hs 27 | cd examples/e2e-tests && stack runghc generate.hs 28 | 29 | 30 | .PHONY: giphy-example 31 | giphy-example: examples/giphy/elm/Generated/GiphyApi.elm 32 | 33 | examples/giphy/elm/Generated/GiphyApi.elm: examples/giphy/generate.hs 34 | cd examples/giphy && stack runghc generate.hs 35 | 36 | 37 | .PHONY: readme-example 38 | readme-example: examples/readme-example/my-elm-dir/Generated/MyApi.elm 39 | 40 | examples/readme-example/my-elm-dir/Generated/MyApi.elm: examples/readme-example/generate.hs 41 | cd examples/readme-example && stack runghc generate.hs 42 | 43 | 44 | .PHONY: clean 45 | clean: 46 | rm -f examples/books/elm/Generated/BooksApi.elm \ 47 | examples/e2e-tests/elm/Generated/Api.elm \ 48 | examples/giphy/elm/Generated/GiphyApi.elm \ 49 | examples/readme-example/my-elm-dir/Generated/MyApi.elm 50 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Servant Elm 2 | 3 | [![Build Status](https://travis-ci.org/haskell-servant/servant-elm.svg?branch=master)](https://travis-ci.org/haskell-servant/servant-elm) 4 | 5 | Generate Elm functions to query your Servant API! 6 | 7 | Elm type generation coutesy of [elm-bridge](http://hackage.haskell.org/package/elm-bridge). 8 | 9 | ## Installation 10 | 11 | Servant Elm is [available on Hackage](http://hackage.haskell.org/package/servant-elm). 12 | 13 | ## Example 14 | 15 | First, some language pragmas and imports. 16 | 17 | ```haskell 18 | {-# LANGUAGE DataKinds #-} 19 | {-# LANGUAGE OverloadedStrings #-} 20 | {-# LANGUAGE TemplateHaskell #-} 21 | {-# LANGUAGE TypeOperators #-} 22 | 23 | import Elm.Derive (defaultOptions, deriveBoth) 24 | 25 | import Servant.API ((:>), Capture, Get, JSON) 26 | import Servant.Elm (DefineElm (DefineElm), Proxy (Proxy), defElmImports, defElmOptions, 27 | generateElmModuleWith) 28 | ``` 29 | 30 | We have some Haskell-defined types and our Servant API. 31 | 32 | ```haskell 33 | data Book = Book 34 | { name :: String 35 | } 36 | 37 | deriveBoth defaultOptions ''Book 38 | 39 | type BooksApi = "books" :> Capture "bookId" Int :> Get '[JSON] Book 40 | ``` 41 | 42 | Now we can generate Elm functions to query the API: 43 | 44 | ```haskell 45 | main :: IO () 46 | main = 47 | generateElmModuleWith 48 | defElmOptions 49 | [ "Generated" 50 | , "MyApi" 51 | ] 52 | defElmImports 53 | "my-elm-dir" 54 | [ DefineElm (Proxy :: Proxy Book) 55 | ] 56 | (Proxy :: Proxy BooksApi) 57 | ``` 58 | 59 | Let's save this as `example.hs` and run it: 60 | 61 | ``` 62 | $ stack runghc example.hs 63 | Writing: my-elm-dir/Generated/MyApi.elm 64 | ``` 65 | 66 | Here's what was generated: 67 | 68 | ```elm 69 | module Generated.MyApi exposing(..) 70 | 71 | import Json.Decode 72 | import Json.Encode exposing (Value) 73 | -- The following module comes from bartavelle/json-helpers 74 | import Json.Helpers exposing (..) 75 | import Dict exposing (Dict) 76 | import Set 77 | import Http 78 | import String 79 | import Url.Builder 80 | 81 | type alias Book = 82 | { name: String 83 | } 84 | 85 | jsonDecBook : Json.Decode.Decoder ( Book ) 86 | jsonDecBook = 87 | Json.Decode.succeed (\pname -> {name = pname}) 88 | |> required "name" (Json.Decode.string) 89 | 90 | jsonEncBook : Book -> Value 91 | jsonEncBook val = 92 | Json.Encode.object 93 | [ ("name", Json.Encode.string val.name) 94 | ] 95 | 96 | 97 | getBooksByBookId : Int -> Http.Request Book 98 | getBooksByBookId capture_bookId = 99 | let 100 | params = 101 | List.filterMap identity 102 | (List.concat 103 | []) 104 | in 105 | Http.request 106 | { method = 107 | "GET" 108 | , headers = 109 | [] 110 | , url = 111 | Url.Builder.absolute 112 | [ "books" 113 | , capture_bookId |> String.fromInt 114 | ] 115 | params 116 | , body = 117 | Http.emptyBody 118 | , expect = 119 | Http.expectJson <| jsonDecBook 120 | , timeout = 121 | Nothing 122 | , withCredentials = 123 | False 124 | } 125 | ``` 126 | 127 | See [`examples`](examples) for a complete usage example, or take a look at 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. 129 | 130 | ## Development 131 | 132 | ``` 133 | $ git clone https://github.com/mattjbray/servant-elm.git 134 | $ cd servant-elm 135 | $ stack test 136 | $ stack test --flag servant-elm:integration 137 | ``` 138 | 139 | To build all examples: 140 | 141 | ``` 142 | $ make examples 143 | ``` 144 | 145 | To run an example: 146 | 147 | ``` 148 | $ cd examples/e2e-tests 149 | $ elm-reactor 150 | # Open http://localhost:8000/elm/Main.elm 151 | ``` 152 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /examples/books/README.md: -------------------------------------------------------------------------------- 1 | ## Books Example 2 | 3 | [`generate.hs`](generate.hs): Defines a very simple Servant API type, and generates Elm code to call the API. 4 | 5 | [`elm/Generated/BooksApi.elm`](elm/Generated/BooksApi.elm): This is the Elm code generated by running `generate.hs`. 6 | 7 | ### Usage 8 | 9 | ``` 10 | cd examples/books 11 | stack build 12 | stack runghc generate.hs 13 | ``` 14 | -------------------------------------------------------------------------------- /examples/books/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "." 5 | ], 6 | "elm-version": "0.19.0", 7 | "dependencies": { 8 | "direct": { 9 | "NoRedInk/elm-json-decode-pipeline": "1.0.0", 10 | "bartavelle/json-helpers": "2.0.2", 11 | "elm/core": "1.0.2", 12 | "elm/http": "1.0.0", 13 | "elm/json": "1.1.3", 14 | "elm/url": "1.0.0" 15 | }, 16 | "indirect": {} 17 | }, 18 | "test-dependencies": { 19 | "direct": {}, 20 | "indirect": { 21 | "elm/bytes": "1.0.8", 22 | "elm/file": "1.0.5", 23 | "elm/time": "1.0.0" 24 | } 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /examples/books/elm/Generated/BooksApi.elm: -------------------------------------------------------------------------------- 1 | module Generated.BooksApi exposing(..) 2 | 3 | import Json.Decode 4 | import Json.Encode exposing (Value) 5 | -- The following module comes from bartavelle/json-helpers 6 | import Json.Helpers exposing (..) 7 | import Dict exposing (Dict) 8 | import Set 9 | import Http 10 | import String 11 | import Url.Builder 12 | 13 | type alias Book = 14 | { name: String 15 | } 16 | 17 | jsonDecBook : Json.Decode.Decoder ( Book ) 18 | jsonDecBook = 19 | Json.Decode.succeed (\pname -> {name = pname}) 20 | |> required "name" (Json.Decode.string) 21 | 22 | jsonEncBook : Book -> Value 23 | jsonEncBook val = 24 | Json.Encode.object 25 | [ ("name", Json.Encode.string val.name) 26 | ] 27 | 28 | 29 | postBooks : Book -> Http.Request Book 30 | postBooks body = 31 | let 32 | params = 33 | List.filterMap identity 34 | (List.concat 35 | []) 36 | in 37 | Http.request 38 | { method = 39 | "POST" 40 | , headers = 41 | [] 42 | , url = 43 | Url.Builder.absolute 44 | [ "books" 45 | ] 46 | params 47 | , body = 48 | Http.jsonBody (jsonEncBook body) 49 | , expect = 50 | Http.expectJson <| jsonDecBook 51 | , timeout = 52 | Nothing 53 | , withCredentials = 54 | False 55 | } 56 | 57 | getBooks : Http.Request (List Book) 58 | getBooks = 59 | let 60 | params = 61 | List.filterMap identity 62 | (List.concat 63 | []) 64 | in 65 | Http.request 66 | { method = 67 | "GET" 68 | , headers = 69 | [] 70 | , url = 71 | Url.Builder.absolute 72 | [ "books" 73 | ] 74 | params 75 | , body = 76 | Http.emptyBody 77 | , expect = 78 | Http.expectJson <| Json.Decode.list (jsonDecBook) 79 | , timeout = 80 | Nothing 81 | , withCredentials = 82 | False 83 | } 84 | 85 | getBooksByBookId : Int -> Http.Request Book 86 | getBooksByBookId capture_bookId = 87 | let 88 | params = 89 | List.filterMap identity 90 | (List.concat 91 | []) 92 | in 93 | Http.request 94 | { method = 95 | "GET" 96 | , headers = 97 | [] 98 | , url = 99 | Url.Builder.absolute 100 | [ "books" 101 | , capture_bookId |> String.fromInt 102 | ] 103 | params 104 | , body = 105 | Http.emptyBody 106 | , expect = 107 | Http.expectJson <| jsonDecBook 108 | , timeout = 109 | Nothing 110 | , withCredentials = 111 | False 112 | } 113 | -------------------------------------------------------------------------------- /examples/books/generate.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | {-# LANGUAGE TypeOperators #-} 5 | 6 | import Servant.API ((:<|>), (:>), Capture, Get, JSON, Post, ReqBody) 7 | import Servant.Elm (DefineElm (DefineElm), ElmOptions(urlPrefix), 8 | Proxy (Proxy), UrlPrefix(Static), defaultOptions, 9 | defElmImports, defElmOptions, deriveBoth, 10 | generateElmModuleWith) 11 | 12 | data Book = Book 13 | { name :: String 14 | } deriving (Show, Eq) 15 | 16 | deriveBoth defaultOptions ''Book 17 | 18 | type BooksApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book 19 | :<|> "books" :> Get '[JSON] [Book] 20 | :<|> "books" :> Capture "bookId" Int :> Get '[JSON] Book 21 | 22 | myElmOpts :: ElmOptions 23 | myElmOpts = defElmOptions { urlPrefix = Static "http://localhost:8000" } 24 | 25 | main :: IO () 26 | main = 27 | generateElmModuleWith 28 | myElmOpts 29 | [ "Generated" 30 | , "BooksApi" 31 | ] 32 | defElmImports 33 | "elm" 34 | [ DefineElm (Proxy :: Proxy Book) 35 | ] 36 | (Proxy :: Proxy BooksApi) 37 | -------------------------------------------------------------------------------- /examples/e2e-tests/README.md: -------------------------------------------------------------------------------- 1 | # End-to-end tests 2 | 3 | Test that Elm can actually compile and run the code we generate. 4 | 5 | Uses https://httpbin.org/ to generate sample responses. 6 | 7 | ### Usage 8 | 9 | ``` 10 | cd examples/e2e-tests 11 | stack build 12 | stack runghc generate.hs 13 | elm install 14 | elm reactor 15 | ``` 16 | 17 | Open http://localhost:8000/elm/Main.elm in your browser to check the results. 18 | -------------------------------------------------------------------------------- /examples/e2e-tests/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "elm" 5 | ], 6 | "elm-version": "0.19.0", 7 | "dependencies": { 8 | "direct": { 9 | "NoRedInk/elm-json-decode-pipeline": "1.0.0", 10 | "bartavelle/json-helpers": "2.0.2", 11 | "elm/browser": "1.0.1", 12 | "elm/core": "1.0.2", 13 | "elm/html": "1.0.0", 14 | "elm/http": "1.0.0", 15 | "elm/json": "1.1.3", 16 | "elm/url": "1.0.0" 17 | }, 18 | "indirect": { 19 | "elm/time": "1.0.0", 20 | "elm/virtual-dom": "1.0.2" 21 | } 22 | }, 23 | "test-dependencies": { 24 | "direct": {}, 25 | "indirect": { 26 | "elm/bytes": "1.0.8", 27 | "elm/file": "1.0.5" 28 | } 29 | } 30 | } 31 | -------------------------------------------------------------------------------- /examples/e2e-tests/elm/Generated/Api.elm: -------------------------------------------------------------------------------- 1 | module Generated.Api exposing(..) 2 | 3 | import Json.Decode 4 | import Json.Encode exposing (Value) 5 | -- The following module comes from bartavelle/json-helpers 6 | import Json.Helpers exposing (..) 7 | import Dict exposing (Dict) 8 | import Set 9 | import Http 10 | import String 11 | import Url.Builder 12 | 13 | type alias MessageBody = 14 | { message: String 15 | } 16 | 17 | jsonDecMessageBody : Json.Decode.Decoder ( MessageBody ) 18 | jsonDecMessageBody = 19 | Json.Decode.succeed (\pmessage -> {message = pmessage}) 20 | |> required "message" (Json.Decode.string) 21 | 22 | jsonEncMessageBody : MessageBody -> Value 23 | jsonEncMessageBody val = 24 | Json.Encode.object 25 | [ ("message", Json.Encode.string val.message) 26 | ] 27 | 28 | 29 | 30 | type alias QueryArgs = 31 | { q: String 32 | } 33 | 34 | jsonDecQueryArgs : Json.Decode.Decoder ( QueryArgs ) 35 | jsonDecQueryArgs = 36 | Json.Decode.succeed (\pq -> {q = pq}) 37 | |> required "q" (Json.Decode.string) 38 | 39 | jsonEncQueryArgs : QueryArgs -> Value 40 | jsonEncQueryArgs val = 41 | Json.Encode.object 42 | [ ("q", Json.Encode.string val.q) 43 | ] 44 | 45 | 46 | 47 | type alias Response = 48 | { origin: String 49 | } 50 | 51 | jsonDecResponse : Json.Decode.Decoder ( Response ) 52 | jsonDecResponse = 53 | Json.Decode.succeed (\porigin -> {origin = porigin}) 54 | |> required "origin" (Json.Decode.string) 55 | 56 | jsonEncResponse : Response -> Value 57 | jsonEncResponse val = 58 | Json.Encode.object 59 | [ ("origin", Json.Encode.string val.origin) 60 | ] 61 | 62 | 63 | 64 | type alias ResponseWithJson = 65 | { json: MessageBody 66 | } 67 | 68 | jsonDecResponseWithJson : Json.Decode.Decoder ( ResponseWithJson ) 69 | jsonDecResponseWithJson = 70 | Json.Decode.succeed (\pjson -> {json = pjson}) 71 | |> required "json" (jsonDecMessageBody) 72 | 73 | jsonEncResponseWithJson : ResponseWithJson -> Value 74 | jsonEncResponseWithJson val = 75 | Json.Encode.object 76 | [ ("json", jsonEncMessageBody val.json) 77 | ] 78 | 79 | 80 | 81 | type alias ResponseWithArgs = 82 | { args: QueryArgs 83 | } 84 | 85 | jsonDecResponseWithArgs : Json.Decode.Decoder ( ResponseWithArgs ) 86 | jsonDecResponseWithArgs = 87 | Json.Decode.succeed (\pargs -> {args = pargs}) 88 | |> required "args" (jsonDecQueryArgs) 89 | 90 | jsonEncResponseWithArgs : ResponseWithArgs -> Value 91 | jsonEncResponseWithArgs val = 92 | Json.Encode.object 93 | [ ("args", jsonEncQueryArgs val.args) 94 | ] 95 | 96 | 97 | getIp : Http.Request Response 98 | getIp = 99 | let 100 | params = 101 | List.filterMap identity 102 | (List.concat 103 | []) 104 | in 105 | Http.request 106 | { method = 107 | "GET" 108 | , headers = 109 | [] 110 | , url = 111 | Url.Builder.absolute 112 | [ "ip" 113 | ] 114 | params 115 | , body = 116 | Http.emptyBody 117 | , expect = 118 | Http.expectJson <| jsonDecResponse 119 | , timeout = 120 | Nothing 121 | , withCredentials = 122 | False 123 | } 124 | 125 | getStatus204 : Http.Request NoContent 126 | getStatus204 = 127 | let 128 | params = 129 | List.filterMap identity 130 | (List.concat 131 | []) 132 | in 133 | Http.request 134 | { method = 135 | "GET" 136 | , headers = 137 | [] 138 | , url = 139 | Url.Builder.absolute 140 | [ "status" 141 | , "204" 142 | ] 143 | params 144 | , body = 145 | Http.emptyBody 146 | , expect = 147 | Http.expectStringResponse 148 | (\ rsp -> 149 | if String.isEmpty rsp.body then 150 | Ok NoContent 151 | else 152 | Err "Expected the response body to be empty" 153 | ) 154 | , timeout = 155 | Nothing 156 | , withCredentials = 157 | False 158 | } 159 | 160 | postPost : MessageBody -> Http.Request ResponseWithJson 161 | postPost body = 162 | let 163 | params = 164 | List.filterMap identity 165 | (List.concat 166 | []) 167 | in 168 | Http.request 169 | { method = 170 | "POST" 171 | , headers = 172 | [] 173 | , url = 174 | Url.Builder.absolute 175 | [ "post" 176 | ] 177 | params 178 | , body = 179 | Http.jsonBody (jsonEncMessageBody body) 180 | , expect = 181 | Http.expectJson <| jsonDecResponseWithJson 182 | , timeout = 183 | Nothing 184 | , withCredentials = 185 | False 186 | } 187 | 188 | getGet : (Maybe String) -> Http.Request ResponseWithArgs 189 | getGet query_q = 190 | let 191 | params = 192 | List.filterMap identity 193 | (List.concat 194 | [ [ query_q 195 | |> Maybe.map (Url.Builder.string "query_q") ] 196 | ]) 197 | in 198 | Http.request 199 | { method = 200 | "GET" 201 | , headers = 202 | [] 203 | , url = 204 | Url.Builder.absolute 205 | [ "get" 206 | ] 207 | params 208 | , body = 209 | Http.emptyBody 210 | , expect = 211 | Http.expectJson <| jsonDecResponseWithArgs 212 | , timeout = 213 | Nothing 214 | , withCredentials = 215 | False 216 | } 217 | 218 | getByPath : String -> Http.Request Response 219 | getByPath capture_path = 220 | let 221 | params = 222 | List.filterMap identity 223 | (List.concat 224 | []) 225 | in 226 | Http.request 227 | { method = 228 | "GET" 229 | , headers = 230 | [] 231 | , url = 232 | Url.Builder.absolute 233 | [ capture_path 234 | ] 235 | params 236 | , body = 237 | Http.emptyBody 238 | , expect = 239 | Http.expectJson <| jsonDecResponse 240 | , timeout = 241 | Nothing 242 | , withCredentials = 243 | False 244 | } 245 | -------------------------------------------------------------------------------- /examples/e2e-tests/elm/Main.elm: -------------------------------------------------------------------------------- 1 | module Main exposing (..) 2 | 3 | import Generated.Api as Api 4 | import Html exposing (div, img, input, button, text, li, ul, h1, dl, dd, dt) 5 | import Http 6 | import Browser 7 | 8 | main : Program () Model Msg 9 | main = 10 | Browser.element 11 | { init = init 12 | , view = view 13 | , update = update 14 | , subscriptions = always Sub.none 15 | } 16 | 17 | 18 | type alias Model = 19 | { successGetIp : Maybe (Result Http.Error Api.Response) 20 | , successGetStatus204 : Maybe (Result Http.Error Api.NoContent) 21 | , successPostPost : Maybe (Result Http.Error Api.ResponseWithJson) 22 | , successGetGet : Maybe (Result MyError Api.ResponseWithArgs) 23 | , successGetByPath : Maybe (Result Http.Error Api.Response) 24 | } 25 | 26 | 27 | type MyError 28 | = HttpError Http.Error 29 | | AppError String 30 | 31 | 32 | init : () -> ( Model, Cmd Msg ) 33 | init _ = 34 | ( { successGetIp = Nothing 35 | , successGetStatus204 = Nothing 36 | , successPostPost = Nothing 37 | , successGetGet = Nothing 38 | , successGetByPath = Nothing 39 | } 40 | , Cmd.batch 41 | [ fetchStatus204 42 | , fetchIp 43 | , postPost 44 | , getGet 45 | , getByPath 46 | ] 47 | ) 48 | 49 | 50 | type Msg 51 | = SetSuccessStatus204 (Result Http.Error Api.NoContent) 52 | | SetSuccessIp (Result Http.Error Api.Response) 53 | | SetSuccessPost (Result Http.Error Api.ResponseWithJson) 54 | | CheckSuccessGet (Result Http.Error Api.ResponseWithArgs) 55 | | SetSuccessGetByPath (Result Http.Error Api.Response) 56 | 57 | 58 | fetchStatus204 : Cmd Msg 59 | fetchStatus204 = 60 | Api.getStatus204 61 | |> Http.send SetSuccessStatus204 62 | 63 | 64 | fetchIp : Cmd Msg 65 | fetchIp = 66 | Api.getIp 67 | |> Http.send SetSuccessIp 68 | 69 | 70 | postPost : Cmd Msg 71 | postPost = 72 | Api.postPost { message = "Hello World" } 73 | |> Http.send SetSuccessPost 74 | 75 | 76 | getGet : Cmd Msg 77 | getGet = 78 | Api.getGet (Just "Hello World") 79 | |> Http.send CheckSuccessGet 80 | 81 | 82 | getByPath : Cmd Msg 83 | getByPath = 84 | Api.getByPath "get" 85 | |> Http.send SetSuccessGetByPath 86 | 87 | 88 | update : Msg -> Model -> ( Model, Cmd Msg ) 89 | update action model = 90 | case action of 91 | SetSuccessStatus204 result -> 92 | ( { model | successGetStatus204 = Just result } 93 | , Cmd.none 94 | ) 95 | 96 | SetSuccessIp result -> 97 | ( { model | successGetIp = Just result } 98 | , Cmd.none 99 | ) 100 | 101 | SetSuccessPost result -> 102 | ( { model | successPostPost = Just result } 103 | , Cmd.none 104 | ) 105 | 106 | CheckSuccessGet result -> 107 | ( { model 108 | | successGetGet = 109 | Just 110 | (case result of 111 | Ok response -> 112 | if response.args.q == "Hello World" then 113 | promoteError result 114 | else 115 | Err (AppError (response.args.q ++ " != " ++ "Hello World")) 116 | 117 | Err _ -> 118 | promoteError result 119 | ) 120 | } 121 | , Cmd.none 122 | ) 123 | 124 | SetSuccessGetByPath result -> 125 | ( { model | successGetByPath = Just result } 126 | , Cmd.none 127 | ) 128 | 129 | 130 | promoteError : Result Http.Error a -> Result MyError a 131 | promoteError result = 132 | case result of 133 | Ok a -> 134 | Ok a 135 | 136 | Err e -> 137 | Err (HttpError e) 138 | 139 | 140 | view : Model -> Html.Html msg 141 | view model = 142 | div 143 | [] 144 | [ h1 [] [ text "Tests" ] 145 | , dl 146 | [] 147 | (List.concat 148 | [ viewResult "getIp" model.successGetIp 149 | , viewResult "getStatus204" model.successGetStatus204 150 | , viewResult "postPost" model.successPostPost 151 | , viewResult "getGet" model.successGetGet 152 | , viewResult "getByPath" model.successGetByPath 153 | ] 154 | ) 155 | ] 156 | 157 | 158 | viewResult : String -> Maybe (Result e a) -> List (Html.Html msg) 159 | viewResult name success = 160 | let 161 | ( status, content ) = 162 | case success of 163 | Nothing -> 164 | ( ": Waiting...", "" ) 165 | 166 | Just (Err e) -> 167 | ( ": Error", "") 168 | 169 | Just (Ok x) -> 170 | ( ": Ok", "") 171 | in 172 | [ dt [] [ text (name ++ status) ] 173 | , dd [] [ text content ] 174 | ] 175 | -------------------------------------------------------------------------------- /examples/e2e-tests/generate.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | {-# LANGUAGE TypeOperators #-} 5 | 6 | import Servant.API ((:<|>), (:>), Capture, Get, GetNoContent, JSON, 7 | Post, QueryParam, ReqBody) 8 | import Servant.Elm (DefineElm (DefineElm), ElmOptions(..), Proxy (Proxy), 9 | UrlPrefix (Static), defaultOptions, defElmImports, 10 | defElmOptions, deriveBoth, generateElmModuleWith) 11 | 12 | myElmOpts :: ElmOptions 13 | myElmOpts = defElmOptions { urlPrefix = Static "https://httpbin.org" } 14 | 15 | 16 | data MessageBody = MessageBody 17 | { message :: String } 18 | 19 | data QueryArgs = QueryArgs 20 | { q :: String } 21 | 22 | data Response = Response 23 | { origin :: String } 24 | 25 | data ResponseWithJson = ResponseWithJson 26 | { json :: MessageBody } 27 | 28 | data ResponseWithArgs = ResponseWithArgs 29 | { args :: QueryArgs } 30 | 31 | concat <$> mapM 32 | (deriveBoth defaultOptions) 33 | [''MessageBody, ''QueryArgs, ''Response, ''ResponseWithJson, ''ResponseWithArgs] 34 | 35 | 36 | type Api 37 | = "ip" 38 | :> Get '[JSON] Response 39 | :<|> "status" 40 | :> "204" 41 | :> GetNoContent '[JSON] () 42 | :<|> "post" 43 | :> ReqBody '[JSON] MessageBody 44 | :> Post '[JSON] ResponseWithJson 45 | :<|> "get" 46 | :> QueryParam "q" String 47 | :> Get '[JSON] ResponseWithArgs 48 | :<|> Capture "path" String 49 | :> Get '[JSON] Response 50 | 51 | 52 | main :: IO () 53 | main = 54 | generateElmModuleWith 55 | myElmOpts 56 | [ "Generated" 57 | , "Api" 58 | ] 59 | defElmImports 60 | "elm" 61 | [ DefineElm (Proxy :: Proxy MessageBody) 62 | , DefineElm (Proxy :: Proxy QueryArgs) 63 | , DefineElm (Proxy :: Proxy Response) 64 | , DefineElm (Proxy :: Proxy ResponseWithJson) 65 | , DefineElm (Proxy :: Proxy ResponseWithArgs) 66 | ] 67 | (Proxy :: Proxy Api) 68 | -------------------------------------------------------------------------------- /examples/giphy/README.md: -------------------------------------------------------------------------------- 1 | ## Giphy Example 2 | 3 | To build this example: 4 | 5 | ``` 6 | cd examples/giphy 7 | stack build 8 | stack runghc generate.hs 9 | elm make elm/Main.elm 10 | ``` 11 | 12 | Then open index.html in your browser. 13 | -------------------------------------------------------------------------------- /examples/giphy/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "elm" 5 | ], 6 | "elm-version": "0.19.0", 7 | "dependencies": { 8 | "direct": { 9 | "NoRedInk/elm-json-decode-pipeline": "1.0.0", 10 | "bartavelle/json-helpers": "2.0.2", 11 | "elm/browser": "1.0.1", 12 | "elm/core": "1.0.2", 13 | "elm/html": "1.0.0", 14 | "elm/http": "1.0.0", 15 | "elm/json": "1.1.3", 16 | "elm/url": "1.0.0" 17 | }, 18 | "indirect": { 19 | "elm/time": "1.0.0", 20 | "elm/virtual-dom": "1.0.2" 21 | } 22 | }, 23 | "test-dependencies": { 24 | "direct": {}, 25 | "indirect": { 26 | "elm/bytes": "1.0.8", 27 | "elm/file": "1.0.5" 28 | } 29 | } 30 | } 31 | -------------------------------------------------------------------------------- /examples/giphy/elm/Generated/GiphyApi.elm: -------------------------------------------------------------------------------- 1 | module Generated.GiphyApi exposing(..) 2 | 3 | import Json.Decode 4 | import Json.Encode exposing (Value) 5 | -- The following module comes from bartavelle/json-helpers 6 | import Json.Helpers exposing (..) 7 | import Dict exposing (Dict) 8 | import Set 9 | import Http 10 | import String 11 | import Url.Builder 12 | 13 | type alias Gif = 14 | { data: GifData 15 | } 16 | 17 | jsonDecGif : Json.Decode.Decoder ( Gif ) 18 | jsonDecGif = 19 | Json.Decode.succeed (\pdata -> {data = pdata}) 20 | |> required "data" (jsonDecGifData) 21 | 22 | jsonEncGif : Gif -> Value 23 | jsonEncGif val = 24 | Json.Encode.object 25 | [ ("data", jsonEncGifData val.data) 26 | ] 27 | 28 | 29 | 30 | type alias GifData = 31 | { image_url: String 32 | } 33 | 34 | jsonDecGifData : Json.Decode.Decoder ( GifData ) 35 | jsonDecGifData = 36 | Json.Decode.succeed (\pimage_url -> {image_url = pimage_url}) 37 | |> required "image_url" (Json.Decode.string) 38 | 39 | jsonEncGifData : GifData -> Value 40 | jsonEncGifData val = 41 | Json.Encode.object 42 | [ ("image_url", Json.Encode.string val.image_url) 43 | ] 44 | 45 | 46 | getRandom : (Maybe String) -> (Maybe String) -> Http.Request Gif 47 | getRandom query_api_key query_tag = 48 | let 49 | params = 50 | List.filterMap identity 51 | (List.concat 52 | [ [ query_api_key 53 | |> Maybe.map (Url.Builder.string "query_api_key") ] 54 | , [ query_tag 55 | |> Maybe.map (Url.Builder.string "query_tag") ] 56 | ]) 57 | in 58 | Http.request 59 | { method = 60 | "GET" 61 | , headers = 62 | [] 63 | , url = 64 | Url.Builder.absolute 65 | [ "random" 66 | ] 67 | params 68 | , body = 69 | Http.emptyBody 70 | , expect = 71 | Http.expectJson <| jsonDecGif 72 | , timeout = 73 | Nothing 74 | , withCredentials = 75 | False 76 | } 77 | -------------------------------------------------------------------------------- /examples/giphy/elm/Main.elm: -------------------------------------------------------------------------------- 1 | module Main exposing (..) 2 | 3 | import Generated.GiphyApi as Api 4 | import Browser 5 | import Html exposing (div, img, input, button, text) 6 | import Html.Attributes exposing (placeholder, src, value) 7 | import Html.Events exposing (onClick, onInput, targetValue) 8 | import Http 9 | import String 10 | 11 | 12 | main : Program () Model Msg 13 | main = 14 | Browser.element 15 | { init = init 16 | , view = view 17 | , update = update 18 | , subscriptions = always Sub.none 19 | } 20 | 21 | 22 | type alias Model = 23 | { url : Maybe String 24 | , topic : Maybe String 25 | } 26 | 27 | 28 | init : () -> ( Model, Cmd Msg ) 29 | init _ = 30 | ( { url = Nothing 31 | , topic = Nothing 32 | } 33 | , Cmd.none 34 | ) 35 | 36 | 37 | type Msg 38 | = FetchGif 39 | | NewGif (Result Http.Error Api.Gif) 40 | | SetTopic String 41 | 42 | 43 | update : Msg -> Model -> ( Model, Cmd Msg ) 44 | update action model = 45 | case action of 46 | FetchGif -> 47 | let 48 | effects = 49 | Api.getRandom (Just "dc6zaTOxFJmzC") model.topic 50 | |> Http.send NewGif 51 | in 52 | ( { model 53 | | url = Nothing 54 | } 55 | , effects 56 | ) 57 | 58 | NewGif rGif -> 59 | ( { model 60 | | url = 61 | rGif 62 | |> Result.toMaybe 63 | |> Maybe.map (.data >> .image_url) 64 | } 65 | , Cmd.none 66 | ) 67 | 68 | SetTopic topic -> 69 | ( { model 70 | | topic = 71 | if String.isEmpty topic then 72 | Nothing 73 | else 74 | Just topic 75 | } 76 | , Cmd.none 77 | ) 78 | 79 | 80 | view : Model -> Html.Html Msg 81 | view model = 82 | div [] 83 | [ div [] 84 | [ input 85 | [ onInput SetTopic 86 | , value (Maybe.withDefault "" model.topic) 87 | , placeholder "topic" 88 | ] 89 | [] 90 | , button 91 | [ onClick FetchGif ] 92 | [ text "click me" ] 93 | ] 94 | , img [ src (Maybe.withDefault "" model.url) ] [] 95 | ] 96 | -------------------------------------------------------------------------------- /examples/giphy/generate.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | {-# LANGUAGE TypeOperators #-} 5 | 6 | import qualified Elm.Derive as Elm 7 | 8 | import Servant.API ((:>), Get, JSON, QueryParam) 9 | import Servant.Elm (DefineElm (DefineElm), ElmOptions (urlPrefix), 10 | Proxy (Proxy), UrlPrefix (Static), defElmImports, 11 | defElmOptions, defaultOptions, deriveBoth, 12 | generateElmModuleWith) 13 | 14 | data GifData = GifData 15 | { image_url :: String 16 | } deriving (Show, Eq) 17 | 18 | data Gif = Gif 19 | { _data :: GifData 20 | } deriving (Show, Eq) 21 | 22 | concat <$> mapM 23 | (deriveBoth defaultOptions 24 | { Elm.fieldLabelModifier = \ field -> 25 | if head field == '_' then 26 | tail field 27 | else 28 | field 29 | , Elm.unwrapUnaryRecords = False 30 | } 31 | ) [''GifData, ''Gif] 32 | 33 | myElmOpts :: ElmOptions 34 | myElmOpts = 35 | defElmOptions 36 | { urlPrefix = 37 | Static "http://api.giphy.com/v1/gifs" 38 | } 39 | 40 | type GiphyApi = "random" :> QueryParam "api_key" String :> QueryParam "tag" String :> Get '[JSON] Gif 41 | 42 | main :: IO () 43 | main = 44 | generateElmModuleWith 45 | myElmOpts 46 | [ "Generated" 47 | , "GiphyApi" 48 | ] 49 | defElmImports 50 | "elm" 51 | [ DefineElm (Proxy :: Proxy Gif) 52 | , DefineElm (Proxy :: Proxy GifData) 53 | ] 54 | (Proxy :: Proxy GiphyApi) 55 | -------------------------------------------------------------------------------- /examples/readme-example/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "." 5 | ], 6 | "elm-version": "0.19.0", 7 | "dependencies": { 8 | "direct": { 9 | "NoRedInk/elm-json-decode-pipeline": "1.0.0", 10 | "bartavelle/json-helpers": "2.0.2", 11 | "elm/core": "1.0.2", 12 | "elm/http": "1.0.0", 13 | "elm/json": "1.1.3", 14 | "elm/url": "1.0.0" 15 | }, 16 | "indirect": {} 17 | }, 18 | "test-dependencies": { 19 | "direct": {}, 20 | "indirect": { 21 | "elm/bytes": "1.0.8", 22 | "elm/file": "1.0.5", 23 | "elm/time": "1.0.0" 24 | } 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /examples/readme-example/generate.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE TemplateHaskell #-} 4 | {-# LANGUAGE TypeOperators #-} 5 | 6 | import Servant.API ((:>), Capture, Get, JSON) 7 | import Servant.Elm (DefineElm (DefineElm), Proxy (Proxy), 8 | defaultOptions, defElmImports, defElmOptions, 9 | deriveBoth, generateElmModuleWith) 10 | 11 | data Book = Book 12 | { name :: String 13 | } 14 | 15 | deriveBoth defaultOptions ''Book 16 | 17 | type BooksApi = "books" :> Capture "bookId" Int :> Get '[JSON] Book 18 | 19 | main :: IO () 20 | main = 21 | generateElmModuleWith 22 | defElmOptions 23 | [ "Generated" 24 | , "MyApi" 25 | ] 26 | defElmImports 27 | "my-elm-dir" 28 | [ DefineElm (Proxy :: Proxy Book) 29 | ] 30 | (Proxy :: Proxy BooksApi) 31 | -------------------------------------------------------------------------------- /examples/readme-example/my-elm-dir/Generated/MyApi.elm: -------------------------------------------------------------------------------- 1 | module Generated.MyApi exposing(..) 2 | 3 | import Json.Decode 4 | import Json.Encode exposing (Value) 5 | -- The following module comes from bartavelle/json-helpers 6 | import Json.Helpers exposing (..) 7 | import Dict exposing (Dict) 8 | import Set 9 | import Http 10 | import String 11 | import Url.Builder 12 | 13 | type alias Book = 14 | { name: String 15 | } 16 | 17 | jsonDecBook : Json.Decode.Decoder ( Book ) 18 | jsonDecBook = 19 | Json.Decode.succeed (\pname -> {name = pname}) 20 | |> required "name" (Json.Decode.string) 21 | 22 | jsonEncBook : Book -> Value 23 | jsonEncBook val = 24 | Json.Encode.object 25 | [ ("name", Json.Encode.string val.name) 26 | ] 27 | 28 | 29 | getBooksByBookId : Int -> Http.Request Book 30 | getBooksByBookId capture_bookId = 31 | let 32 | params = 33 | List.filterMap identity 34 | (List.concat 35 | []) 36 | in 37 | Http.request 38 | { method = 39 | "GET" 40 | , headers = 41 | [] 42 | , url = 43 | Url.Builder.absolute 44 | [ "books" 45 | , capture_bookId |> String.fromInt 46 | ] 47 | params 48 | , body = 49 | Http.emptyBody 50 | , expect = 51 | Http.expectJson <| jsonDecBook 52 | , timeout = 53 | Nothing 54 | , withCredentials = 55 | False 56 | } 57 | -------------------------------------------------------------------------------- /servant-elm.cabal: -------------------------------------------------------------------------------- 1 | name: servant-elm 2 | version: 0.7.3 3 | synopsis: Automatically derive Elm functions to query servant webservices. 4 | description: Please see README.md 5 | homepage: http://github.com/mattjbray/servant-elm#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Matt Bray 9 | maintainer: mattjbray@gmail.com 10 | copyright: 2015-2016 Matt Bray 11 | category: Web 12 | build-type: Simple 13 | extra-source-files: 14 | CHANGELOG.md 15 | README.md 16 | test/elm-sources/elm.json 17 | test/elm-sources/*.elm 18 | cabal-version: >=1.10 19 | 20 | flag examples 21 | Description: Build the example programs. 22 | Default: False 23 | 24 | flag integration 25 | Description: Build the integration tests (requires an Elm installation). 26 | Default: False 27 | 28 | library 29 | hs-source-dirs: src 30 | exposed-modules: Servant.Elm 31 | , Servant.Elm.Internal.Foreign 32 | , Servant.Elm.Internal.Generate 33 | , Servant.Elm.Internal.Options 34 | build-depends: base >= 4.7 && < 5 35 | , aeson >= 0.9 36 | , directory 37 | , elm-bridge >= 0.5.2 38 | , lens 39 | , servant >= 0.8 40 | , servant-foreign >= 0.8 41 | , text 42 | , wl-pprint-text 43 | ghc-options: -Wall 44 | default-language: Haskell2010 45 | 46 | test-suite servant-elm-test 47 | type: exitcode-stdio-1.0 48 | hs-source-dirs: test 49 | main-is: GenerateSpec.hs 50 | other-modules: Common 51 | , PolymorphicData 52 | build-depends: 53 | Diff 54 | , HUnit 55 | , aeson >= 0.9 56 | , base 57 | , elm-bridge >= 0.4 58 | , hspec 59 | , servant 60 | , servant-client 61 | , servant-elm 62 | , text 63 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 64 | default-language: Haskell2010 65 | 66 | test-suite servant-elm-test-integration 67 | if !flag(integration) 68 | Buildable: False 69 | type: exitcode-stdio-1.0 70 | hs-source-dirs: test 71 | main-is: CompileSpec.hs 72 | other-modules: Common 73 | build-depends: aeson >= 0.9 74 | , base 75 | , directory 76 | , elm-bridge >= 0.4 77 | , hspec 78 | , interpolate 79 | , mockery 80 | , process 81 | , servant 82 | , servant-elm 83 | , text 84 | , typed-process 85 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 86 | default-language: Haskell2010 87 | 88 | source-repository head 89 | type: git 90 | location: https://github.com/mattjbray/servant-elm 91 | 92 | executable books-example 93 | if !flag(examples) 94 | Buildable: False 95 | main-is: generate.hs 96 | build-depends: base >= 4.7 && < 5 97 | , elm-bridge >= 0.4 98 | , servant >= 0.8 99 | , servant-elm 100 | hs-source-dirs: examples/books 101 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 102 | default-language: Haskell2010 103 | 104 | executable e2e-tests-example 105 | if !flag(examples) 106 | Buildable: False 107 | main-is: generate.hs 108 | build-depends: base >= 4.7 && < 5 109 | , elm-bridge >= 0.4 110 | , servant >= 0.8 111 | , servant-elm 112 | hs-source-dirs: examples/e2e-tests 113 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 114 | default-language: Haskell2010 115 | 116 | executable giphy-example 117 | if !flag(examples) 118 | Buildable: False 119 | main-is: generate.hs 120 | build-depends: base >= 4.7 && < 5 121 | , elm-bridge >= 0.4 122 | , servant >= 0.8 123 | , servant-elm 124 | , text 125 | hs-source-dirs: examples/giphy 126 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 127 | default-language: Haskell2010 128 | 129 | executable readme-example 130 | if !flag(examples) 131 | Buildable: False 132 | main-is: generate.hs 133 | build-depends: base >= 4.7 && < 5 134 | , elm-bridge >= 0.4 135 | , servant >= 0.8 136 | , servant-elm 137 | hs-source-dirs: examples/readme-example 138 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 139 | default-language: Haskell2010 140 | -------------------------------------------------------------------------------- /src/Servant/Elm.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Basic usage: 3 | 4 | > import MyLib (MyServantApiType) 5 | > import Servant.Elm 6 | > 7 | > spec :: Spec 8 | > spec = Spec ["Generated", "MyApi"] 9 | > (defElmImports : generateElmForAPI (Proxy :: Proxy MyServantApiType)) 10 | > 11 | > main :: IO () 12 | > main = specsToDir [spec] "my-elm-dir" 13 | -} 14 | module Servant.Elm 15 | ( generateElmForAPI 16 | , generateElmForAPIWith 17 | , generateElmModule 18 | , generateElmModuleWith 19 | , ElmOptions(..) 20 | , UrlPrefix(..) 21 | , defElmOptions 22 | , defElmImports 23 | , defaultOptions 24 | , defaultElmToString 25 | -- * Convenience re-exports from the "Elm" module 26 | , DefineElm (..) 27 | , EType (..) 28 | , defaultTypeAlterations 29 | , toElmType 30 | , deriveBoth 31 | , deriveElmDef 32 | -- * Convenience re-exports from "Data.Proxy" 33 | , Proxy(Proxy) 34 | ) where 35 | 36 | import Servant.Elm.Internal.Generate (ElmOptions (..), UrlPrefix (..), 37 | defElmImports, defElmOptions, 38 | defaultElmToString, 39 | generateElmForAPI, 40 | generateElmForAPIWith, 41 | generateElmModule, 42 | generateElmModuleWith) 43 | import Servant.Elm.Internal.Options (defaultOptions) 44 | import Data.Proxy (Proxy (Proxy)) 45 | import Elm.TyRep (EType (..), toElmType) 46 | import Elm.Module (DefineElm (..), defaultTypeAlterations) 47 | import Elm.Derive (deriveBoth, deriveElmDef) 48 | -------------------------------------------------------------------------------- /src/Servant/Elm/Internal/Foreign.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | {-# LANGUAGE TypeFamilies #-} 6 | 7 | module Servant.Elm.Internal.Foreign where 8 | 9 | import Data.Proxy (Proxy (Proxy)) 10 | import Data.Typeable (Typeable) 11 | import Elm.TyRep (EType, toElmType) 12 | import Servant.API (Headers(..)) 13 | import Servant.Foreign (Foreign, GenerateList, HasForeign, 14 | HasForeignType, Req, listFromAPI, typeFor) 15 | 16 | 17 | data LangElm 18 | 19 | --- TODO: Generate Elm functions that can handle the response headers. PRs 20 | --- welcome! 21 | instance {-# OVERLAPPING #-} (Typeable a) => HasForeignType LangElm EType (Headers b a) where 22 | typeFor _ _ _ = toElmType (Proxy :: Proxy a) 23 | 24 | instance {-# OVERLAPPABLE #-} (Typeable a) => HasForeignType LangElm EType a where 25 | typeFor _ _ _ = toElmType (Proxy :: Proxy a) 26 | 27 | getEndpoints 28 | :: ( HasForeign LangElm EType api 29 | , GenerateList EType (Foreign EType api)) 30 | => Proxy api 31 | -> [Req EType] 32 | getEndpoints = 33 | listFromAPI (Proxy :: Proxy LangElm) (Proxy :: Proxy EType) 34 | -------------------------------------------------------------------------------- /src/Servant/Elm/Internal/Generate.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | module Servant.Elm.Internal.Generate where 7 | 8 | import Prelude hiding ((<$>)) 9 | import Control.Lens (to, (^.)) 10 | import Data.List (intercalate, intersperse, nub) 11 | import Data.Maybe (catMaybes) 12 | import Data.Proxy (Proxy(..)) 13 | import Data.Text (Text) 14 | import qualified Data.Text as T 15 | import qualified Data.Text.Lazy as L 16 | import qualified Data.Text.Encoding as T 17 | import Data.Text.IO as TIO 18 | 19 | import Elm.Json (jsonParserForType, jsonSerForType) 20 | import qualified Elm.Module as Elm 21 | import Elm.TyRep (ETCon(..), EType(..), ETypeDef(..), toElmType) 22 | import Elm.TyRender (renderElm) 23 | #if MIN_VERSION_elm_bridge(0,6,0) 24 | import Elm.Versions (ElmVersion(Elm0p19)) 25 | #else 26 | import Elm.Versions (ElmVersion(Elm0p18)) 27 | #endif 28 | import Servant.Elm.Internal.Foreign (LangElm, getEndpoints) 29 | import qualified Servant.Foreign as F 30 | import System.Directory (createDirectoryIfMissing) 31 | import Text.PrettyPrint.Leijen.Text 32 | 33 | 34 | toElmTypeRefWith :: ElmOptions -> EType -> Text 35 | toElmTypeRefWith ElmOptions{..} = T.pack . renderElm . elmTypeAlterations 36 | 37 | toElmDecoderRefWith :: ElmOptions -> EType -> Text 38 | toElmDecoderRefWith ElmOptions{..} = T.pack . jsonParserForType . elmTypeAlterations 39 | 40 | toElmEncoderRefWith :: ElmOptions -> EType -> Text 41 | toElmEncoderRefWith ElmOptions{..} = T.pack . jsonSerForType . elmTypeAlterations 42 | 43 | {-| 44 | Options to configure how code is generated. 45 | -} 46 | data ElmOptions = ElmOptions 47 | { {- | The protocol, host and any path prefix to be used as the base for all 48 | requests. 49 | 50 | Example: @Static "https://mydomain.com/api/v1"@ 51 | 52 | When @Dynamic@, the generated Elm functions take the base URL as the first 53 | argument. 54 | -} 55 | urlPrefix :: UrlPrefix 56 | , elmTypeAlterations :: (EType -> EType) 57 | -- ^ Alterations to perform on ETypes before code generation. 58 | , elmAlterations :: (ETypeDef -> ETypeDef) 59 | -- ^ Alterations to perform on ETypeDefs before code generation. 60 | , elmToString :: (EType -> Text) 61 | -- ^ Elm functions creating a string from a given type. 62 | , emptyResponseElmTypes :: [EType] 63 | -- ^ Types that represent an empty Http response. 64 | , stringElmTypes :: [EType] 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. 72 | } 73 | 74 | 75 | data UrlPrefix 76 | = Static T.Text 77 | | Dynamic 78 | 79 | type Namespace = [String] 80 | 81 | {-| 82 | Default options for generating Elm code. 83 | 84 | The default options are: 85 | 86 | > { urlPrefix = 87 | > Static "" 88 | > , elmAlterations = 89 | > Elm.defaultTypeAlterations 90 | > , emptyResponseElmTypes = 91 | > [ getType (Proxy :: Proxy ()) ] 92 | > , stringElmTypes = 93 | > [ getType (Proxy :: Proxy String) 94 | > , getType (Proxy :: Proxy T.Text) ] 95 | > , expectJsonMethod = "Http.expectJson" 96 | > , expectStringMethod = "Http.expectString" 97 | > , httpErrorType = "Http.Error" 98 | > } 99 | -} 100 | defElmOptions :: ElmOptions 101 | defElmOptions = ElmOptions 102 | { urlPrefix = Static "" 103 | , elmTypeAlterations = Elm.defaultTypeAlterations 104 | , elmAlterations = Elm.defaultAlterations 105 | , elmToString = defaultElmToString 106 | , emptyResponseElmTypes = 107 | [ toElmType (Proxy :: Proxy ()) 108 | ] 109 | , stringElmTypes = 110 | [ toElmType (Proxy :: Proxy String) 111 | , toElmType (Proxy :: Proxy T.Text) 112 | ] 113 | , expectJsonMethod = "Http.expectJson" 114 | , expectStringMethod = "Http.expectString" 115 | , httpErrorType = "Http.Error" 116 | } 117 | 118 | 119 | {-| 120 | Default imports required by generated Elm code. 121 | 122 | You probably want to include this at the top of your generated Elm module. 123 | 124 | The default required imports are: 125 | 126 | > import Json.Decode 127 | > import Json.Encode exposing (Value) 128 | > -- The following module comes from bartavelle/json-helpers 129 | > import Json.Helpers exposing (..) 130 | > import Dict exposing (Dict) 131 | > import Set 132 | > import Http 133 | > import String 134 | > import Url 135 | > import Url.Builder 136 | -} 137 | defElmImports :: Text 138 | defElmImports = 139 | T.unlines 140 | [ "import Json.Decode" 141 | , "import Json.Encode exposing (Value)" 142 | , "-- The following module comes from bartavelle/json-helpers" 143 | , "import Json.Helpers exposing (..)" 144 | , "import Dict exposing (Dict)" 145 | , "import Set" 146 | , "import Http" 147 | , "import String" 148 | , "import Url" 149 | , "import Url.Builder" 150 | ] 151 | 152 | {-| 153 | Helper to generate a complete Elm module given a list of Elm type definitions 154 | and an API. 155 | -} 156 | generateElmModuleWith :: 157 | ( F.HasForeign LangElm EType api 158 | , F.GenerateList EType (F.Foreign EType api) 159 | ) 160 | => ElmOptions 161 | -> Namespace 162 | -> Text 163 | -> FilePath 164 | -> [Elm.DefineElm] 165 | -> Proxy api 166 | -> IO () 167 | generateElmModuleWith options namespace imports rootDir typeDefs api = do 168 | let out = 169 | T.unlines $ 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 176 | , "" 177 | , imports 178 | , T.pack $ Elm.makeModuleContentWithAlterations (elmAlterations options) typeDefs 179 | ] ++ 180 | generateElmForAPIWith options api 181 | moduleName = intercalate "." namespace 182 | filePath = intercalate "/" $ rootDir:init namespace 183 | fileName = intercalate "/" $ filePath:[last namespace ++ ".elm"] 184 | createDirectoryIfMissing True filePath 185 | TIO.writeFile fileName out 186 | 187 | {-| 188 | Calls generateElmModuleWith with @defElmOptions@. 189 | -} 190 | generateElmModule :: 191 | ( F.HasForeign LangElm EType api 192 | , F.GenerateList EType (F.Foreign EType api) 193 | ) 194 | => Namespace 195 | -> Text 196 | -> FilePath 197 | -> [Elm.DefineElm] 198 | -> Proxy api 199 | -> IO () 200 | generateElmModule namespace imports filePath typeDefs api = 201 | generateElmModuleWith defElmOptions namespace imports filePath typeDefs api 202 | 203 | {-| 204 | Generate Elm code for the API with default options. 205 | 206 | Returns a list of Elm functions to query your Servant API from Elm. 207 | 208 | You could spit these out to a file and call them from your Elm code, but you 209 | would be better off creating a 'Spec' with the result and using 'specsToDir', 210 | which handles the module name for you. 211 | -} 212 | generateElmForAPI 213 | :: ( F.HasForeign LangElm EType api 214 | , F.GenerateList EType (F.Foreign EType api)) 215 | => Proxy api 216 | -> [Text] 217 | generateElmForAPI = 218 | generateElmForAPIWith defElmOptions 219 | 220 | 221 | {-| 222 | Generate Elm code for the API with custom options. 223 | -} 224 | generateElmForAPIWith 225 | :: ( F.HasForeign LangElm EType api 226 | , F.GenerateList EType (F.Foreign EType api)) 227 | => ElmOptions 228 | -> Proxy api 229 | -> [Text] 230 | generateElmForAPIWith opts = intersperse "" . 231 | nub . map docToText . map (generateElmForRequest opts) . getEndpoints 232 | 233 | i :: Int 234 | i = 4 235 | 236 | {-| 237 | Generate an Elm function for one endpoint. 238 | -} 239 | generateElmForRequest :: ElmOptions -> F.Req EType -> Doc 240 | generateElmForRequest opts request = 241 | funcDef 242 | where 243 | funcDef = 244 | vsep 245 | [ fnName <+> ":" <+> typeSignature 246 | , fnName <+> args <+> equals 247 | , case letParams of 248 | Just params -> 249 | indent i 250 | (vsep ["let" 251 | , indent i params 252 | , "in" 253 | , indent i elmRequest 254 | ]) 255 | Nothing -> 256 | indent i elmRequest 257 | ] 258 | 259 | fnName = 260 | request ^. F.reqFuncName . to (replace . F.camelCase) . to stext 261 | 262 | replace = T.replace "-" "" . T.replace "." "" . T.replace " " "" 263 | 264 | typeSignature = 265 | mkTypeSignature opts request 266 | 267 | args = 268 | mkArgs opts request 269 | 270 | letParams = 271 | mkLetParams opts request 272 | 273 | elmRequest = 274 | mkRequest opts request 275 | 276 | 277 | mkTypeSignature :: ElmOptions -> F.Req EType -> Doc 278 | mkTypeSignature opts request = 279 | (hsep . punctuate " ->" . concat) 280 | [ catMaybes [urlPrefixType] 281 | , headerTypes 282 | , urlCaptureTypes 283 | , queryTypes 284 | , catMaybes [bodyType, toMsgType, returnType] 285 | ] 286 | where 287 | urlPrefixType :: Maybe Doc 288 | urlPrefixType = 289 | case (urlPrefix opts) of 290 | Dynamic -> Just "String" 291 | Static _ -> Nothing 292 | 293 | elmTypeRef :: EType -> Doc 294 | elmTypeRef eType = 295 | stext (toElmTypeRefWith opts eType) 296 | 297 | headerTypes :: [Doc] 298 | headerTypes = 299 | [ header ^. F.headerArg . F.argType . to elmTypeRef 300 | | header <- request ^. F.reqHeaders 301 | , isNotCookie header 302 | ] 303 | 304 | urlCaptureTypes :: [Doc] 305 | urlCaptureTypes = 306 | [ F.captureArg capture ^. F.argType . to elmTypeRef 307 | | capture <- request ^. F.reqUrl . F.path 308 | , F.isCapture capture 309 | ] 310 | 311 | queryTypes :: [Doc] 312 | queryTypes = 313 | [ arg ^. F.queryArgName . F.argType . to elmTypeRef 314 | | arg <- request ^. F.reqUrl . F.queryStr 315 | ] 316 | 317 | bodyType :: Maybe Doc 318 | bodyType = 319 | fmap elmTypeRef $ request ^. F.reqBody 320 | 321 | toMsgType :: Maybe Doc 322 | toMsgType = do 323 | result <- fmap elmTypeRef $ request ^. F.reqReturnType 324 | Just ("(Result" <+> stext (httpErrorType opts) <+> parens result <+> "-> msg)") 325 | 326 | returnType :: Maybe Doc 327 | returnType = do 328 | pure ("Cmd msg") 329 | 330 | 331 | elmHeaderArg :: F.HeaderArg EType -> Doc 332 | elmHeaderArg header = 333 | "header_" <> 334 | header ^. F.headerArg . F.argName . to (stext . T.replace "-" "_" . F.unPathSegment) 335 | 336 | 337 | elmCaptureArg :: F.Segment EType -> Doc 338 | elmCaptureArg segment = 339 | "capture_" <> 340 | F.captureArg segment ^. F.argName . to (stext . replace . F.unPathSegment) 341 | where 342 | replace = T.replace "-" "_" . T.replace " " "_" 343 | 344 | 345 | elmQueryArg :: F.QueryArg EType -> Doc 346 | elmQueryArg arg = 347 | "query_" <> 348 | arg ^. F.queryArgName . F.argName . to (stext . replace . F.unPathSegment) 349 | where 350 | replace = T.replace "-" "_" 351 | 352 | 353 | elmBodyArg :: Doc 354 | elmBodyArg = 355 | "body" 356 | 357 | 358 | isNotCookie :: F.HeaderArg f -> Bool 359 | isNotCookie header = 360 | header 361 | ^. F.headerArg 362 | . F.argName 363 | . to ((/= "cookie") . T.toLower . F.unPathSegment) 364 | 365 | 366 | mkArgs 367 | :: ElmOptions 368 | -> F.Req EType 369 | -> Doc 370 | mkArgs opts request = 371 | (hsep . concat) $ 372 | [ -- Dynamic url prefix 373 | case urlPrefix opts of 374 | Dynamic -> ["urlBase"] 375 | Static _ -> [] 376 | , -- Headers 377 | [ elmHeaderArg header 378 | | header <- request ^. F.reqHeaders 379 | , isNotCookie header 380 | ] 381 | , -- URL Captures 382 | [ elmCaptureArg segment 383 | | segment <- request ^. F.reqUrl . F.path 384 | , F.isCapture segment 385 | ] 386 | , -- Query params 387 | [ elmQueryArg arg 388 | | arg <- request ^. F.reqUrl . F.queryStr 389 | ] 390 | , -- Request body 391 | maybe [] (const [elmBodyArg]) (request ^. F.reqBody) 392 | , pure "toMsg" 393 | ] 394 | 395 | 396 | mkLetParams :: ElmOptions -> F.Req EType -> Maybe Doc 397 | mkLetParams opts request = 398 | Just $ "params =" <$> 399 | indent i ("List.filterMap identity" <$> 400 | parens ("List.concat" <$> 401 | indent i (elmList params))) 402 | where 403 | params :: [Doc] 404 | params = map paramToDoc (request ^. F.reqUrl . F.queryStr) 405 | 406 | paramToDoc :: F.QueryArg EType -> Doc 407 | paramToDoc qarg = 408 | -- something wrong with indentation here... 409 | case qarg ^. F.queryArgType of 410 | F.Normal -> 411 | let 412 | argType = qarg ^. F.queryArgName . F.argType 413 | wrapped = isElmMaybeType argType 414 | toStringSrc = 415 | toString opts (maybeOf argType) 416 | in 417 | "[" <+> (if wrapped then elmName else "Just" <+> elmName) <> line <> 418 | (indent 4 ("|> Maybe.map" <+> composeRight [toStringSrc, "Url.Builder.string" <+> dquotes name])) 419 | <+> "]" 420 | -- (if wrapped then name else "Just" <+> name) <$> 421 | -- indent 4 ("|> Maybe.map" <+> parens (toStringSrc <> "Http.encodeUri >> (++)" <+> dquotes (elmName <> equals)) <$> 422 | -- "|> Maybe.withDefault" <+> dquotes empty) 423 | 424 | F.Flag -> 425 | "[" <+> 426 | ("if" <+> elmName <+> "then" <$> 427 | indent 4 ("Just" <+> parens ("Url.Builder.string" <+> dquotes name <+> dquotes empty)) <$> 428 | indent 2 "else" <$> 429 | indent 4 "Nothing") 430 | <+> "]" 431 | 432 | F.List -> 433 | let 434 | argType = qarg ^. F.queryArgName . F.argType 435 | toStringSrc = 436 | toString opts (listOf (maybeOf argType)) 437 | in 438 | elmName <$> 439 | indent 4 ("|> List.map" 440 | <+> composeRight 441 | [ toStringSrc 442 | , "Url.Builder.string" <+> dquotes (name <> "[]") 443 | , "Just" 444 | ] 445 | ) 446 | 447 | where 448 | elmName = elmQueryArg qarg 449 | name = qarg ^. F.queryArgName . F.argName . to (stext . F.unPathSegment) 450 | 451 | 452 | mkRequest :: ElmOptions -> F.Req EType -> Doc 453 | mkRequest opts request = 454 | "Http.request" <$> 455 | indent i 456 | (elmRecord 457 | [ "method =" <$> 458 | indent i (dquotes method) 459 | , "headers =" <$> 460 | indent i 461 | (elmListOfMaybes headers) 462 | , "url =" <$> 463 | indent i url 464 | , "body =" <$> 465 | indent i body 466 | , "expect =" <$> 467 | indent i expect 468 | , "timeout =" <$> 469 | indent i "Nothing" 470 | , "tracker =" <$> 471 | indent i "Nothing" 472 | ]) 473 | where 474 | method = 475 | request ^. F.reqMethod . to (stext . T.decodeUtf8) 476 | 477 | mkHeader header = 478 | let headerName = header ^. F.headerArg . F.argName . to (stext . F.unPathSegment) 479 | headerArgName = elmHeaderArg header 480 | argType = header ^. F.headerArg . F.argType 481 | wrapped = isElmMaybeType argType 482 | toStringSrc = toString opts (maybeOf argType) 483 | in 484 | "Maybe.map" <+> composeLeft ["Http.header" <+> dquotes headerName, toStringSrc] 485 | <+> 486 | (if wrapped then headerArgName else parens ("Just" <+> headerArgName)) 487 | 488 | headers = 489 | [ mkHeader header 490 | | header <- request ^. F.reqHeaders 491 | , isNotCookie header 492 | ] 493 | 494 | url = 495 | mkUrl opts (request ^. F.reqUrl . F.path) 496 | <> mkQueryParams request 497 | 498 | body = 499 | case request ^. F.reqBody of 500 | Nothing -> 501 | "Http.emptyBody" 502 | 503 | Just elmTypeExpr -> 504 | let 505 | encoderName = 506 | toElmEncoderRefWith opts elmTypeExpr 507 | in 508 | "Http.jsonBody" <+> parens (stext encoderName <+> elmBodyArg) 509 | 510 | expect = 511 | case request ^. F.reqReturnType of 512 | Just elmTypeExpr 513 | | isEmptyType opts $ (elmTypeAlterations opts) elmTypeExpr 514 | -- let elmConstructor = T.pack (renderElm elmTypeExpr) 515 | -> 516 | stext (expectStringMethod opts) <> line <+> indent i "(\\x -> case x of" <> line <+> 517 | indent i "Err e -> toMsg (Err e)" <> line <+> 518 | indent i "Ok _ -> toMsg (Ok ()))" 519 | Just elmTypeExpr -> 520 | stext (expectJsonMethod opts) <+> "toMsg" <+> renderDecoderName ((elmTypeAlterations opts) elmTypeExpr) 521 | Nothing -> error "mkHttpRequest: no reqReturnType?" 522 | -- case request ^. F.reqReturnType of 523 | -- Just elmTypeExpr | isEmptyType opts elmTypeExpr -> 524 | -- let elmConstructor = 525 | -- toElmTypeRefWith opts elmTypeExpr 526 | -- in 527 | -- "Http.expectStringResponse" <$> 528 | -- indent i (parens (backslash <> " rsp " <+> "->" <$> 529 | -- indent i ("if String.isEmpty rsp.body then" <$> 530 | -- indent i "Ok" <+> stext elmConstructor <$> 531 | -- "else" <$> 532 | -- indent i ("Err" <+> dquotes "Expected the response body to be empty")) <> line)) 533 | 534 | 535 | -- Just elmTypeExpr -> 536 | -- "Http.expectJson <|" <+> stext (toElmDecoderRefWith opts elmTypeExpr) 537 | 538 | -- Nothing -> 539 | -- error "mkHttpRequest: no reqReturnType?" 540 | 541 | renderDecoderName :: EType -> Doc 542 | renderDecoderName elmTypeExpr = 543 | case elmTypeExpr of 544 | ETyApp (ETyCon (ETCon "List")) t -> 545 | parens ("Json.Decode.list " <> parens (renderDecoderName t)) 546 | ETyApp (ETyCon (ETCon "Maybe")) t -> 547 | parens ("Json.Decode.maybe " <> parens (renderDecoderName t)) 548 | ETyApp x y -> 549 | parens (renderDecoderName x <+> renderDecoderName y) 550 | ETyCon (ETCon "Int") -> "Json.Decode.int" 551 | ETyCon (ETCon "String") -> "Json.Decode.string" 552 | _ -> ("jsonDec" <> stext (T.pack (renderElm elmTypeExpr))) 553 | 554 | 555 | mkUrl :: ElmOptions -> [F.Segment EType] -> Doc 556 | mkUrl opts segments = 557 | urlBuilder <$> 558 | (indent i . elmList) 559 | ( map segmentToDoc segments) 560 | -- ( case urlPrefix opts of 561 | -- Dynamic -> "urlBase" 562 | -- Static url -> dquotes (stext url) 563 | -- : map segmentToDoc segments) 564 | where 565 | urlBuilder :: Doc 566 | urlBuilder = case urlPrefix opts of 567 | Dynamic -> "Url.Builder.crossOrigin urlBase" :: Doc 568 | Static url -> "Url.Builder.crossOrigin" <+> dquotes (stext url) 569 | 570 | segmentToDoc :: F.Segment EType -> Doc 571 | segmentToDoc s = 572 | case F.unSegment s of 573 | F.Static path -> 574 | dquotes (stext (F.unPathSegment path)) 575 | F.Cap arg -> 576 | let 577 | toStringSrc = 578 | toString opts (elmTypeAlterations opts (maybeOf (arg ^. F.argType))) 579 | in 580 | "Url.percentEncode " <> pipeRight [elmCaptureArg s, toStringSrc] 581 | 582 | 583 | mkQueryParams 584 | :: F.Req EType 585 | -> Doc 586 | mkQueryParams _request = 587 | -- if null (request ^. F.reqUrl . F.queryStr) then 588 | -- empty 589 | -- else 590 | line <> indent 4 (align "params") 591 | 592 | 593 | {- | Determines whether we construct an Elm function that expects an empty 594 | response body. 595 | -} 596 | isEmptyType :: ElmOptions -> EType -> Bool 597 | isEmptyType opts elmTypeExpr = 598 | (elmTypeAlterations opts elmTypeExpr) `elem` emptyResponseElmTypes opts 599 | 600 | 601 | {- | Determines whether we call `toString` on URL captures and query params of 602 | this type in Elm. 603 | -} 604 | isElmStringType :: ElmOptions -> EType -> Bool 605 | isElmStringType opts elmTypeExpr = 606 | (elmTypeAlterations opts elmTypeExpr) `elem` stringElmTypes opts 607 | 608 | {- | Determines whether a type is 'Maybe a' where 'a' is something akin to a 'String'. 609 | -} 610 | isElmMaybeStringType :: ElmOptions -> EType -> Bool 611 | isElmMaybeStringType opts (ETyApp (ETyCon (ETCon "Maybe")) elmTypeExpr) = elmTypeExpr `elem` stringElmTypes opts 612 | isElmMaybeStringType _ _ = False 613 | 614 | isElmMaybeType :: EType -> Bool 615 | isElmMaybeType (ETyApp (ETyCon (ETCon "Maybe")) _) = True 616 | isElmMaybeType _ = False 617 | 618 | isElmListOfMaybeBoolType :: EType -> Bool 619 | isElmListOfMaybeBoolType t = 620 | case t of 621 | (ETyApp (ETyCon (ETCon "List")) (ETyApp (ETyCon (ETCon "Maybe")) (ETyCon (ETCon "Bool")))) -> True 622 | _ -> False 623 | 624 | -- Doc helpers 625 | 626 | 627 | docToText :: Doc -> Text 628 | docToText = 629 | L.toStrict . displayT . renderPretty 0.4 100 630 | 631 | stext :: Text -> Doc 632 | stext = text . L.fromStrict 633 | 634 | elmRecord :: [Doc] -> Doc 635 | elmRecord = encloseSep (lbrace <> space) (line <> rbrace) (comma <> space) 636 | 637 | elmList :: [Doc] -> Doc 638 | elmList [] = lbracket <> rbracket 639 | elmList ds = lbracket <+> hsep (punctuate (line <> comma) ds) <$> rbracket 640 | 641 | elmListOfMaybes :: [Doc] -> Doc 642 | elmListOfMaybes [] = lbracket <> rbracket 643 | elmListOfMaybes 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) 685 | -------------------------------------------------------------------------------- /src/Servant/Elm/Internal/Options.hs: -------------------------------------------------------------------------------- 1 | module Servant.Elm.Internal.Options where 2 | 3 | import qualified Data.Aeson as A 4 | import qualified Elm.Derive as E 5 | 6 | defaultOptions :: A.Options 7 | defaultOptions = E.defaultOptions { A.unwrapUnaryRecords = False} 8 | 9 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-20.11 2 | packages: 3 | - '.' 4 | flags: {} 5 | extra-package-dbs: [] 6 | nix: 7 | enable: true 8 | packages: 9 | - zlib 10 | -------------------------------------------------------------------------------- /test/Common.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | {-# LANGUAGE TypeOperators #-} 4 | module Common where 5 | 6 | import Data.Proxy (Proxy (Proxy)) 7 | import Data.Text (Text) 8 | import Servant.API ((:<|>), (:>), Capture, Get, Header, 9 | Header', Headers, JSON, Post, 10 | Put, QueryFlag, QueryParam, 11 | QueryParam', QueryParams, ReqBody, Required) 12 | import Servant.Elm (deriveBoth, defaultOptions) 13 | 14 | data Book = Book 15 | { title :: String 16 | } 17 | 18 | deriveBoth defaultOptions ''Book 19 | 20 | type TestApi = 21 | "one" 22 | :> Get '[JSON] Int 23 | :<|> "two" 24 | :> ReqBody '[JSON] String 25 | :> Post '[JSON] (Maybe Int) 26 | :<|> "books" 27 | :> Capture "id" Int 28 | :> Get '[JSON] Book 29 | :<|> "books" 30 | :> Capture "title space" Text 31 | :> Get '[JSON] Book 32 | :<|> "books" 33 | :> QueryFlag "published" 34 | :> QueryParam "sort" String 35 | :> QueryParam "year" Int 36 | :> QueryParam' '[Required] "category" String 37 | :> QueryParams "filters" (Maybe Bool) 38 | :> Get '[JSON] [Book] 39 | :<|> "books" 40 | :> ReqBody '[JSON] Book 41 | -- :> PostNoContent '[JSON] () 42 | :> Post '[JSON] () 43 | :<|> "nothing" 44 | :> Get '[JSON] () 45 | -- :> GetNoContent '[JSON] () 46 | :<|> "nothing" 47 | :> Put '[JSON] () -- old way to specify no content 48 | :<|> "with-a-header" 49 | :> Header "Cookie" String 50 | :> Header "myStringHeader" String 51 | :> Header "MyIntHeader" Int 52 | :> Header' '[Required] "MyRequiredStringHeader" String 53 | :> Header' '[Required] "MyRequiredIntHeader" Int 54 | :> Get '[JSON] String 55 | :<|> "with-a-response-header" 56 | :> Get '[JSON] (Headers '[Header "myResponse" String] String) 57 | 58 | testApi :: Proxy TestApi 59 | testApi = Proxy 60 | -------------------------------------------------------------------------------- /test/CompileSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE QuasiQuotes #-} 3 | 4 | module Main where 5 | 6 | import Test.Hspec 7 | import Test.Mockery.Directory 8 | 9 | import Control.Exception 10 | import Control.Monad (when) 11 | import Data.List (intercalate) 12 | import Data.String.Interpolate 13 | import Data.String.Interpolate.Util 14 | import Elm.Versions (ElmVersion(..)) 15 | import Servant.Elm 16 | import System.Directory (canonicalizePath, 17 | createDirectoryIfMissing, 18 | doesDirectoryExist, 19 | getCurrentDirectory, removeFile, 20 | setCurrentDirectory) 21 | import System.Process (callCommand) 22 | import System.Process.Typed 23 | import qualified Data.Text as T 24 | import qualified Elm.Module as Elm 25 | import Data.Text.IO as TIO 26 | 27 | import Common (Book, TestApi) 28 | 29 | main :: IO () 30 | main = 31 | hspec spec 32 | 33 | spec :: Test.Hspec.Spec 34 | spec = do 35 | describe "generateElmForAPI" $ do 36 | it "creates compilable javascript" $ do 37 | inTempElmDir $ do 38 | let options = defElmOptions 39 | namespace :: [String] 40 | namespace = ["Generated", "BooksApi"] 41 | imports = defElmImports 42 | rootDir = "." 43 | typeDefs = [ DefineElm (Proxy :: Proxy Book) 44 | ] 45 | api = (Proxy :: Proxy TestApi) 46 | let out = 47 | T.unlines $ 48 | [ T.pack $ Elm.moduleHeader Elm0p19 moduleName 49 | , "" 50 | , imports 51 | , "" 52 | , "type NoContent = NoContent" 53 | , "" 54 | , T.pack $ Elm.makeModuleContentWithAlterations (elmAlterations options) typeDefs 55 | ] ++ 56 | generateElmForAPIWith options api 57 | moduleName = T.unpack (T.intercalate "." (map T.pack namespace)) 58 | filePath = intercalate "/" $ rootDir:init namespace 59 | fileName = intercalate "/" $ filePath : [last namespace ++ ".elm"] 60 | createDirectoryIfMissing True filePath 61 | TIO.writeFile fileName out 62 | 63 | -- -- Useful for locally checking out sources in your tmp dir 64 | -- callCommand "cp -r . /home/kb/tmp/servelmtest" 65 | runProcess_ "elm make Generated/BooksApi.elm --output api.js" 66 | 67 | 68 | inTempElmDir :: IO a -> IO a 69 | inTempElmDir action = do 70 | callCommand "rm -rf ./_test-cache" 71 | cacheExists <- doesDirectoryExist "_test-cache" 72 | when (not cacheExists) createCache 73 | cacheDir <- canonicalizePath "_test-cache" 74 | inTempDirectory $ do 75 | callCommand ("cp -r " ++ cacheDir ++ "/* .") 76 | action 77 | 78 | createCache :: IO () 79 | createCache = do 80 | createDirectoryIfMissing True "_test-cache" 81 | withCurrentDirectory "_test-cache" $ do 82 | TIO.writeFile "elm.json" $ T.pack $ unindent $ [i| 83 | { 84 | "type": "application", 85 | "source-directories": [ 86 | "." 87 | ], 88 | "elm-version": "0.19.0", 89 | "version": "1.0.0", 90 | "summary": "helpful summary of your project, less than 80 characters", 91 | "dependencies": { 92 | "direct": { 93 | "elm/core": "1.0.2", 94 | "elm/json": "1.1.3", 95 | "elm/http": "2.0.0", 96 | "elm/url": "1.0.0", 97 | "bartavelle/json-helpers": "2.0.2" 98 | }, 99 | "indirect": { 100 | "elm/bytes": "1.0.8", 101 | "elm/file": "1.0.5", 102 | "elm/time": "1.0.0" 103 | } 104 | }, 105 | "test-dependencies": { 106 | "direct": {}, 107 | "indirect": {} 108 | } 109 | } 110 | |] 111 | -- callCommand "elm install" 112 | -- compileDependencies 113 | 114 | compileDependencies :: IO () 115 | compileDependencies = do 116 | TIO.writeFile "Main.elm" "module Main exposing (foo)\n\nfoo : Int\nfoo = 42\n" 117 | callCommand "echo '>>>>>> Main.elm'" 118 | callCommand "cat Main.elm" 119 | callCommand "elm make Main.elm --output main.js" 120 | removeFile "Main.elm" 121 | removeFile "main.js" 122 | 123 | withCurrentDirectory :: FilePath -> IO a -> IO a 124 | withCurrentDirectory dir action = 125 | bracket enter recover (const action) 126 | where 127 | enter = do 128 | original <- getCurrentDirectory 129 | setCurrentDirectory dir 130 | return original 131 | recover = setCurrentDirectory 132 | -------------------------------------------------------------------------------- /test/GenerateSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE TypeOperators #-} 5 | 6 | module Main where 7 | 8 | import Control.Monad (zipWithM_) 9 | import qualified Data.Algorithm.Diff as Diff 10 | import qualified Data.Algorithm.DiffOutput as Diff 11 | import Data.Monoid ((<>)) 12 | import Data.Text (Text) 13 | import qualified Data.Text as T 14 | import qualified Data.Text.IO as T 15 | import Servant.API ((:>), Get, JSON) 16 | import Servant.Elm 17 | import Test.Hspec (Spec, describe, hspec, it) 18 | import Test.HUnit (Assertion, assertEqual) 19 | 20 | import Common (testApi) 21 | import PolymorphicData (SomeRecord(..), PolymorphicData(..)) 22 | 23 | 24 | main :: IO () 25 | main = hspec spec 26 | 27 | spec :: Test.Hspec.Spec 28 | spec = 29 | describe "encoding a simple api" $ 30 | do it "does it" $ 31 | do expected <- 32 | mapM 33 | (\(fpath,header) -> do 34 | source <- T.readFile fpath 35 | return (fpath, header, source)) 36 | [ ( "test/elm-sources/getOneSource.elm" 37 | , "module GetOneSource exposing (..)\n\n" <> 38 | "import Http\n" <> 39 | "import Json.Decode exposing (..)\n" <> 40 | "import Url.Builder\n\n\n" 41 | ) 42 | , ( "test/elm-sources/postTwoSource.elm" 43 | , "module PostTwoSource exposing (..)\n\n" <> 44 | "import Http\n" <> 45 | "import Json.Decode exposing (..)\n" <> 46 | "import Json.Encode\n" <> 47 | "import Url.Builder\n\n\n" 48 | ) 49 | , ( "test/elm-sources/getBooksByIdSource.elm" 50 | , "module GetBooksByIdSource exposing (..)\n\n" <> 51 | "import Http\n" <> 52 | "import Url.Builder\n" <> 53 | "import Json.Decode\n" <> 54 | "\n" <> 55 | "type Book = Book\n" <> 56 | "jsonDecBook : Json.Decode.Decoder Book\n" <> 57 | "jsonDecBook = Debug.todo \"\"\n\n" 58 | ) 59 | , ( "test/elm-sources/getBooksByTitleSource.elm" 60 | , "module GetBooksByTitleSource exposing (..)\n\n" <> 61 | "import Http\n" <> 62 | "import Url.Builder\n" <> 63 | "import Json.Decode as J\n\n" <> 64 | "type alias Book = {}\n" <> 65 | "jsonDecBook = J.succeed {}\n\n" 66 | ) 67 | , ( "test/elm-sources/getBooksSource.elm" 68 | , "module GetBooksSource exposing (..)\n\n" <> 69 | "import Http\n" <> 70 | "import Json.Decode exposing (..)\n" <> 71 | "import Url.Builder\n" <> 72 | "import Json.Decode as J\n\n" <> 73 | "type alias Book = {}\n\n" <> 74 | "jsonDecBook = J.succeed {}\n\n" 75 | ) 76 | , ( "test/elm-sources/postBooksSource.elm" 77 | , "module PostBooksSource exposing (..)\n\n" <> 78 | "import Http\n" <> 79 | "import Url.Builder\n" <> 80 | "import Json.Encode as Enc\n\n" <> 81 | "type alias Book = {}\n" <> 82 | "jsonEncBook = \\b -> Enc.object []\n\n" 83 | ) 84 | , ( "test/elm-sources/getNothingSource.elm" 85 | , "module GetNothingSource exposing (..)\n\n" <> 86 | "import Http\n" <> 87 | "import Url.Builder\n\n\n" 88 | ) 89 | , ( "test/elm-sources/putNothingSource.elm" 90 | , "module PutNothingSource exposing (..)\n\n" <> 91 | "import Http\n" <> 92 | "import Url.Builder\n\n\n" 93 | ) 94 | , ( "test/elm-sources/getWithaheaderSource.elm" 95 | , "module GetWithAHeaderSource exposing (..)\n\n" <> 96 | "import Http\n" <> 97 | "import Url.Builder\n" <> 98 | "import Json.Decode exposing (..)\n\n\n") 99 | , ( "test/elm-sources/getWitharesponseheaderSource.elm" 100 | , "module GetWithAResponseHeaderSource exposing (..)\n\n" <> 101 | "import Http\n" <> 102 | "import Url.Builder\n" <> 103 | "import Json.Decode exposing (..)\n\n\n")] 104 | let generated = filter (not . T.null) (generateElmForAPI testApi) 105 | generated `itemsShouldBe` expected 106 | it "with dynamic URLs" $ 107 | do expected <- 108 | mapM 109 | (\(fpath,header) -> do 110 | source <- T.readFile fpath 111 | return (fpath, header, source)) 112 | [ ( "test/elm-sources/getOneWithDynamicUrlSource.elm" 113 | , "module GetOneWithDynamicUrlSource exposing (..)\n\n" <> 114 | "import Http\n" <> 115 | "import Url.Builder\n" <> 116 | "import Json.Decode exposing (..)\n\n\n")] 117 | let generated = 118 | map 119 | (<> "\n") 120 | (generateElmForAPIWith 121 | (defElmOptions 122 | { urlPrefix = Dynamic 123 | }) 124 | (Proxy :: Proxy ("one" :> Get '[JSON] Int))) 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 150 | 151 | itemsShouldBe :: [Text] -> [(String, Text, Text)] -> IO () 152 | itemsShouldBe actual expected = 153 | zipWithM_ 154 | shouldBeDiff 155 | (actual ++ replicate (length expected - length actual) mempty) 156 | (expected ++ replicate (length actual - length expected) mempty) 157 | 158 | shouldBeDiff :: Text -> (String, Text, Text) -> Assertion 159 | shouldBeDiff a (fpath,header,b) = 160 | assertEqual 161 | ("< generated\n" <> "> " <> fpath <> "\n" <> 162 | Diff.ppDiff 163 | (Diff.getGroupedDiff 164 | (lines (T.unpack actual)) 165 | (lines (T.unpack expected)))) 166 | expected actual 167 | where 168 | actual = T.strip $ header <> a 169 | expected = T.strip b 170 | -------------------------------------------------------------------------------- /test/PolymorphicData.hs: -------------------------------------------------------------------------------- 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 16 | -------------------------------------------------------------------------------- /test/elm-sources/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "version": "1.0.0", 4 | "summary": "helpful summary of your project, less than 80 characters", 5 | "repository": "https://github.com/user/project.git", 6 | "license": "BSD3", 7 | "source-directories": [ 8 | "." 9 | ], 10 | "exposed-modules": [], 11 | "dependencies": { 12 | "direct": { 13 | "elm/core": "1.0.2", 14 | "elm/json": "1.1.3", 15 | "elm/http": "2.0.0", 16 | "elm/url": "1.0.0", 17 | "bartavelle/json-helpers": "2.0.2" 18 | }, 19 | "indirect": { 20 | "elm/bytes": "1.0.8", 21 | "elm/file": "1.0.5", 22 | "elm/time": "1.0.0" 23 | } 24 | }, 25 | "test-dependencies": { 26 | "direct": {}, 27 | "indirect": {} 28 | }, 29 | "elm-version": "0.19.0" 30 | } 31 | -------------------------------------------------------------------------------- /test/elm-sources/getBooksByIdSource.elm: -------------------------------------------------------------------------------- 1 | module GetBooksByIdSource exposing (..) 2 | 3 | import Http 4 | import Url.Builder 5 | import Json.Decode 6 | 7 | type Book = Book 8 | jsonDecBook : Json.Decode.Decoder Book 9 | jsonDecBook = Debug.todo "" 10 | 11 | getBooksById : Int -> (Result Http.Error (Book) -> msg) -> Cmd msg 12 | getBooksById capture_id toMsg = 13 | let 14 | params = 15 | List.filterMap identity 16 | (List.concat 17 | []) 18 | in 19 | Http.request 20 | { method = 21 | "GET" 22 | , headers = 23 | [] 24 | , url = 25 | Url.Builder.crossOrigin "" 26 | [ "books" 27 | , Url.percentEncode (capture_id 28 | |> String.fromInt) 29 | ] 30 | params 31 | , body = 32 | Http.emptyBody 33 | , expect = 34 | Http.expectJson toMsg jsonDecBook 35 | , timeout = 36 | Nothing 37 | , tracker = 38 | Nothing 39 | } 40 | -------------------------------------------------------------------------------- /test/elm-sources/getBooksByTitleSource.elm: -------------------------------------------------------------------------------- 1 | module GetBooksByTitleSource exposing (..) 2 | 3 | import Http 4 | import Url.Builder 5 | import Json.Decode as J 6 | 7 | type alias Book = {} 8 | jsonDecBook = J.succeed {} 9 | 10 | getBooksByTitlespace : String -> (Result Http.Error (Book) -> msg) -> Cmd msg 11 | getBooksByTitlespace capture_title_space toMsg = 12 | let 13 | params = 14 | List.filterMap identity 15 | (List.concat 16 | []) 17 | in 18 | Http.request 19 | { method = 20 | "GET" 21 | , headers = 22 | [] 23 | , url = 24 | Url.Builder.crossOrigin "" 25 | [ "books" 26 | , Url.percentEncode (capture_title_space) 27 | ] 28 | params 29 | , body = 30 | Http.emptyBody 31 | , expect = 32 | Http.expectJson toMsg jsonDecBook 33 | , timeout = 34 | Nothing 35 | , tracker = 36 | Nothing 37 | } 38 | -------------------------------------------------------------------------------- /test/elm-sources/getBooksSource.elm: -------------------------------------------------------------------------------- 1 | module GetBooksSource exposing (..) 2 | 3 | import Http 4 | import Json.Decode exposing (..) 5 | import Url.Builder 6 | import Json.Decode as J 7 | 8 | type alias Book = {} 9 | 10 | jsonDecBook = J.succeed {} 11 | 12 | getBooks : Bool -> (Maybe String) -> (Maybe Int) -> String -> (List (Maybe Bool)) -> (Result Http.Error ((List Book)) -> msg) -> Cmd msg 13 | getBooks query_published query_sort query_year query_category query_filters toMsg = 14 | let 15 | params = 16 | List.filterMap identity 17 | (List.concat 18 | [ [ if query_published then 19 | Just (Url.Builder.string "published" "") 20 | else 21 | Nothing ] 22 | , [ query_sort 23 | |> Maybe.map (Url.Builder.string "sort") ] 24 | , [ query_year 25 | |> Maybe.map (String.fromInt 26 | >> Url.Builder.string "year") ] 27 | , [ Just query_category 28 | |> Maybe.map (Url.Builder.string "category") ] 29 | , query_filters 30 | |> List.map ((Maybe.map (\value -> if value then "true" else "false") >> Maybe.withDefault "") 31 | >> Url.Builder.string "filters[]" 32 | >> Just) 33 | ]) 34 | in 35 | Http.request 36 | { method = 37 | "GET" 38 | , headers = 39 | [] 40 | , url = 41 | Url.Builder.crossOrigin "" 42 | [ "books" 43 | ] 44 | params 45 | , body = 46 | Http.emptyBody 47 | , expect = 48 | Http.expectJson toMsg (Json.Decode.list (jsonDecBook)) 49 | , timeout = 50 | Nothing 51 | , tracker = 52 | Nothing 53 | } 54 | -------------------------------------------------------------------------------- /test/elm-sources/getNothingSource.elm: -------------------------------------------------------------------------------- 1 | module GetNothingSource exposing (..) 2 | 3 | import Http 4 | import Url.Builder 5 | 6 | 7 | getNothing : (Result Http.Error (()) -> msg) -> Cmd msg 8 | getNothing toMsg = 9 | let 10 | params = 11 | List.filterMap identity 12 | (List.concat 13 | []) 14 | in 15 | Http.request 16 | { method = 17 | "GET" 18 | , headers = 19 | [] 20 | , url = 21 | Url.Builder.crossOrigin "" 22 | [ "nothing" 23 | ] 24 | params 25 | , body = 26 | Http.emptyBody 27 | , expect = 28 | Http.expectString 29 | (\x -> case x of 30 | Err e -> toMsg (Err e) 31 | Ok _ -> toMsg (Ok ())) 32 | , timeout = 33 | Nothing 34 | , tracker = 35 | Nothing 36 | } 37 | -------------------------------------------------------------------------------- /test/elm-sources/getOneSource.elm: -------------------------------------------------------------------------------- 1 | module GetOneSource exposing (..) 2 | 3 | import Http 4 | import Json.Decode exposing (..) 5 | import Url.Builder 6 | 7 | 8 | getOne : (Result Http.Error (Int) -> msg) -> Cmd msg 9 | getOne toMsg = 10 | let 11 | params = 12 | List.filterMap identity 13 | (List.concat 14 | []) 15 | in 16 | Http.request 17 | { method = 18 | "GET" 19 | , headers = 20 | [] 21 | , url = 22 | Url.Builder.crossOrigin "" 23 | [ "one" 24 | ] 25 | params 26 | , body = 27 | Http.emptyBody 28 | , expect = 29 | Http.expectJson toMsg Json.Decode.int 30 | , timeout = 31 | Nothing 32 | , tracker = 33 | Nothing 34 | } 35 | -------------------------------------------------------------------------------- /test/elm-sources/getOneWithDynamicUrlSource.elm: -------------------------------------------------------------------------------- 1 | module GetOneWithDynamicUrlSource exposing (..) 2 | 3 | import Http 4 | import Url.Builder 5 | import Json.Decode exposing (..) 6 | 7 | 8 | getOne : String -> (Result Http.Error (Int) -> msg) -> Cmd msg 9 | getOne urlBase toMsg = 10 | let 11 | params = 12 | List.filterMap identity 13 | (List.concat 14 | []) 15 | in 16 | Http.request 17 | { method = 18 | "GET" 19 | , headers = 20 | [] 21 | , url = 22 | Url.Builder.crossOrigin urlBase 23 | [ "one" 24 | ] 25 | params 26 | , body = 27 | Http.emptyBody 28 | , expect = 29 | Http.expectJson toMsg Json.Decode.int 30 | , timeout = 31 | Nothing 32 | , tracker = 33 | Nothing 34 | } 35 | -------------------------------------------------------------------------------- /test/elm-sources/getPolymorphicData.elm: -------------------------------------------------------------------------------- 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 | } 44 | -------------------------------------------------------------------------------- /test/elm-sources/getWithaheaderSource.elm: -------------------------------------------------------------------------------- 1 | module GetWithAHeaderSource exposing (..) 2 | 3 | import Http 4 | import Url.Builder 5 | import Json.Decode exposing (..) 6 | 7 | 8 | getWithaheader : (Maybe String) -> (Maybe Int) -> String -> Int -> (Result Http.Error (String) -> msg) -> Cmd msg 9 | getWithaheader header_myStringHeader header_MyIntHeader header_MyRequiredStringHeader header_MyRequiredIntHeader toMsg = 10 | let 11 | params = 12 | List.filterMap identity 13 | (List.concat 14 | []) 15 | in 16 | Http.request 17 | { method = 18 | "GET" 19 | , headers = 20 | List.filterMap identity 21 | [ Maybe.map (Http.header "myStringHeader") header_myStringHeader 22 | , Maybe.map (Http.header "MyIntHeader" 23 | << String.fromInt) header_MyIntHeader 24 | , Maybe.map (Http.header "MyRequiredStringHeader") (Just header_MyRequiredStringHeader) 25 | , Maybe.map (Http.header "MyRequiredIntHeader" 26 | << String.fromInt) (Just header_MyRequiredIntHeader) 27 | ] 28 | , url = 29 | Url.Builder.crossOrigin "" 30 | [ "with-a-header" 31 | ] 32 | params 33 | , body = 34 | Http.emptyBody 35 | , expect = 36 | Http.expectJson toMsg Json.Decode.string 37 | , timeout = 38 | Nothing 39 | , tracker = 40 | Nothing 41 | } 42 | -------------------------------------------------------------------------------- /test/elm-sources/getWitharesponseheaderSource.elm: -------------------------------------------------------------------------------- 1 | module GetWithAResponseHeaderSource exposing (..) 2 | 3 | import Http 4 | import Url.Builder 5 | import Json.Decode exposing (..) 6 | 7 | 8 | getWitharesponseheader : (Result Http.Error (String) -> msg) -> Cmd msg 9 | getWitharesponseheader toMsg = 10 | let 11 | params = 12 | List.filterMap identity 13 | (List.concat 14 | []) 15 | in 16 | Http.request 17 | { method = 18 | "GET" 19 | , headers = 20 | [] 21 | , url = 22 | Url.Builder.crossOrigin "" 23 | [ "with-a-response-header" 24 | ] 25 | params 26 | , body = 27 | Http.emptyBody 28 | , expect = 29 | Http.expectJson toMsg Json.Decode.string 30 | , timeout = 31 | Nothing 32 | , tracker = 33 | Nothing 34 | } 35 | -------------------------------------------------------------------------------- /test/elm-sources/postBooksSource.elm: -------------------------------------------------------------------------------- 1 | module PostBooksSource exposing (..) 2 | 3 | import Http 4 | import Url.Builder 5 | import Json.Encode as Enc 6 | 7 | type alias Book = {} 8 | jsonEncBook = \b -> Enc.object [] 9 | 10 | postBooks : Book -> (Result Http.Error (()) -> msg) -> Cmd msg 11 | postBooks body toMsg = 12 | let 13 | params = 14 | List.filterMap identity 15 | (List.concat 16 | []) 17 | in 18 | Http.request 19 | { method = 20 | "POST" 21 | , headers = 22 | [] 23 | , url = 24 | Url.Builder.crossOrigin "" 25 | [ "books" 26 | ] 27 | params 28 | , body = 29 | Http.jsonBody (jsonEncBook body) 30 | , expect = 31 | Http.expectString 32 | (\x -> case x of 33 | Err e -> toMsg (Err e) 34 | Ok _ -> toMsg (Ok ())) 35 | , timeout = 36 | Nothing 37 | , tracker = 38 | Nothing 39 | } 40 | -------------------------------------------------------------------------------- /test/elm-sources/postTwoSource.elm: -------------------------------------------------------------------------------- 1 | module PostTwoSource exposing (..) 2 | 3 | import Http 4 | import Json.Decode exposing (..) 5 | import Json.Encode 6 | import Url.Builder 7 | 8 | 9 | postTwo : String -> (Result Http.Error ((Maybe Int)) -> msg) -> Cmd msg 10 | postTwo body toMsg = 11 | let 12 | params = 13 | List.filterMap identity 14 | (List.concat 15 | []) 16 | in 17 | Http.request 18 | { method = 19 | "POST" 20 | , headers = 21 | [] 22 | , url = 23 | Url.Builder.crossOrigin "" 24 | [ "two" 25 | ] 26 | params 27 | , body = 28 | Http.jsonBody (Json.Encode.string body) 29 | , expect = 30 | Http.expectJson toMsg (Json.Decode.maybe (Json.Decode.int)) 31 | , timeout = 32 | Nothing 33 | , tracker = 34 | Nothing 35 | } 36 | -------------------------------------------------------------------------------- /test/elm-sources/putNothingSource.elm: -------------------------------------------------------------------------------- 1 | module PutNothingSource exposing (..) 2 | 3 | import Http 4 | import Url.Builder 5 | 6 | 7 | putNothing : (Result Http.Error (()) -> msg) -> Cmd msg 8 | putNothing toMsg = 9 | let 10 | params = 11 | List.filterMap identity 12 | (List.concat 13 | []) 14 | in 15 | Http.request 16 | { method = 17 | "PUT" 18 | , headers = 19 | [] 20 | , url = 21 | Url.Builder.crossOrigin "" 22 | [ "nothing" 23 | ] 24 | params 25 | , body = 26 | Http.emptyBody 27 | , expect = 28 | Http.expectString 29 | (\x -> case x of 30 | Err e -> toMsg (Err e) 31 | Ok _ -> toMsg (Ok ())) 32 | , timeout = 33 | Nothing 34 | , tracker = 35 | Nothing 36 | } 37 | --------------------------------------------------------------------------------