master..6bd16ed · servant-reflex

git.iko.soy/servant-reflex

on 6bd16ed help sign in

.gitignore−2

since splitsnapshots

unifiedsplit

@@ -7,5 +7,3 @@ log

7*.stats

8out

9/.stack-work/

10−TAGS

11−dist-newstyle

.gitmodules+12

@@ -0,0 +1,12 @@

1+[submodule "deps/http-api-data"]

2+ path = deps/http-api-data

3+ url = https://github.com/fizruk/http-api-data

4+[submodule "deps/servant"]

5+ path = deps/servant

6+ url = https://github.com/haskell-servant/servant

7+[submodule "deps/servant-snap"]

8+ path = deps/servant-snap

9+ url = https://github.com/haskell-servant/servant-snap

10+[submodule "deps/reflex-platform"]

11+ path = deps/reflex-platform

12+ url = https://github.com/reflex-frp/reflex-platform

.travis.yml+56−12

@@ -1,17 +1,61 @@

1−language: nix

1+sudo: required

2−nix: 2.3.6

3−sudo: require

3+before_cache:

4+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log

5+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar

7+addons:

8+ apt:

9+ - phantomjs

10+

11+matrix:

12+ include:

13+ - env: CABALVER=1.24 GHCVER=7.10.3

14+ compiler: ": #GHC 7.10.3"

15+ addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.3], sources: [hvr-ghc]}}

16+ - env: CABALVER=1.24 GHCVER=8.0.1

17+ compiler: ": #GHC 8.0.1"

18+ addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}

19+

20+

5before_install:

22before_install:

6− - sudo cp -rT $TRAVIS_BUILD_DIR/nix /etc/nix

23+ - unset CC

24+ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH

25+ - git submodule update --init --recursive

8−before_script:

27+install:

9− - sudo systemctl restart nix-daemon.service

28+ - cabal --version

10− - git config --global user.email "travis-ci@example.com"

29+ - BENCH=${BENCH---enable-benchmarks}

11− - git config --global user.name "Travis-CI"

30+ - TEST=${TEST---enable-tests}

31+ - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"

32+ - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];

33+ then

34+ zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >

35+ $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;

36+ fi

37+ - travis_retry cabal update -v

38+ - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config

39+ - deps/reflex-platform/work-on ./overrides-ghc.nix ./testserver --command "cd testserver && cabal configure -fExample && cabal build"

40+ - deps/reflex-platform/work-on ghc ./testdriver --command "cd testdriver && cabal configure && cabal build"

41+ - cd testserver && dist/build/back/back -p 8000 &

42+ - sleep 3

43+ - phantomjs --webdriver=127.0.0.1:4444 &

44+ - sleep 3

13script:

46script:

14− - nix-build travis.nix -A build

47+ - git config --global user.email "travis-ci@example.com"

15− - nix-build travis.nix -A buildGhc

48+ - git config --global user.name "Travis-CI"

16− - nix-build travis.nix -A testserver

49+ - ./build.sh

17− - nix-build travis.nix -A testresults

50+ # - testdriver/dist/build/spec/spec

51+

52+cache:

53+ directories:

54+ - /nix

55+ - $HOME/.cabal/packages

56+ - $HOME/.cabal/store

57+

58+env:

59+ global:

60+ - ENCRYPTION_LABEL: "3c89d919c82e"

61+ - COMMIT_AUTHOR_EMAIL: "imalsogreg@gmail.com"

README.md+33−70

@@ -4,19 +4,14 @@

5## `servant-reflex` lets you share your `servant` APIs with the frontend

7−Keeping your frontend in sync with your API server can be difficult - when the

7+Keeping your frontend in sync with your API server can be difficult - when the API changes its input parameters or return type, XHR requests from the frontend will fail at runtime. If your API is defined by [servant](haskell-servant.readthedocs.io) combinators, you can use `servant-reflex` to share the API between the server and frontend.

8−API changes its input parameters or return type, XHR requests from the

9−frontend will fail at runtime. If your API is defined by

10−[servant](https://haskell-servant.readthedocs.io) combinators, you can use

11−`servant-reflex` to share the API between the server and frontend.

12−Syncronization between is checked at compile time, and rather than building XHR

8+Syncronization between is checked at compile time, and rather than building XHR requests by hand, API endpoints are available behind `reflex`'s FRP semantics.

13−requests by hand, API endpoints are available behind `reflex`'s FRP semantics.

16## Example

12## Example

18−We have a webservice API defined in a module where both the server (compiled

14+We have a webservice API defined in a module where both the server (compiled with ghc) and the frontend (compiled with ghcjs) can see it:

19−with ghc) and the frontend (compiled with ghcjs) can see it:

21```haskell

16```haskell

22type API = "getint" :> Get '[JSON] Int

17type API = "getint" :> Get '[JSON] Int

@@ -29,8 +24,7 @@ type API = "getint" :> Get '[JSON] Int

29 :<|> Raw

24 :<|> Raw

30```

25```

32−`servant-reflex` then computes client functions that can query the API through

27+`servant-reflex` then computes client functions that can query the API through an `XhrRequest`.

33−an `XhrRequest`.

35```haskell

29```haskell

@@ -43,16 +37,7 @@ an `XhrRequest`.

43 (constDyn (BasePath "/"))

37 (constDyn (BasePath "/"))

44```

38```

46−These client functions are computed from your API type. They manage

40+These client functions are computed from your API type. They manage serialization, `XhrRequest` generation, and deserialization for you. `a` parameters used in URL captures become `Dynamic t (Either Text a)` parameters in the client functions. `QueryFlag`, `QueryParams` and `QueryParam` API parameters map to `Dynamic t Bool`, `Dynamic t [a]` and `Dynamic t (QParam a)` respectively. These parameters to the client function are wrapped with failure possibility to allow you to indicate at any time whether input validation for that parameter has failed and no valid XHR request can be generated. The final parameter is a trigger event for the XHR request. The return value `Event t (ReqResult a)` contains responses from the API server.

47−serialization, `XhrRequest` generation, and deserialization for you. `a`

48−parameters used in URL captures become `Dynamic t (Either Text a)` parameters

49−in the client functions. `QueryFlag`, `QueryParams` and `QueryParam` API

50−parameters map to `Dynamic t Bool`, `Dynamic t [a]` and `Dynamic t (QParam a)`

51−respectively. These parameters to the client function are wrapped with failure

52−possibility to allow you to indicate at any time whether input validation for

53−that parameter has failed and no valid XHR request can be generated. The final

54−parameter is a trigger event for the XHR request. The return value

55−`Event t (ReqResult a)` contains responses from the API server.

57```haskell

42```haskell

58 -- No need to write these functions. servant-reflex creates them for you!

43 -- No need to write these functions. servant-reflex creates them for you!

@@ -77,13 +62,7 @@ parameter is a trigger event for the XHR request. The return value

77 -> m (Event t (ReqResult () Double))

62 -> m (Event t (ReqResult () Double))

78```

63```

80−`ReqResult tag a` is defined in

81−[`Servant.Common.Req`](https://github.com/imalsogreg/servant-reflex/blob/6d866e338edb9bf6fd8f8d5083ff0187b4d8c0d2/src/Servant/Common/Req.hs#L40-L42)

65+`ReqResult tag a` is defined in [`Servant.Common.Req`](https://github.com/imalsogreg/servant-reflex/blob/6d866e338edb9bf6fd8f8d5083ff0187b4d8c0d2/src/Servant/Common/Req.hs#L40-L42) and reports whether or not your request was sent (if validation fails, the request won't be sent), and how decoding of the response went. You can pattern match on these explicitly, but usually you'll want to use `fmapMaybe :: (a -> Maybe b) -> Event t a -> Event t b` and one of the elimination functions to filter the result type you care about, like this:

82−and reports whether or not your request was sent (if validation fails, the

83−request won't be sent), and how decoding of the response went. You can pattern

84−match on these explicitly, but usually you'll want to use

85−`fmapMaybe :: (a -> Maybe b) -> Event t a -> Event t b` and one of the

86−elimination functions to filter the result type you care about, like this:

88```haskell

67```haskell

89 -- ... continued ...

68 -- ... continued ...

@@ -101,8 +80,7 @@ elimination functions to filter the result type you care about, like this:

101 dynText =<< holdDyn "" (leftmost [errs, const "" <$> ys])

80 dynText =<< holdDyn "" (leftmost [errs, const "" <$> ys])

102```

81```

103

104−This example builds some input fields to enter API parameters, buttons to

83+This example builds some input fields to enter API parameters, buttons to trigger the API calls, and text elements to show the results:

105−trigger the API calls, and text elements to show the results:

106

107```haskell

85```haskell

108 elClass "div" "int-demo" $ do

86 elClass "div" "int-demo" $ do

@@ -125,53 +103,47 @@ trigger the API calls, and text elements to show the results:

125 display =<< holdDyn Nothing outputDouble

103 display =<< holdDyn Nothing outputDouble

126```

104```

127

105

128−For a great introduction to recative DOM building, see the

106+For a great introduction to recative DOM building, see the [README](https://github.com/reflex-frp/reflex-platform) for the `reflex-platform`. For more information about servant, see their [documentation](http://haskell-servant.readthedocs.io/en/stable/). Thanks to the respective authors of these fabulous libraries.

129−[README](https://github.com/reflex-frp/reflex-platform) for the

130−`reflex-platform`. For more information about servant, see their

131−[documentation](http://haskell-servant.readthedocs.io/en/stable/). Thanks to

132−the respective authors of these fabulous libraries.

133

107

134

108

135## Building the library and test server

109## Building the library and test server

136

110

137−This repository comes with a small example of an API shared between a

138−ghcjs-compiled frontend

139−([exec/](https://github.com/imalsogreg/servant-reflex/tree/master/exec)) and a

140−ghc-compiled backend

141−([testserver/](https://github.com/imalsogreg/servant-reflex/tree/master/testserver).

111+This repository comes with a small example of an API shared between a ghcjs-compiled frontend ([exec/](https://github.com/imalsogreg/servant-reflex/tree/master/exec)) and a ghc-compiled backend ([testserver/](https://github.com/imalsogreg/servant-reflex/tree/master/testserver). To build these components:

142−To build these components, we will use the nix packages for the testserver. It

112+

143−manages the frontend build as a dependency.

113+

114+First build the library:

144

115

145```

116```

146−nix build -f travis.nix testserver -o server

117+git submodule update --init --recursive

118+./build.sh

147```

119```

148

120

149−Point it at the static directory and run it:

121+Then build the test server:

122+

123+```

124+deps/reflex-platform/work-on ./overrides-ghc.nix ./testserver --command "cd testserver && cabal build"

125+```

126+

127+

128+## Running the example site

129+

130+The server must be run from the directory where static assets live:

150

131

151```

132```

152−STATIC_DIR=server/static server/back -p 8000

133+cd testserver

134+dist/build/back/back -p 8001

153```

135```

154

136

155−Browse to [http://localhost:8000](http://localhost:8000) and click around.

137+And simply browse to `localhost:8001`

156−Open the firefox or chrome developer tools and examine the XHR activity

157−under the Network tab.

158

138

159−**For a larger example of a project that shares types between backend and

139+**For a larger example of a project that shares types between backend and frontend, see [hsnippet](https://github.com/mightybyte/hsnippet).**

160−frontend, see [hsnippet](https://github.com/mightybyte/hsnippet).**

161

140

162

141

163## Tagging requests

142## Tagging requests

164

143

165−The input and the return type of a client function like `getDouble` are both

166−event streams. The individual input events and responses occur at different

144+The input and the return type of a client function like `getDouble` are both event streams. The individual input events and responses occur at different times and aren't automatically paired up, but you can recover the relationship by tagging the requests.

167−times and aren't automatically paired up, but you can recover the

168−relationship by tagging the requests.

169

145

170−So far we have used an `Event t ()` to trigger sending a request. If we choose

146+So far we have used an `Event t ()` to trigger sending a request. If we choose e.g. `Double` for the third `Proxy` argument to `client`, then `Event t Double` will be used to trigger requests, and each `ReqResult` will carry the tag of its request. Imagine we wanted to display not just the last "double" from `doubleIt`, but a whole table of valid inputs and their doubled responses:

171−e.g. `Double` for the third `Proxy` argument to `client`, then `Event t Double`

172−will be used to trigger requests, and each `ReqResult` will carry the tag of

173−its request. Imagine we wanted to display not just the last "double" from

174−`doubleIt`, but a whole table of valid inputs and their doubled responses:

175

147

176```haskell

148```haskell

177 ...

149 ...

@@ -201,10 +173,7 @@ its request. Imagine we wanted to display not just the last "double" from

201

173

202## Simultaneous requests

174## Simultaneous requests

203

175

204−`Servant.Reflex.Multi` provides an alternative client-generation function

176+`Servant.Reflex.Multi` provides an alternative client-generation function called `clientA` (client applicative). Choose a container type that has both `Applicative` and `Traversable` instances, and pass it to `clientA` through another `Proxy`. Our `sayHi` client function will then have this type:

205−called `clientA` (client applicative). Choose a container type that has both

206−`Applicative` and `Traversable` instances, and pass it to `clientA` through

207−another `Proxy`. Our `sayHi` client function will then have this type:

208

177

209```haskell

178```haskell

210sayHi

179sayHi

@@ -215,10 +184,4 @@ sayHi

215 -> m (Event t (f (ReqResult tag Text)))

184 -> m (Event t (f (ReqResult tag Text)))

216```

185```

217

186

218−The dynamic params are each wrapped in `f`. For every firing of the trigger

187+The dynamic params are each wrapped in `f`. For every firing of the trigger event `tag`, all of these parameters will be combined according to `f`'s `Applicative` instance (when `f` is `[]`, you will get all combinations of all parameters taken together as a request; when `f` is `ZipList`, the Nth elemens of each parameters list will be taken together as a request). Using this interface, you can trigger many XHR's from a single event occurence, and expect the responses to be structured the same way as the requests.

219−event `tag`, all of these parameters will be combined according to `f`'s

220−`Applicative` instance (when `f` is `[]`, you will get all combinations of

221−all parameters taken together as a request; when `f` is `ZipList`, the Nth

222−elemens of each parameters list will be taken together as a request). Using

223−this interface, you can trigger many XHR's from a single event occurence, and

224−expect the responses to be structured the same way as the requests.

build.shnew file+3

@@ -0,0 +1,3 @@

1+#!/usr/bin/env bash

3+deps/reflex-platform/work-on ./overrides.nix ./. --run "cabal configure --ghcjs -f Example && cabal build && exec/toSite.sh"

ChangeLog.md → changelog.mdrenamed+1−14

@@ -1,20 +1,7 @@

1−0.3.5

2−-----

3−

4− - Require reflex-dom-core >= 0.6 (for internal handling of case-insensitive headers)

5− - Require servant >= 0.16

6− - Eliminate use of deprecated widgets from reflex-dom-core

7− - Bump the version of reflex-platform used in nix-shell and test suite

8−

9−0.3.4

10−-----

11−

12−Add selenium-based test suite

13−

140.3.3

10.3.3

15-----

2-----

17−- Fix encoding issue: Explicitly escape reserved characters from path pieces and query parameters

4+Explicitly escape reserved characters from path pieces and query parameters

200.3.2

70.3.2

default.nixdeleted−21

@@ -1,21 +0,0 @@

1−{ mkDerivation, base, bytestring, case-insensitive, containers

2−, data-default, exceptions, ghcjs-dom, http-api-data, http-media

3−, jsaddle, mtl, network-uri, reflex, reflex-dom, reflex-dom-core

4−, safe, servant, servant-auth, stdenv, string-conversions, text

5−, transformers

6−}:

7−mkDerivation {

8− pname = "servant-reflex";

9− version = "0.3.6";

10− src = ./.;

11− isLibrary = true;

12− isExecutable = true;

13− libraryHaskellDepends = [

14− base bytestring case-insensitive containers data-default exceptions

15− ghcjs-dom http-api-data http-media jsaddle mtl network-uri reflex

16− reflex-dom reflex-dom-core safe servant servant-auth string-conversions

17− text transformers

18− ];

19− description = "servant API generator for reflex apps";

20− license = stdenv.lib.licenses.bsd3;

21−}

deps/http-api-datanew file+1

Submodule changed.

deps/reflex-platformnew file+1

Submodule changed.

deps/servantnew file+1

Submodule changed.

deps/servant-snapnew file+1

Submodule changed.

exec/Example.hs+2−2

@@ -21,8 +21,7 @@ import Servant.API

21import API

22import Data.Proxy

23import Text.Read (readMaybe)

24−import Reflex.Dom.Core hiding (run, mainWidget)

24+import Reflex.Dom hiding (run)

25−import Reflex.Dom (mainWidget)

26------------------------------------------------------------------------------

25------------------------------------------------------------------------------

27import Servant.Reflex

26import Servant.Reflex

28import Servant.Reflex.Multi

27import Servant.Reflex.Multi

@@ -98,6 +97,7 @@ run = mdo

99 -- Name the computed API client functions

98 -- Name the computed API client functions

100 let tweakRequest = ClientOptions $ \r -> do

99 let tweakRequest = ClientOptions $ \r -> do

100+ putStrLn ("Got req: " ++ show r)

101 return $ r & withCredentials .~ True

102 let (getUnit :<|> getInt :<|> sayhi :<|> dbl

103 :<|> multi :<|> qna :<|> secret :<|> doRaw) =

nix/nix.confdeleted−3

@@ -1,3 +0,0 @@

1−substituters = https://cache.nixos.org/ https://nixcache.reflex-frp.org/

2−trusted-public-keys = cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY= ryantrinkle.com-1:JJiAKaRv9mWgpVAz8dwewnZe0AzzEAzPkagE9SP5NWI=

3−trusted-users = travis

nix/reflex-platform.nixdeleted−7

@@ -1,7 +0,0 @@

1−let

2− rev = "1aba6f367982bd6dd78ec2fda75ab246a62d32c5" ;

3−in import (builtins.fetchTarball

4− {

5− url = "https://github.com/reflex-frp/reflex-platform/archive/${rev}.tar.gz";

6− sha256 = "137vg6i8yy4lp6rz4wbvvhfcc9d9qf7j1b3fnng3r7sj63k7j664" ;

7− }) {}

nix/servant-snap.nixdeleted−7

@@ -1,7 +0,0 @@

1−# Servant-snap is marked broken in nixpkgs

2−{ nixpkgs ? import <nixpkgs> {}}: self: super:

3−self.callCabal2nix "servant-snap" (nixpkgs.fetchgit {

4− url = "https://github.com/haskell-servant/servant-snap.git";

5− rev = "af5172a6de5bb2a07eb1bf4c85952075ec6ecdf3";

6− sha256 = "sha256-fzzQGwG8Ko72OO/kwLMG52eNZSt3F2dxhNgM9gaO4yQ=";

7−}) {}

nix/testresults.nixdeleted−17

@@ -1,17 +0,0 @@

1−{ curl, reflexPlatform, testdriver, testserver, phantomjs }:

2−

3−reflexPlatform.nixpkgs.pkgs.runCommand "runWebdriveTest.sh" {} ''

4− echo About to phantom

5− ${phantomjs}/bin/phantomjs --webdriver=127.0.0.1:4444 &

6− sleep 3

7− echo About to Server

8− STATIC_DIR=${testserver}/static ${testserver}/back -q --no-access-log --no-error-log -p 8000 &

9− sleep 3

10− ${curl}/bin/curl localhost:8000

11− ${curl}/bin/curl localhost:8000/runmain.js

12− echo About to testdrive

13− ${testdriver}/bin/spec > $out 2>&1

14− echo Done

15− trap "exit" INT TERM

16− trap "kill 0" EXIT

17− ''

nix/testserver.nixdeleted−9

@@ -1,9 +0,0 @@

1−servant-reflex: self: super:

2−

3−(self.callCabal2nix "testserver" ../testserver {}).overrideDerivation (drv: {

4− postInstall = ''

5− cp dist/build/back/back $out/back

6− mkdir $out/static

7− cp ${servant-reflex}/bin/example.jsexe/* $out/static/

8− '';

9−})

overrides-ghc.nixnew file+11

@@ -0,0 +1,11 @@

1+{ reflex-platform, ... }:

2+let

3+ c2n = reflex-platform.cabal2nixResult;

4+ dc = reflex-platform.lib.dontCheck;

5+in reflex-platform.ghc.override {

6+ overrides = self: super: {

7+ servant-snap = dc (self.callPackage (c2n deps/servant-snap) {});

8+ heist = dc (self.callPackage (c2n deps/servant-snap/deps/snap/deps/heist) {});

9+ xmlhtml = dc (self.callPackage (c2n deps/servant-snap/deps/snap/deps/xmlhtml) {});

10+ };

11+}

overrides.nixnew file+9

@@ -0,0 +1,9 @@

1+{ reflex-platform, ... }:

2+let

3+ dc = reflex-platform.lib.dontCheck;

4+ c2n = reflex-platform.cabal2nixResult;

5+in

6+reflex-platform.ghcjs.override {

7+ overrides = self: super: {

8+ };

9+}

servant-reflex.cabal+19−24

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

1Name: servant-reflex

2−Version: 0.3.6

2+Version: 0.3.3

3−Synopsis: servant API generator for reflex apps

3+Synopsis: Servant reflex API generator

4−Description: Generate reflex-compatible client functions from servant API descriptions

4+Description: Servant reflex API generator

5License: BSD3

6License-file: LICENSE.md

7Author: Greg Hale, Doug Beardsley

@@ -17,35 +17,39 @@ Flag Example

18library

19 exposed-modules:

20− Servant.Common.BaseUrl

21− Servant.Common.Req

22 Servant.Reflex

20 Servant.Reflex

23 Servant.Reflex.Multi

21 Servant.Reflex.Multi

23+ other-modules:

24+ Servant.Common.BaseUrl

25+ Servant.Common.Req

26+

25 hs-source-dirs: src

27 hs-source-dirs: src

26 build-depends:

28 build-depends:

27− base >= 4.8 && < 5,

29+ base >= 4.8 && < 4.10,

30+ aeson >= 0.11 && < 1.3,

28 bytestring >= 0.10 && < 0.11,

31 bytestring >= 0.10 && < 0.11,

29 case-insensitive >= 1.2.0.4 && < 1.3,

32 case-insensitive >= 1.2.0.4 && < 1.3,

30− containers >= 0.5.6 && < 0.7,

33+ containers >= 0.5.6 && < 0.6,

31 data-default >= 0.5 && < 0.8,

34 data-default >= 0.5 && < 0.8,

32− exceptions >= 0.8 && < 0.11,

35+ exceptions >= 0.8 && < 0.9,

33 ghcjs-dom >= 0.2 && < 0.10,

36 ghcjs-dom >= 0.2 && < 0.10,

34− http-api-data >= 0.3.6 && < 0.5,

37+ http-api-data >= 0.3.6 && < 0.4,

35− http-media >= 0.6 && < 0.9,

38+ http-media >= 0.6 && < 0.7,

36 jsaddle >= 0.8 && < 0.10,

39 jsaddle >= 0.8 && < 0.10,

37 mtl >= 2.2.1 && < 2.3,

40 mtl >= 2.2.1 && < 2.3,

38 network-uri >= 2.6 && < 2.7,

41 network-uri >= 2.6 && < 2.7,

39− reflex >= 0.5 && < 0.9,

42+ reflex >= 0.5 && < 0.6,

40− reflex-dom-core >= 0.6 && < 0.7,

43+ reflex-dom-core == 0.4 && < 0.5,

41 safe >= 0.3.9 && < 0.4,

44 safe >= 0.3.9 && < 0.4,

42− servant >= 0.16 && < 0.18,

45+ servant >= 0.13 && < 0.14,

46+ servant-checked-exceptions >= 1.1.0.0 && < 1.2,

43 servant-auth >= 0.2.1 && < 0.4,

47 servant-auth >= 0.2.1 && < 0.4,

44 string-conversions >= 0.4 && < 0.5,

48 string-conversions >= 0.4 && < 0.5,

45 text >= 1.2 && < 1.3,

49 text >= 1.2 && < 1.3,

46 transformers >= 0.4 && < 0.6

50 transformers >= 0.4 && < 0.6

48− ghc-options: -Wall -fwarn-tabs -funbox-strict-fields

52+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2

50 default-language: Haskell2010

54 default-language: Haskell2010

@@ -54,16 +58,7 @@ executable example

54 buildable: True

58 buildable: True

55 else

59 else

56 buildable: False

60 buildable: False

57− build-depends:

61+ build-depends: aeson, reflex, servant-reflex, base, scientific, servant, reflex-dom, text

58− aeson,

59− reflex,

60− servant-reflex,

61− base,

62− scientific,

63− servant,

64− reflex-dom,

65− reflex-dom-core,

66− text

67 default-language: Haskell2010

62 default-language: Haskell2010

68 main-is: Example.hs

63 main-is: Example.hs

69 other-modules: API

64 other-modules: API

shell.nixdeleted−1

@@ -1 +0,0 @@

1−(import ./travis.nix {nativeCompiler = "ghc";}).ghcPkgs.servant-reflex.env

src/Servant/Common/BaseUrl.hs+5−4

@@ -85,14 +85,15 @@ baseUrlWidget = elClass "div" "base-url" $ do

85 where pathWidget :: m (Dynamic t BaseUrl)

86 pathWidget = do

87 text "Url base path"

88− t <- inputElement def

88+ t <- textInput (def {_textInputConfig_attributes =

89+ constDyn ("placeholder" =: "/a/b")})

89 return $ BasePath <$> value t

90 return $ BasePath <$> value t

90 fullUrlWidget :: m (Dynamic t BaseUrl)

91 fullUrlWidget :: m (Dynamic t BaseUrl)

91 fullUrlWidget = do

92 fullUrlWidget = do

92 schm <- dropdown Https (constDyn $ Https =: "https" <> Http =: "http") def

93 schm <- dropdown Https (constDyn $ Https =: "https" <> Http =: "http") def

93− srv <- inputElement def

94+ srv <- textInput def {_textInputConfig_attributes = constDyn $ "placeholder" =: "example.com"}

94 text ":"

95 text ":"

95− prt <- inputElement def

96+ prt <- textInput def { _textInputConfig_attributes = constDyn $ "placeholder" =: "80"}

96 port :: Dynamic t Int <- holdDyn 80 (fmapMaybe (readMaybe . T.unpack) $ updated (value prt))

97 port :: Dynamic t Int <- holdDyn 80 (fmapMaybe (readMaybe . T.unpack) $ updated (value prt))

97− path <- inputElement def

98+ path <- textInput def { _textInputConfig_attributes = constDyn $ "placeholder" =: "a/b" }

98 return $ BaseFullUrl <$> value schm <*> value srv <*> port <*> value path

99 return $ BaseFullUrl <$> value schm <*> value srv <*> port <*> value path

src/Servant/Common/Req.hs+68−44

@@ -8,18 +8,21 @@

8{-# LANGUAGE ScopedTypeVariables #-}

9{-# LANGUAGE TupleSections #-}

11+{-# LANGUAGE MultiParamTypeClasses #-}

12+{-# LANGUAGE FlexibleInstances #-}

11module Servant.Common.Req where

13module Servant.Common.Req where

13-------------------------------------------------------------------------------

15-------------------------------------------------------------------------------

14import Control.Applicative (liftA2, liftA3)

16import Control.Applicative (liftA2, liftA3)

15−import Control.Arrow ((&&&))

16import Control.Concurrent

17import Control.Concurrent

17import Control.Monad (join)

18import Control.Monad (join)

18import Control.Monad.IO.Class (MonadIO, liftIO)

19import Control.Monad.IO.Class (MonadIO, liftIO)

20+import Data.Aeson

19import Data.Bifunctor (first)

21import Data.Bifunctor (first)

20−import qualified Data.ByteString.Builder as Builder

22+import qualified Data.ByteString.Builder as BB

23+import qualified Data.ByteString as BS

24+import Data.ByteString.Lazy (ByteString)

21import qualified Data.ByteString.Lazy.Char8 as BL

25import qualified Data.ByteString.Lazy.Char8 as BL

22−import Data.ByteString (ByteString)

23import qualified Data.Map as Map

26import qualified Data.Map as Map

24import Data.Maybe (catMaybes, fromMaybe)

27import Data.Maybe (catMaybes, fromMaybe)

25import Data.Functor.Compose

28import Data.Functor.Compose

@@ -27,17 +30,24 @@ import Data.Monoid ((<>))

27import Data.Proxy (Proxy(..))

30import Data.Proxy (Proxy(..))

28import Data.Text (Text)

31import Data.Text (Text)

29import qualified Data.Text as T

32import qualified Data.Text as T

30−import qualified Data.Text.Encoding as TE

33+import qualified Data.Text.Lazy as TL

34+import qualified Data.Text.Encoding as T

31import Data.Traversable (forM)

35import Data.Traversable (forM)

32import Language.Javascript.JSaddle.Monad (JSM, MonadJSM, liftJSM)

36import Language.Javascript.JSaddle.Monad (JSM, MonadJSM, liftJSM)

37+import qualified Language.Javascript.JSaddle as JS

38+import qualified Data.JSString.Text as JS (lazyTextFromJSString)

33import qualified Network.URI as N

39import qualified Network.URI as N

34import Reflex.Dom.Core hiding (tag)

40import Reflex.Dom.Core hiding (tag)

35import Servant.Common.BaseUrl (BaseUrl, showBaseUrl,

41import Servant.Common.BaseUrl (BaseUrl, showBaseUrl,

36 SupportsServantReflex)

42 SupportsServantReflex)

37−import Servant.API.ContentTypes (MimeUnrender(..), NoContent(..))

43+import Servant.API.ContentTypes ( NoContent(..), Accept, JSON

44+ , OctetStream, PlainText

45+ , FormUrlEncoded)

38import Web.HttpApiData (ToHttpApiData(..))

46import Web.HttpApiData (ToHttpApiData(..))

47+import Web.FormUrlEncoded (FromForm, urlDecodeAsForm)

39-------------------------------------------------------------------------------

48-------------------------------------------------------------------------------

40import Servant.API.BasicAuth

49import Servant.API.BasicAuth

50+-------------------------------------------------------------------------------

43------------------------------------------------------------------------------

53------------------------------------------------------------------------------

@@ -93,13 +103,6 @@ reqFailure (ResponseFailure _ s _) = Just s

93reqFailure (RequestFailure _ s) = Just s

103reqFailure (RequestFailure _ s) = Just s

94reqFailure _ = Nothing

104reqFailure _ = Nothing

105

96−------------------------------------------------------------------------------

97−-- | Simple filter/accessor like 'reqFailure', but keeping the request tag

98−reqFailure' :: ReqResult tag a -> Maybe (tag,Text)

99−reqFailure' (ResponseFailure tag s _) = Just (tag,s)

100−reqFailure' (RequestFailure tag s) = Just (tag,s)

101−reqFailure' _ = Nothing

102−

103

106

104------------------------------------------------------------------------------

107------------------------------------------------------------------------------

105-- | Simple filter/accessor for the raw XHR response

108-- | Simple filter/accessor for the raw XHR response

@@ -159,7 +162,7 @@ prependToPathParts p req =

159 req { reqPathParts = p : reqPathParts req }

162 req { reqPathParts = p : reqPathParts req }

160

163

161addHeader :: (ToHttpApiData a, Reflex t) => Text -> Dynamic t (Either Text a) -> Req t -> Req t

164addHeader :: (ToHttpApiData a, Reflex t) => Text -> Dynamic t (Either Text a) -> Req t -> Req t

162−addHeader name val req = req { headers = (name, (fmap . fmap) (TE.decodeUtf8 . toHeader) val) : headers req }

165+addHeader name val req = req { headers = (name, (fmap . fmap) (T.decodeUtf8 . toHeader) val) : headers req }

163

166

164

167

165reqToReflexRequest

168reqToReflexRequest

@@ -232,7 +235,7 @@ reqToReflexRequest reqMeth reqHost req =

232 Map.insert "Content-Type" bCT (Map.fromList hs)

235 Map.insert "Content-Type" bCT (Map.fromList hs)

233 , _xhrRequestConfig_user = Nothing

236 , _xhrRequestConfig_user = Nothing

234 , _xhrRequestConfig_password = Nothing

237 , _xhrRequestConfig_password = Nothing

235− , _xhrRequestConfig_responseType = Just XhrResponseType_ArrayBuffer

238+ , _xhrRequestConfig_responseType = Nothing

236 , _xhrRequestConfig_withCredentials = False

239 , _xhrRequestConfig_withCredentials = False

237 , _xhrRequestConfig_responseHeaders = def

240 , _xhrRequestConfig_responseHeaders = def

238 }

241 }

@@ -244,8 +247,8 @@ reqToReflexRequest reqMeth reqHost req =

244 Right hs -> Right $ def { _xhrRequestConfig_headers = Map.fromList hs

247 Right hs -> Right $ def { _xhrRequestConfig_headers = Map.fromList hs

245 , _xhrRequestConfig_user = Nothing

248 , _xhrRequestConfig_user = Nothing

246 , _xhrRequestConfig_password = Nothing

249 , _xhrRequestConfig_password = Nothing

247− , _xhrRequestConfig_responseType = Just XhrResponseType_ArrayBuffer

250+ , _xhrRequestConfig_responseType = Nothing

248− , _xhrRequestConfig_sendData = mempty

251+ , _xhrRequestConfig_sendData = ""

249 , _xhrRequestConfig_withCredentials = False

252 , _xhrRequestConfig_withCredentials = False

250 }

253 }

251 Just rBody -> liftA2 mkConfigBody xhrHeaders rBody

254 Just rBody -> liftA2 mkConfigBody xhrHeaders rBody

@@ -254,8 +257,8 @@ reqToReflexRequest reqMeth reqHost req =

254 mkAuth _ (Left e) = Left e

257 mkAuth _ (Left e) = Left e

255 mkAuth Nothing r = r

258 mkAuth Nothing r = r

256 mkAuth (Just (BasicAuthData u p)) (Right config) = Right $ config

259 mkAuth (Just (BasicAuthData u p)) (Right config) = Right $ config

257− { _xhrRequestConfig_user = Just $ TE.decodeUtf8 u

260+ { _xhrRequestConfig_user = Just $ T.decodeUtf8 u

258− , _xhrRequestConfig_password = Just $ TE.decodeUtf8 p}

261+ , _xhrRequestConfig_password = Just $ T.decodeUtf8 p}

259

262

260 addAuth :: Dynamic t (Either Text (XhrRequestConfig x))

263 addAuth :: Dynamic t (Either Text (XhrRequestConfig x))

261 -> Dynamic t (Either Text (XhrRequestConfig x))

264 -> Dynamic t (Either Text (XhrRequestConfig x))

@@ -335,10 +338,9 @@ performSomeRequestsAsync' opts newXhr req = performEventAsync $ ffor req $ \hrs

335 return ()

338 return ()

336

339

337

340

338−

339−type XhrPayload = ByteString

341+type XhrPayload = T.Text

340bytesToPayload :: BL.ByteString -> XhrPayload

342bytesToPayload :: BL.ByteString -> XhrPayload

341−bytesToPayload = BL.toStrict

343+bytesToPayload = T.decodeUtf8 . BL.toStrict

342

344

343

345

344performRequestsCT

346performRequestsCT

@@ -353,15 +355,14 @@ performRequestsCT

353 -> m (Event t (f (ReqResult tag a)))

355 -> m (Event t (f (ReqResult tag a)))

354performRequestsCT ct reqMeth reqs reqHost opts trigger = do

356performRequestsCT ct reqMeth reqs reqHost opts trigger = do

355 resps <- performRequests reqMeth reqs reqHost opts trigger

357 resps <- performRequests reqMeth reqs reqHost opts trigger

356− let decodeResp (Just (XhrResponseBody_ArrayBuffer x)) =

357− first T.pack .

358+ let decodeResp x = first T.pack

358− mimeUnrender ct $

359+ . mimeUnrender ct

359− BL.fromStrict x

360+ . JS.textToJSString

360− decodeResp _ = Left "No body"

361+ =<< note "No body text" (_xhrResponse_responseText x)

361 return $ fmap

362 return $ fmap

362 (\(t,rs) -> ffor rs $ \r -> case r of

363 (\(t,rs) -> ffor rs $ \r -> case r of

363 Left e -> RequestFailure t e

364 Left e -> RequestFailure t e

364− Right g -> evalResponse (decodeResp . _xhrResponse_response) (t,g)

365+ Right g -> evalResponse decodeResp (t,g)

365 )

366 )

366 resps

367 resps

367

368

@@ -388,7 +389,7 @@ evalResponse

388 :: (XhrResponse -> Either Text a)

389 :: (XhrResponse -> Either Text a)

389 -> (tag, XhrResponse)

390 -> (tag, XhrResponse)

390 -> ReqResult tag a

391 -> ReqResult tag a

391−evalResponse decode (tag, xhr) =

392+evalResponse decodeRes (tag, xhr) =

392 let status = _xhrResponse_status xhr

393 let status = _xhrResponse_status xhr

393 okStatus = status >= 200 && status < 400

394 okStatus = status >= 200 && status < 400

394 errMsg = fromMaybe

395 errMsg = fromMaybe

@@ -399,33 +400,56 @@ evalResponse decode (tag, xhr) =

399 then either

400 then either

400 (\e -> ResponseFailure tag e xhr)

401 (\e -> ResponseFailure tag e xhr)

401 (\v -> ResponseSuccess tag v xhr)

402 (\v -> ResponseSuccess tag v xhr)

402− (decode xhr)

403+ (decodeRes xhr)

403 else ResponseFailure tag errMsg xhr

404 else ResponseFailure tag errMsg xhr

404 in respPayld

405 in respPayld

405

406

406−------------------------------------------------------------------------------

407−-- | Utility for simultaneously accessing/filtering Success and Failure

408−-- response 'Event's,

409−fanReqResult :: Reflex t => Event t (ReqResult tag a) -> (Event t Text, Event t a)

410−fanReqResult = fmapMaybe reqFailure &&& fmapMaybe reqSuccess

411

407

412−------------------------------------------------------------------------------

408+-- | Similar to 'Servant.API.ContentType.MimeUnrender' but with the differnce that

413−-- | Utility for simultaneously accessing/filtering Success and Failure

409+-- the second argument expects a JSString instead of ByteString.

414−-- response 'Event's, but keeping the request tag

410+-- This can lead to better performance ghcjs.

415−fanReqResult' :: Reflex t => Event t (ReqResult tag a) -> (Event t (tag, Text), Event t (tag, a))

411+class Accept contentType => MimeUnrender contentType a where

416−fanReqResult' = fmapMaybe reqFailure' &&& fmapMaybe reqSuccess'

412+ mimeUnrender :: Proxy contentType -> JS.JSString -> Either String a

413+

414+instance FromJSON a => MimeUnrender JSON a where

415+ mimeUnrender _ = note "Failed to decode response" . jsonDecode

417

416

417+-- | @urlDecodeAsForm@

418+-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only

419+-- holds if every element of x is non-null (i.e., not @("", "")@)

420+instance FromForm a => MimeUnrender FormUrlEncoded a where

421+ mimeUnrender _ = first T.unpack . urlDecodeAsForm . BB.toLazyByteString . T.encodeUtf8Builder . JS.textFromJSString

422+

423+-- | @left show . TextL.decodeUtf8'@

424+instance MimeUnrender PlainText TL.Text where

425+ mimeUnrender _ = pure . JS.lazyTextFromJSString

426+

427+-- | @left show . TextS.decodeUtf8' . toStrict@

428+instance MimeUnrender PlainText T.Text where

429+ mimeUnrender _ = pure . JS.textFromJSString

430+

431+-- | @Right . BC.unpack@

432+instance MimeUnrender PlainText String where

433+ mimeUnrender _ = Right . T.unpack . JS.textFromJSString

434+

435+-- | @Right . id@

436+instance MimeUnrender OctetStream ByteString where

437+ mimeUnrender _ = pure . BB.toLazyByteString . T.encodeUtf8Builder . JS.textFromJSString

438+

439+-- | @Right . toStrict@

440+instance MimeUnrender OctetStream BS.ByteString where

441+ mimeUnrender _ = pure . T.encodeUtf8 . JS.textFromJSString

418

442

419note :: e -> Maybe a -> Either e a

443note :: e -> Maybe a -> Either e a

420−note e = maybe (Left e) Right

444+note e Nothing = Left e

445+note _ (Just a) = Right a

421

446

422fmapL :: (e -> e') -> Either e a -> Either e' a

447fmapL :: (e -> e') -> Either e a -> Either e' a

423fmapL _ (Right a) = Right a

448fmapL _ (Right a) = Right a

424fmapL f (Left e) = Left (f e)

449fmapL f (Left e) = Left (f e)

425

450

426−builderToText :: Builder.Builder -> T.Text

451+builderToText :: BB.Builder -> T.Text

427−builderToText = TE.decodeUtf8 . BL.toStrict . Builder.toLazyByteString

452+builderToText = T.decodeUtf8 . BL.toStrict . BB.toLazyByteString

428

453

429escape :: T.Text -> T.Text

454escape :: T.Text -> T.Text

430−escape = T.pack . N.escapeURIString (not . N.isReserved) . T.unpack . TE.decodeUtf8 . BL.toStrict . Builder.toLazyByteString . toEncodedUrlPiece

455+escape = T.pack . N.escapeURIString (not . N.isReserved) . T.unpack . T.decodeUtf8 . BL.toStrict . BB.toLazyByteString . toEncodedUrlPiece

431−

src/Servant/Reflex.hs+207−124

@@ -8,7 +8,6 @@

8{-# LANGUAGE MultiParamTypeClasses #-}

9{-# LANGUAGE OverloadedStrings #-}

10{-# LANGUAGE PolyKinds #-}

11−{-# LANGUAGE Rank2Types #-}

12{-# LANGUAGE ScopedTypeVariables #-}

11{-# LANGUAGE ScopedTypeVariables #-}

13{-# LANGUAGE TupleSections #-}

12{-# LANGUAGE TupleSections #-}

14{-# LANGUAGE TypeFamilies #-}

13{-# LANGUAGE TypeFamilies #-}

@@ -26,9 +25,7 @@

26module Servant.Reflex

25module Servant.Reflex

27 ( client

26 ( client

28 , clientWithOpts

27 , clientWithOpts

29− , clientWithOptsAndResultHandler

30 , clientWithRoute

28 , clientWithRoute

31− , clientWithRouteAndResultHandler

32 , BuildHeaderKeysTo(..)

29 , BuildHeaderKeysTo(..)

33 , toHeaders

30 , toHeaders

34 , HasClient

31 , HasClient

@@ -39,41 +36,39 @@ module Servant.Reflex

40------------------------------------------------------------------------------

37------------------------------------------------------------------------------

41import Control.Applicative

38import Control.Applicative

42−import qualified Data.CaseInsensitive as CI

43−import Data.Functor.Identity

44−import qualified Data.Map as Map

45import Data.Monoid ((<>))

39import Data.Monoid ((<>))

46−import Data.Proxy (Proxy (..))

47import qualified Data.Set as Set

40import qualified Data.Set as Set

41+import qualified Data.Text.Encoding as E

42+import Data.CaseInsensitive (mk)

43+import Data.Functor.Identity

44+import Data.Proxy (Proxy (..))

45+import qualified Data.Map as Map

48import Data.Text (Text)

46import Data.Text (Text)

49import qualified Data.Text as T

47import qualified Data.Text as T

50−import qualified Data.Text.Encoding as E

51import GHC.Exts (Constraint)

48import GHC.Exts (Constraint)

52import GHC.TypeLits (KnownSymbol, symbolVal)

49import GHC.TypeLits (KnownSymbol, symbolVal)

53−import Servant.API ((:<|>) (..), (:>), BasicAuth,

50+import Servant.API ((:<|>)(..),(:>), BasicAuth,

54− BasicAuthData, BuildHeadersTo (..),

51+ BasicAuthData, BuildHeadersTo(..),

55− Capture, Header, Headers (..),

52+ Capture, contentType, Header,

56− HttpVersion, IsSecure,

53+ Headers(..), HttpVersion, IsSecure,

57− MimeRender (..), MimeUnrender,

54+ MimeRender(..),

58 NoContent, QueryFlag, QueryParam,

55 NoContent, QueryFlag, QueryParam,

59− QueryParams, Raw, ReflectMethod (..),

56+ QueryParams, Raw, ReflectMethod(..),

60 RemoteHost, ReqBody,

57 RemoteHost, ReqBody,

61− ToHttpApiData (..), Vault, Verb,

58+ ToHttpApiData(..), Vault, Verb)

62− contentType)

63−import Servant.API.Description (Summary)

64import qualified Servant.Auth as Auth

59import qualified Servant.Auth as Auth

66import Reflex.Dom.Core (Dynamic, Event, Reflex,

61import Reflex.Dom.Core (Dynamic, Event, Reflex,

67− XhrRequest (..), XhrResponse (..),

62+ XhrRequest(..),

68− XhrResponseHeaders (..),

63+ XhrResponseHeaders(..),

69− attachPromptlyDynWith, constDyn, ffor,

64+ XhrResponse(..), attachPromptlyDynWith, constDyn, ffor, fmapMaybe,

70− fmapMaybe, leftmost,

71− performRequestsAsync)

65+ leftmost, performRequestsAsync,

66+ )

72------------------------------------------------------------------------------

67------------------------------------------------------------------------------

73import Servant.Common.BaseUrl (BaseUrl(..), Scheme(..), baseUrlWidget,

68import Servant.Common.BaseUrl (BaseUrl(..), Scheme(..), baseUrlWidget,

74 showBaseUrl,

69 showBaseUrl,

75 SupportsServantReflex)

70 SupportsServantReflex)

76−import Servant.Common.Req (ClientOptions(..),

71+import Servant.Common.Req (ClientOptions(..), MimeUnrender(..),

77 defaultClientOptions,

72 defaultClientOptions,

78 Req, ReqResult(..), QParam(..),

73 Req, ReqResult(..), QParam(..),

79 QueryPart(..), addHeader, authData,

74 QueryPart(..), addHeader, authData,

@@ -89,6 +84,8 @@ import Servant.Common.Req (ClientOptions(..),

89 response,

84 response,

90 reqTag,

85 reqTag,

91 qParams, withCredentials)

86 qParams, withCredentials)

87+import Servant.Checked.Exceptions.Internal.Envelope (Envelope)

88+import Servant.Checked.Exceptions.Internal.Servant.API (NoThrow, Throws, Throwing, ThrowingNonterminal)

94-- * Accessing APIs as a Client

91-- * Accessing APIs as a Client

@@ -103,7 +100,7 @@ import Servant.Common.Req (ClientOptions(..),

103-- >

100-- >

104-- > getAllBooks :: Event t l -> m (Event t (l, ReqResult [Book]))

101-- > getAllBooks :: Event t l -> m (Event t (l, ReqResult [Book]))

105-- > postNewBook :: Dynamic t (Maybe Book) -> Event t l

102-- > postNewBook :: Dynamic t (Maybe Book) -> Event t l

106−-- > -> m (Event t (l, ReqResult Book)))

103+-- -> m (Event t (l, ReqResult Book)))

107-- > (getAllBooks :<|> postNewBook) = client myApi host

104-- > (getAllBooks :<|> postNewBook) = client myApi host

108-- > where host = constDyn $ BaseUrl Http "localhost" 8080

105-- > where host = constDyn $ BaseUrl Http "localhost" 8080

109client

106client

@@ -125,53 +122,21 @@ clientWithOpts

125 -> Client t m layout tag

122 -> Client t m layout tag

126clientWithOpts p q t baseurl = clientWithRoute p q t defReq baseurl

123clientWithOpts p q t baseurl = clientWithRoute p q t defReq baseurl

127

124

128−-- | Like 'clientWithOpts' but allows passing a function which will process the

129−-- result event in some way. This can be used to handle errors in a uniform way

130−-- across call sites.

131−clientWithOptsAndResultHandler

132− :: (HasClient t m layout tag)

133− => Proxy layout

134− -> Proxy m

135− -> Proxy tag

136− -> Dynamic t BaseUrl

137− -> ClientOptions

138− -> (forall a. Event t (ReqResult tag a) -> m (Event t (ReqResult tag a)))

139− -> Client t m layout tag

140−clientWithOptsAndResultHandler p q t = clientWithRouteAndResultHandler p q t defReq

141−

142

125

143-- | This class lets us define how each API combinator

126-- | This class lets us define how each API combinator

144-- influences the creation of an HTTP request. It's mostly

127-- influences the creation of an HTTP request. It's mostly

145-- an internal class, you can just use 'client'.

128-- an internal class, you can just use 'client'.

146−class Monad m => HasClient t m layout (tag :: *) where

129+class HasClient t m layout (tag :: *) where

147 type Client t m layout tag :: *

130 type Client t m layout tag :: *

148− clientWithRoute

131+ clientWithRoute :: Proxy layout -> Proxy m -> Proxy tag -> Req t -> Dynamic t BaseUrl -> ClientOptions -> Client t m layout tag

149− :: Proxy layout

150− -> Proxy m

151− -> Proxy tag

152− -> Req t

153− -> Dynamic t BaseUrl

154− -> ClientOptions

155− -> Client t m layout tag

156− clientWithRoute l m t r b o = clientWithRouteAndResultHandler l m t r b o return

157−

158− clientWithRouteAndResultHandler

159− :: Proxy layout

160− -> Proxy m

161− -> Proxy tag

162− -> Req t

163− -> Dynamic t BaseUrl

164− -> ClientOptions

165− -> (forall a. Event t (ReqResult tag a) -> m (Event t (ReqResult tag a)))

166− -> Client t m layout tag

167

132

168

133

169instance (HasClient t m a tag, HasClient t m b tag) => HasClient t m (a :<|> b) tag where

134instance (HasClient t m a tag, HasClient t m b tag) => HasClient t m (a :<|> b) tag where

170 type Client t m (a :<|> b) tag = Client t m a tag :<|> Client t m b tag

135 type Client t m (a :<|> b) tag = Client t m a tag :<|> Client t m b tag

171

136

172− clientWithRouteAndResultHandler Proxy q pTag req baseurl opts wrap =

137+ clientWithRoute Proxy q pTag req baseurl opts =

173− clientWithRouteAndResultHandler (Proxy :: Proxy a) q pTag req baseurl opts wrap :<|>

138+ clientWithRoute (Proxy :: Proxy a) q pTag req baseurl opts :<|>

174− clientWithRouteAndResultHandler (Proxy :: Proxy b) q pTag req baseurl opts wrap

139+ clientWithRoute (Proxy :: Proxy b) q pTag req baseurl opts

175

140

176

141

177-- Capture. Example:

142-- Capture. Example:

@@ -192,9 +157,11 @@ instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout ta

192 type Client t m (Capture capture a :> sublayout) tag =

157 type Client t m (Capture capture a :> sublayout) tag =

193 Dynamic t (Either Text a) -> Client t m sublayout tag

158 Dynamic t (Either Text a) -> Client t m sublayout tag

194

159

195− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap val =

160+ clientWithRoute Proxy q t req baseurl opts val =

196− clientWithRouteAndResultHandler

161+ clientWithRoute (Proxy :: Proxy sublayout)

162+ q t

197− (Proxy :: Proxy sublayout) q t (prependToPathParts p req) baseurl opts wrap

163+ (prependToPathParts p req)

164+ baseurl opts

198 where p = (fmap . fmap) (toUrlPiece) val

165 where p = (fmap . fmap) (toUrlPiece) val

199

166

200

167

@@ -207,8 +174,8 @@ instance {-# OVERLAPPABLE #-}

207 Event t tag -> m (Event t (ReqResult tag a))

174 Event t tag -> m (Event t (ReqResult tag a))

208 -- TODO how to access input types here?

175 -- TODO how to access input types here?

209 -- ExceptT ServantError IO a

176 -- ExceptT ServantError IO a

210− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs =

177+ clientWithRoute Proxy _ _ req baseurl opts trigs =

211− wrap =<< fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity $ req') baseurl opts trigs

178+ fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity $ req') baseurl opts trigs

212 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

179 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

213 req' = req { reqMethod = method }

180 req' = req { reqMethod = method }

214

181

@@ -221,33 +188,29 @@ instance {-# OVERLAPPING #-}

221 Event t tag -> m (Event t (ReqResult tag NoContent))

188 Event t tag -> m (Event t (ReqResult tag NoContent))

222 -- TODO: how to access input types here?

189 -- TODO: how to access input types here?

223 -- ExceptT ServantError IO NoContent

190 -- ExceptT ServantError IO NoContent

224− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs =

191+ clientWithRoute Proxy _ _ req baseurl opts =

225− wrap =<< fmap runIdentity <$> performRequestsNoBody method (constDyn $ Identity req) baseurl opts trigs

192+ (fmap . fmap) runIdentity . performRequestsNoBody method (constDyn $ Identity req) baseurl opts

226 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

193 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

227

194

228

195

229toHeaders :: BuildHeadersTo ls => ReqResult tag a -> ReqResult tag (Headers ls a)

196toHeaders :: BuildHeadersTo ls => ReqResult tag a -> ReqResult tag (Headers ls a)

230toHeaders r =

197toHeaders r =

198+ let toBS = E.encodeUtf8

231− let hdrs = maybe []

199+ hdrs = maybe []

232− (\xhr -> fmap (\(h,v) -> (CI.map E.encodeUtf8 h, E.encodeUtf8 v))

200+ (\xhr -> fmap (\(h,v) -> (mk (toBS h), toBS v))

233 (Map.toList $ _xhrResponse_headers xhr))

201 (Map.toList $ _xhrResponse_headers xhr))

234 (response r)

202 (response r)

235 in ffor r $ \a -> Headers {getResponse = a ,getHeadersHList = buildHeadersTo hdrs}

203 in ffor r $ \a -> Headers {getResponse = a ,getHeadersHList = buildHeadersTo hdrs}

236

204

237−

238class BuildHeaderKeysTo hs where

205class BuildHeaderKeysTo hs where

239− buildHeaderKeysTo :: Proxy hs -> [CI.CI T.Text]

206+ buildHeaderKeysTo :: Proxy hs -> [T.Text]

240

207

241instance {-# OVERLAPPABLE #-} BuildHeaderKeysTo '[]

208instance {-# OVERLAPPABLE #-} BuildHeaderKeysTo '[]

242 where buildHeaderKeysTo _ = []

209 where buildHeaderKeysTo _ = []

243

210

244instance {-# OVERLAPPABLE #-} (BuildHeaderKeysTo xs, KnownSymbol h)

211instance {-# OVERLAPPABLE #-} (BuildHeaderKeysTo xs, KnownSymbol h)

245 => BuildHeaderKeysTo ((Header h v) ': xs) where

212 => BuildHeaderKeysTo ((Header h v) ': xs) where

246− buildHeaderKeysTo _ =

247− let

248− thisKey = CI.mk $ T.pack (symbolVal (Proxy :: Proxy h))

249− in thisKey : buildHeaderKeysTo (Proxy :: Proxy xs)

213+ buildHeaderKeysTo _ = T.pack (symbolVal (Proxy :: Proxy h)) : buildHeaderKeysTo (Proxy :: Proxy xs)

250−

251

214

252-- HEADERS Verb (Content) --

215-- HEADERS Verb (Content) --

253-- Headers combinator not treated in fully general case,

216-- Headers combinator not treated in fully general case,

@@ -262,10 +225,10 @@ instance {-# OVERLAPPABLE #-}

262 ) => HasClient t m (Verb method status cts' (Headers ls a)) tag where

225 ) => HasClient t m (Verb method status cts' (Headers ls a)) tag where

263 type Client t m (Verb method status cts' (Headers ls a)) tag =

226 type Client t m (Verb method status cts' (Headers ls a)) tag =

264 Event t tag -> m (Event t (ReqResult tag (Headers ls a)))

227 Event t tag -> m (Event t (ReqResult tag (Headers ls a)))

265− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs = do

228+ clientWithRoute Proxy _ _ req baseurl opts trigs = do

266 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

229 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

267 resp <- fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity req') baseurl opts trigs

230 resp <- fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity req') baseurl opts trigs

268− wrap $ toHeaders <$> resp

231+ return $ toHeaders <$> resp

269 where req' = req { respHeaders =

232 where req' = req { respHeaders =

270 OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))

233 OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))

271 }

234 }

@@ -278,10 +241,10 @@ instance {-# OVERLAPPABLE #-}

278 ) => HasClient t m (Verb method status cts (Headers ls NoContent)) tag where

241 ) => HasClient t m (Verb method status cts (Headers ls NoContent)) tag where

279 type Client t m (Verb method status cts (Headers ls NoContent)) tag

242 type Client t m (Verb method status cts (Headers ls NoContent)) tag

280 = Event t tag -> m (Event t (ReqResult tag (Headers ls NoContent)))

243 = Event t tag -> m (Event t (ReqResult tag (Headers ls NoContent)))

281− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs = do

244+ clientWithRoute Proxy _ _ req baseurl opts trigs = do

282 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

245 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

283 resp <- fmap runIdentity <$> performRequestsNoBody method (constDyn $ Identity req') baseurl opts trigs

246 resp <- fmap runIdentity <$> performRequestsNoBody method (constDyn $ Identity req') baseurl opts trigs

284− wrap $ toHeaders <$> resp

247+ return $ toHeaders <$> resp

285 where req' = req {respHeaders =

248 where req' = req {respHeaders =

286 OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))

249 OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))

287 }

250 }

@@ -308,11 +271,11 @@ instance (KnownSymbol sym, ToHttpApiData a,

308 type Client t m (Header sym a :> sublayout) tag =

271 type Client t m (Header sym a :> sublayout) tag =

309 Dynamic t (Either Text a) -> Client t m sublayout tag

272 Dynamic t (Either Text a) -> Client t m sublayout tag

310

273

311− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap eVal =

274+ clientWithRoute Proxy q t req baseurl opts eVal =

312− clientWithRouteAndResultHandler

313− (Proxy :: Proxy sublayout) q t

275+ clientWithRoute (Proxy :: Proxy sublayout)

276+ q t

314− (Servant.Common.Req.addHeader hname eVal req)

277+ (Servant.Common.Req.addHeader hname eVal req)

315− baseurl opts wrap

278+ baseurl opts

316 where hname = T.pack $ symbolVal (Proxy :: Proxy sym)

279 where hname = T.pack $ symbolVal (Proxy :: Proxy sym)

317

280

318

281

@@ -326,21 +289,8 @@ instance HasClient t m sublayout tag

326 type Client t m (HttpVersion :> sublayout) tag =

289 type Client t m (HttpVersion :> sublayout) tag =

327 Client t m sublayout tag

290 Client t m sublayout tag

328

291

329− clientWithRouteAndResultHandler Proxy =

292+ clientWithRoute Proxy q t =

330− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)

293+ clientWithRoute (Proxy :: Proxy sublayout) q t

331−

332−-- | Using a 'Summary' combinator in your API doesn't affect the client

333−-- functions.

334−instance (HasClient t m sublayout tag, KnownSymbol sym)

335− => HasClient t m (Summary sym :> sublayout) tag where

336−

337− type Client t m (Summary sym :> sublayout) tag =

338− Client t m sublayout tag

339−

340− clientWithRouteAndResultHandler Proxy =

341− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)

342−

343−

344

294

345

295

346-- | If you use a 'QueryParam' in one of your endpoints in your API,

296-- | If you use a 'QueryParam' in one of your endpoints in your API,

@@ -376,9 +326,9 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex

376 Dynamic t (QParam a) -> Client t m sublayout tag

326 Dynamic t (QParam a) -> Client t m sublayout tag

377

327

378 -- if mparam = Nothing, we don't add it to the query string

328 -- if mparam = Nothing, we don't add it to the query string

379− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap mparam =

329+ clientWithRoute Proxy q t req baseurl opts mparam =

380− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t

330+ clientWithRoute (Proxy :: Proxy sublayout) q t

381− (req {qParams = paramPair : qParams req}) baseurl opts wrap

331+ (req {qParams = paramPair : qParams req}) baseurl opts

382

332

383 where pname = symbolVal (Proxy :: Proxy sym)

333 where pname = symbolVal (Proxy :: Proxy sym)

384 --p prm = QueryPartParam $ (fmap . fmap) (toQueryParam) prm

334 --p prm = QueryPartParam $ (fmap . fmap) (toQueryParam) prm

@@ -422,8 +372,8 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex

422 type Client t m (QueryParams sym a :> sublayout) tag =

372 type Client t m (QueryParams sym a :> sublayout) tag =

423 Dynamic t [a] -> Client t m sublayout tag

373 Dynamic t [a] -> Client t m sublayout tag

424

374

425− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap paramlist =

375+ clientWithRoute Proxy q t req baseurl opts paramlist =

426− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap

376+ clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl opts

427

377

428 where req' = req { qParams = (T.pack pname, params') : qParams req }

378 where req' = req { qParams = (T.pack pname, params') : qParams req }

429 pname = symbolVal (Proxy :: Proxy sym)

379 pname = symbolVal (Proxy :: Proxy sym)

@@ -462,8 +412,8 @@ instance (KnownSymbol sym, HasClient t m sublayout tag, Reflex t)

462 type Client t m (QueryFlag sym :> sublayout) tag =

412 type Client t m (QueryFlag sym :> sublayout) tag =

463 Dynamic t Bool -> Client t m sublayout tag

413 Dynamic t Bool -> Client t m sublayout tag

464

414

465− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap flag =

415+ clientWithRoute Proxy q t req baseurl opts flag =

466− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap

416+ clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl opts

467

417

468 where req' = req { qParams = thisPair : qParams req }

418 where req' = req { qParams = thisPair : qParams req }

469 thisPair = (T.pack pName, QueryPartFlag flag) :: (Text, QueryPart t)

419 thisPair = (T.pack pName, QueryPartFlag flag) :: (Text, QueryPart t)

@@ -477,7 +427,7 @@ instance SupportsServantReflex t m => HasClient t m Raw tag where

477 -> Event t tag

427 -> Event t tag

478 -> m (Event t (ReqResult tag ()))

428 -> m (Event t (ReqResult tag ()))

479

429

480− clientWithRouteAndResultHandler _ _ _ _ baseurl _ wrap xhrs triggers = do

430+ clientWithRoute _ _ _ _ baseurl _ xhrs triggers = do

481

431

482 let xhrs' = liftA2 (\x path -> case x of

432 let xhrs' = liftA2 (\x path -> case x of

483 Left e -> Left e

433 Left e -> Left e

@@ -488,7 +438,7 @@ instance SupportsServantReflex t m => HasClient t m Raw tag where

488 okReq = fmapMaybe (\(t,x) -> either (const Nothing) (Just . (t,)) x) xhrs'' :: Event t (tag, XhrRequest ())

438 okReq = fmapMaybe (\(t,x) -> either (const Nothing) (Just . (t,)) x) xhrs'' :: Event t (tag, XhrRequest ())

489

439

490 resps <- performRequestsAsync okReq

440 resps <- performRequestsAsync okReq

491− wrap $ leftmost [ uncurry RequestFailure <$> badReq

441+ return $ leftmost [ uncurry RequestFailure <$> badReq

492 , evalResponse (const $ Right ()) <$> resps

442 , evalResponse (const $ Right ()) <$> resps

493 ]

443 ]

494

444

@@ -519,8 +469,8 @@ instance (MimeRender ct a, HasClient t m sublayout tag, Reflex t)

519 type Client t m (ReqBody (ct ': cts) a :> sublayout) tag =

469 type Client t m (ReqBody (ct ': cts) a :> sublayout) tag =

520 Dynamic t (Either Text a) -> Client t m sublayout tag

470 Dynamic t (Either Text a) -> Client t m sublayout tag

521

471

522− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap body =

472+ clientWithRoute Proxy q t req baseurl opts body =

523− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap

473+ clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl opts

524 where req' = req { reqBody = bodyBytesCT }

474 where req' = req { reqBody = bodyBytesCT }

525 ctProxy = Proxy :: Proxy ct

475 ctProxy = Proxy :: Proxy ct

526 ctString = T.pack $ show $ contentType ctProxy

476 ctString = T.pack $ show $ contentType ctProxy

@@ -534,9 +484,9 @@ instance (MimeRender ct a, HasClient t m sublayout tag, Reflex t)

534instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient t m (path :> sublayout) tag where

484instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient t m (path :> sublayout) tag where

535 type Client t m (path :> sublayout) tag = Client t m sublayout tag

485 type Client t m (path :> sublayout) tag = Client t m sublayout tag

536

486

537− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap =

487+ clientWithRoute Proxy q t req baseurl opts =

538− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t

488+ clientWithRoute (Proxy :: Proxy sublayout) q t

539− (prependToPathParts (pure (Right $ T.pack p)) req) baseurl opts wrap

489+ (prependToPathParts (pure (Right $ T.pack p)) req) baseurl opts

540

490

541 where p = symbolVal (Proxy :: Proxy path)

491 where p = symbolVal (Proxy :: Proxy path)

542

492

@@ -544,23 +494,23 @@ instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient

544instance HasClient t m api tag => HasClient t m (Vault :> api) tag where

494instance HasClient t m api tag => HasClient t m (Vault :> api) tag where

545 type Client t m (Vault :> api) tag = Client t m api tag

495 type Client t m (Vault :> api) tag = Client t m api tag

546

496

547− clientWithRouteAndResultHandler Proxy =

497+ clientWithRoute Proxy q t req baseurl =

548− clientWithRouteAndResultHandler (Proxy :: Proxy api)

498+ clientWithRoute (Proxy :: Proxy api) q t req baseurl

549

499

550

500

551instance HasClient t m api tag => HasClient t m (RemoteHost :> api) tag where

501instance HasClient t m api tag => HasClient t m (RemoteHost :> api) tag where

552 type Client t m (RemoteHost :> api) tag = Client t m api tag

502 type Client t m (RemoteHost :> api) tag = Client t m api tag

553

503

554− clientWithRouteAndResultHandler Proxy =

504+ clientWithRoute Proxy q t req baseurl =

555− clientWithRouteAndResultHandler (Proxy :: Proxy api)

505+ clientWithRoute (Proxy :: Proxy api) q t req baseurl

556

506

557

507

558

508

559instance HasClient t m api tag => HasClient t m (IsSecure :> api) tag where

509instance HasClient t m api tag => HasClient t m (IsSecure :> api) tag where

560 type Client t m (IsSecure :> api) tag = Client t m api tag

510 type Client t m (IsSecure :> api) tag = Client t m api tag

561

511

562− clientWithRouteAndResultHandler Proxy =

512+ clientWithRoute Proxy q t req baseurl =

563− clientWithRouteAndResultHandler (Proxy :: Proxy api)

513+ clientWithRoute (Proxy :: Proxy api) q t req baseurl

564

514

565

515

566instance (HasClient t m api tag, Reflex t)

516instance (HasClient t m api tag, Reflex t)

@@ -569,8 +519,8 @@ instance (HasClient t m api tag, Reflex t)

569 type Client t m (BasicAuth realm usr :> api) tag = Dynamic t (Maybe BasicAuthData)

519 type Client t m (BasicAuth realm usr :> api) tag = Dynamic t (Maybe BasicAuthData)

570 -> Client t m api tag

520 -> Client t m api tag

571

521

572− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap authdata =

522+ clientWithRoute Proxy q t req baseurl opts authdata =

573− clientWithRouteAndResultHandler (Proxy :: Proxy api) q t req' baseurl opts wrap

523+ clientWithRoute (Proxy :: Proxy api) q t req' baseurl opts

574 where

524 where

575 req' = req { authData = Just authdata }

525 req' = req { authData = Just authdata }

576

526

@@ -613,7 +563,7 @@ for empty and one for non-empty lists).

613instance (HasCookieAuth auths, HasClient t m api tag) => HasClient t m (Auth.Auth auths a :> api) tag where

563instance (HasCookieAuth auths, HasClient t m api tag) => HasClient t m (Auth.Auth auths a :> api) tag where

614

564

615 type Client t m (Auth.Auth auths a :> api) tag = Client t m api tag

565 type Client t m (Auth.Auth auths a :> api) tag = Client t m api tag

616− clientWithRouteAndResultHandler Proxy = clientWithRouteAndResultHandler (Proxy :: Proxy api)

566+ clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy api)

617

567

618

568

619type family HasCookieAuth xs :: Constraint where

569type family HasCookieAuth xs :: Constraint where

@@ -623,3 +573,136 @@ type family HasCookieAuth xs :: Constraint where

623

573

624class CookieAuthNotEnabled

574class CookieAuthNotEnabled

625

575

576+{- servant-checked-exceptions

577+~~~~~~~~~~~~~~~~~~~~~

578+-}

579+

580+-- | Change a 'Throws' into 'Throwing'.

581+instance (HasClient t m (Throwing '[e] :> api) tag) => HasClient t m (Throws e :> api) tag where

582+ type Client t m (Throws e :> api) tag = Client t m (Throwing '[e] :> api) tag

583+

584+ clientWithRoute

585+ :: Proxy (Throws e :> api)

586+ -> Proxy m

587+ -> Proxy tag

588+ -> Req t

589+ -> Dynamic t BaseUrl

590+ -> ClientOptions

591+ -> Client t m (Throwing '[e] :> api) tag

592+ clientWithRoute _ = clientWithRoute (Proxy :: Proxy (Throwing '[e] :> api))

593+

594+-- | When @'Throwing' es@ comes before a 'Verb', change it into the same 'Verb'

595+-- but returning an @'Envelope' es@.

596+instance (HasClient t m (Verb method status ctypes (Envelope es a)) tag) =>

597+ HasClient t m (Throwing es :> Verb method status ctypes a) tag where

598+

599+ type Client t m (Throwing es :> Verb method status ctypes a) tag =

600+ Client t m (Verb method status ctypes (Envelope es a)) tag

601+

602+ clientWithRoute

603+ :: Proxy (Throwing es :> Verb method status ctypes a)

604+ -> Proxy m

605+ -> Proxy tag

606+ -> Req t

607+ -> Dynamic t BaseUrl

608+ -> ClientOptions

609+ -> Client t m (Verb method status ctypes (Envelope es a)) tag

610+ clientWithRoute Proxy =

611+ clientWithRoute (Proxy :: Proxy (Verb method status ctypes (Envelope es a)))

612+

613+-- | When 'NoThrow' comes before a 'Verb', change it into the same 'Verb'

614+-- but returning an @'Envelope' \'[]@.

615+instance (HasClient t m (Verb method status ctypes (Envelope '[] a)) tag) =>

616+ HasClient t m (NoThrow :> Verb method status ctypes a) tag where

617+

618+ type Client t m (NoThrow :> Verb method status ctypes a) tag =

619+ Client t m (Verb method status ctypes (Envelope '[] a)) tag

620+

621+ clientWithRoute

622+ :: Proxy (NoThrow :> Verb method status ctypes a)

623+ -> Proxy m

624+ -> Proxy tag

625+ -> Req t

626+ -> Dynamic t BaseUrl

627+ -> ClientOptions

628+ -> Client t m (Verb method status ctypes (Envelope '[] a)) tag

629+ clientWithRoute Proxy =

630+ clientWithRoute (Proxy :: Proxy (Verb method status ctypes (Envelope '[] a)))

631+

632+-- | When @'Throwing' es@ comes before ':<|>', push @'Throwing' es@ into each

633+-- branch of the API.

634+instance HasClient t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) tag =>

635+ HasClient t m (Throwing es :> (api1 :<|> api2)) tag where

636+

637+ type Client t m (Throwing es :> (api1 :<|> api2)) tag =

638+ Client t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) tag

639+

640+ clientWithRoute

641+ :: Proxy (Throwing es :> (api1 :<|> api2))

642+ -> Proxy m

643+ -> Proxy tag

644+ -> Req t

645+ -> Dynamic t BaseUrl

646+ -> ClientOptions

647+ -> Client t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) tag

648+ clientWithRoute _ =

649+ clientWithRoute (Proxy :: Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2)))

650+

651+-- | When 'NoThrow' comes before ':<|>', push 'NoThrow' into each branch of the

652+-- API.

653+instance HasClient t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) tag =>

654+ HasClient t m (NoThrow :> (api1 :<|> api2)) tag where

655+

656+ type Client t m (NoThrow :> (api1 :<|> api2)) tag =

657+ Client t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) tag

658+

659+ clientWithRoute

660+ :: Proxy (NoThrow :> (api1 :<|> api2))

661+ -> Proxy m

662+ -> Proxy tag

663+ -> Req t

664+ -> Dynamic t BaseUrl

665+ -> ClientOptions

666+ -> Client t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) tag

667+ clientWithRoute _ =

668+ clientWithRoute (Proxy :: Proxy ((NoThrow :> api1) :<|> (NoThrow :> api2)))

669+

670+-- | When a @'Throws' e@ comes immediately after a @'Throwing' es@, 'Snoc' the

671+-- @e@ onto the @es@. Otherwise, if @'Throws' e@ comes before any other

672+-- combinator, push it down so it is closer to the 'Verb'.

673+instance HasClient t m (ThrowingNonterminal (Throwing es :> api :> apis)) tag =>

674+ HasClient t m (Throwing es :> api :> apis) tag where

675+

676+ type Client t m (Throwing es :> api :> apis) tag =

677+ Client t m (ThrowingNonterminal (Throwing es :> api :> apis)) tag

678+

679+ clientWithRoute

680+ :: Proxy (Throwing es :> api :> apis)

681+ -> Proxy m

682+ -> Proxy tag

683+ -> Req t

684+ -> Dynamic t BaseUrl

685+ -> ClientOptions

686+ -> Client t m (ThrowingNonterminal (Throwing es :> api :> apis)) tag

687+ clientWithRoute _ =

688+ clientWithRoute (Proxy :: Proxy (ThrowingNonterminal (Throwing es :> api :> apis)))

689+

690+-- | When 'NoThrow' comes before any other combinator, push it down so it is

691+-- closer to the 'Verb'.

692+instance HasClient t m (api :> NoThrow :> apis) tag =>

693+ HasClient t m (NoThrow :> api :> apis) tag where

694+

695+ type Client t m (NoThrow :> api :> apis) tag =

696+ Client t m (api :> NoThrow :> apis) tag

697+

698+ clientWithRoute

699+ :: Proxy (NoThrow :> api :> apis)

700+ -> Proxy m

701+ -> Proxy tag

702+ -> Req t

703+ -> Dynamic t BaseUrl

704+ -> ClientOptions

705+ -> Client t m (api :> NoThrow :> apis) tag

706+ clientWithRoute _ =

707+ clientWithRoute (Proxy :: Proxy (api :> NoThrow :> apis))

708+

src/Servant/Reflex/Multi.hs+165−36

@@ -37,34 +37,32 @@ module Servant.Reflex.Multi (

37 ) where

39------------------------------------------------------------------------------

40−import Control.Applicative (liftA2)

40+import Control.Applicative (liftA2)

41−import Data.Functor.Compose (Compose (..), getCompose)

41+import Data.Functor.Compose (Compose (..), getCompose)

42−import Data.Proxy (Proxy (..))

42+import Data.Proxy (Proxy (..))

43−import qualified Data.Set as Set

43+import qualified Data.Set as Set

44−import Data.Text (Text)

44+import Data.Text (Text)

45−import qualified Data.Text as T

45+import qualified Data.Text as T

46−import qualified Data.Text.Encoding as E

46+import qualified Data.Text.Encoding as E

47−import GHC.TypeLits (KnownSymbol, symbolVal)

47+import GHC.TypeLits (KnownSymbol, symbolVal)

48−import Servant.API ((:<|>) (..), (:>), BasicAuth,

48+import Servant.API ((:<|>) (..), (:>), BasicAuth,

49− BasicAuthData, BuildHeadersTo (..),

49+ BasicAuthData, BuildHeadersTo (..),

50− Capture, Header, Headers (..),

50+ Capture, Header, Headers (..),

51− HttpVersion, IsSecure,

51+ HttpVersion, IsSecure, MimeRender (..),

52− MimeRender (..), MimeUnrender,

53− NoContent, QueryFlag, QueryParam,

52+ NoContent, QueryFlag,

54− QueryParams, Raw, ReflectMethod (..),

53+ QueryParam, QueryParams, Raw,

55− RemoteHost, ReqBody,

54+ ReflectMethod (..), RemoteHost,

56− ToHttpApiData (..), Vault, Verb,

55+ ReqBody, ToHttpApiData (..), Vault,

57− contentType)

56+ Verb, contentType)

58−import Servant.API.Description (Summary)

57+

59−

60−import Reflex.Dom.Core (Dynamic, Event, Reflex,

58+import Reflex.Dom.Core (Dynamic, Event, Reflex,

61− XhrRequest (..),

59+ XhrRequest (..),

62− XhrResponseHeaders (..),

60+ XhrResponseHeaders (..),

63− attachPromptlyDynWith, constDyn)

61+ attachPromptlyDynWith, constDyn)

64------------------------------------------------------------------------------

62------------------------------------------------------------------------------

65import Servant.Common.BaseUrl (BaseUrl (..), Scheme (..),

63import Servant.Common.BaseUrl (BaseUrl (..), Scheme (..),

66 SupportsServantReflex)

64 SupportsServantReflex)

67−import Servant.Common.Req (ClientOptions,

65+import Servant.Common.Req (ClientOptions, MimeUnrender,

68 QParam (..), QueryPart (..), Req,

66 QParam (..), QueryPart (..), Req,

69 ReqResult (..), addHeader, authData,

67 ReqResult (..), addHeader, authData,

70 defReq,

68 defReq,

@@ -76,6 +74,8 @@ import Servant.Common.Req (ClientOptions,

76 qParams, reqBody, reqFailure,

74 qParams, reqBody, reqFailure,

77 reqMethod, reqSuccess, reqSuccess',

75 reqMethod, reqSuccess, reqSuccess',

78 respHeaders, response, withCredentials)

76 respHeaders, response, withCredentials)

77+import Servant.Checked.Exceptions.Internal.Envelope (Envelope)

78+import Servant.Checked.Exceptions.Internal.Servant.API (NoThrow, Throws, Throwing, ThrowingNonterminal)

79import Servant.Reflex (BuildHeaderKeysTo (..), toHeaders)

@@ -242,17 +242,6 @@ instance HasClientMulti t m sublayout f tag

242 clientWithRouteMulti (Proxy :: Proxy sublayout) q f tag

243

244

245−------------------------------------------------------------------------------

246−instance (HasClientMulti t m sublayout f tag, KnownSymbol sym)

247− => HasClientMulti t m (Summary sym :> sublayout) f tag where

248−

249− type ClientMulti t m (Summary sym :> sublayout) f tag =

250− ClientMulti t m sublayout f tag

251−

252− clientWithRouteMulti Proxy q f tag =

253− clientWithRouteMulti (Proxy :: Proxy sublayout) q f tag

254−

255−

256------------------------------------------------------------------------------

245------------------------------------------------------------------------------

257instance (KnownSymbol sym,

246instance (KnownSymbol sym,

258 ToHttpApiData a,

247 ToHttpApiData a,

@@ -399,3 +388,143 @@ instance (HasClientMulti t m api f tag, Reflex t, Applicative f)

399 where

388 where

400 req' a r = r { authData = Just (constDyn a) }

389 req' a r = r { authData = Just (constDyn a) }

401 reqs' = liftA2 req' <$> authdatas <*> reqs

390 reqs' = liftA2 req' <$> authdatas <*> reqs

391+

392+{- servant-checked-exceptions

393+~~~~~~~~~~~~~~~~~~~~~

394+-}

395+

396+-- | Change a 'Throws' into 'Throwing'.

397+instance (HasClientMulti t m (Throwing '[e] :> api) f tag) => HasClientMulti t m (Throws e :> api) f tag where

398+ type ClientMulti t m (Throws e :> api) f tag = ClientMulti t m (Throwing '[e] :> api) f tag

399+

400+ clientWithRouteMulti

401+ :: Proxy (Throws e :> api)

402+ -> Proxy m

403+ -> Proxy f

404+ -> Proxy tag

405+ -> Dynamic t (f (Req t))

406+ -> Dynamic t BaseUrl

407+ -> ClientOptions

408+ -> ClientMulti t m (Throwing '[e] :> api) f tag

409+ clientWithRouteMulti _ = clientWithRouteMulti (Proxy :: Proxy (Throwing '[e] :> api))

410+

411+-- | When @'Throwing' es@ comes before a 'Verb', change it into the same 'Verb'

412+-- but returning an @'Envelope' es@.

413+instance (HasClientMulti t m (Verb method status ctypes (Envelope es a)) f tag) =>

414+ HasClientMulti t m (Throwing es :> Verb method status ctypes a) f tag where

415+

416+ type ClientMulti t m (Throwing es :> Verb method status ctypes a) f tag =

417+ ClientMulti t m (Verb method status ctypes (Envelope es a)) f tag

418+

419+ clientWithRouteMulti

420+ :: Proxy (Throwing es :> Verb method status ctypes a)

421+ -> Proxy m

422+ -> Proxy f

423+ -> Proxy tag

424+ -> Dynamic t (f (Req t))

425+ -> Dynamic t BaseUrl

426+ -> ClientOptions

427+ -> ClientMulti t m (Verb method status ctypes (Envelope es a)) f tag

428+ clientWithRouteMulti Proxy =

429+ clientWithRouteMulti (Proxy :: Proxy (Verb method status ctypes (Envelope es a)))

430+

431+-- | When 'NoThrow' comes before a 'Verb', change it into the same 'Verb'

432+-- but returning an @'Envelope' \'[]@.

433+instance (HasClientMulti t m (Verb method status ctypes (Envelope '[] a)) f tag) =>

434+ HasClientMulti t m (NoThrow :> Verb method status ctypes a) f tag where

435+

436+ type ClientMulti t m (NoThrow :> Verb method status ctypes a) f tag =

437+ ClientMulti t m (Verb method status ctypes (Envelope '[] a)) f tag

438+

439+ clientWithRouteMulti

440+ :: Proxy (NoThrow :> Verb method status ctypes a)

441+ -> Proxy m

442+ -> Proxy f

443+ -> Proxy tag

444+ -> Dynamic t (f (Req t))

445+ -> Dynamic t BaseUrl

446+ -> ClientOptions

447+ -> ClientMulti t m (Verb method status ctypes (Envelope '[] a)) f tag

448+ clientWithRouteMulti Proxy =

449+ clientWithRouteMulti (Proxy :: Proxy (Verb method status ctypes (Envelope '[] a)))

450+

451+-- | When @'Throwing' es@ comes before ':<|>', push @'Throwing' es@ into each

452+-- branch of the API.

453+instance HasClientMulti t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) f tag =>

454+ HasClientMulti t m (Throwing es :> (api1 :<|> api2)) f tag where

455+

456+ type ClientMulti t m (Throwing es :> (api1 :<|> api2)) f tag =

457+ ClientMulti t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) f tag

458+

459+ clientWithRouteMulti

460+ :: Proxy (Throwing es :> (api1 :<|> api2))

461+ -> Proxy m

462+ -> Proxy f

463+ -> Proxy tag

464+ -> Dynamic t (f (Req t))

465+ -> Dynamic t BaseUrl

466+ -> ClientOptions

467+ -> ClientMulti t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) f tag

468+ clientWithRouteMulti _ =

469+ clientWithRouteMulti (Proxy :: Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2)))

470+

471+-- | When 'NoThrow' comes before ':<|>', push 'NoThrow' into each branch of the

472+-- API.

473+instance HasClientMulti t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) f tag =>

474+ HasClientMulti t m (NoThrow :> (api1 :<|> api2)) f tag where

475+

476+ type ClientMulti t m (NoThrow :> (api1 :<|> api2)) f tag =

477+ ClientMulti t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) f tag

478+

479+ clientWithRouteMulti

480+ :: Proxy (NoThrow :> (api1 :<|> api2))

481+ -> Proxy m

482+ -> Proxy f

483+ -> Proxy tag

484+ -> Dynamic t (f (Req t))

485+ -> Dynamic t BaseUrl

486+ -> ClientOptions

487+ -> ClientMulti t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) f tag

488+ clientWithRouteMulti _ =

489+ clientWithRouteMulti (Proxy :: Proxy ((NoThrow :> api1) :<|> (NoThrow :> api2)))

490+

491+-- | When a @'Throws' e@ comes immediately after a @'Throwing' es@, 'Snoc' the

492+-- @e@ onto the @es@. Otherwise, if @'Throws' e@ comes before any other

493+-- combinator, push it down so it is closer to the 'Verb'.

494+instance HasClientMulti t m (ThrowingNonterminal (Throwing es :> api :> apis)) f tag =>

495+ HasClientMulti t m (Throwing es :> api :> apis) f tag where

496+

497+ type ClientMulti t m (Throwing es :> api :> apis) f tag =

498+ ClientMulti t m (ThrowingNonterminal (Throwing es :> api :> apis)) f tag

499+

500+ clientWithRouteMulti

501+ :: Proxy (Throwing es :> api :> apis)

502+ -> Proxy m

503+ -> Proxy f

504+ -> Proxy tag

505+ -> Dynamic t (f (Req t))

506+ -> Dynamic t BaseUrl

507+ -> ClientOptions

508+ -> ClientMulti t m (ThrowingNonterminal (Throwing es :> api :> apis)) f tag

509+ clientWithRouteMulti _ =

510+ clientWithRouteMulti (Proxy :: Proxy (ThrowingNonterminal (Throwing es :> api :> apis)))

511+

512+-- | When 'NoThrow' comes before any other combinator, push it down so it is

513+-- closer to the 'Verb'.

514+instance HasClientMulti t m (api :> NoThrow :> apis) f tag =>

515+ HasClientMulti t m (NoThrow :> api :> apis) f tag where

516+

517+ type ClientMulti t m (NoThrow :> api :> apis) f tag =

518+ ClientMulti t m (api :> NoThrow :> apis) f tag

519+

520+ clientWithRouteMulti

521+ :: Proxy (NoThrow :> api :> apis)

522+ -> Proxy m

523+ -> Proxy f

524+ -> Proxy tag

525+ -> Dynamic t (f (Req t))

526+ -> Dynamic t BaseUrl

527+ -> ClientOptions

528+ -> ClientMulti t m (api :> NoThrow :> apis) f tag

529+ clientWithRouteMulti _ =

530+ clientWithRouteMulti (Proxy :: Proxy (api :> NoThrow :> apis))

testdriver/test/Servant/ReflexSpec.hs+1−2

@@ -9,7 +9,6 @@ import qualified Data.Text as T

9import Data.Foldable

10import Test.WebDriver.Commands.Wait

11import Test.Hspec.WebDriver

12−import Test.Hspec.WebDriver (chromeCaps)

15clickingShouldCause :: Selector -> Selector -> Double -> (Element -> Element -> WD Bool) -> WD ()

14clickingShouldCause :: Selector -> Selector -> Double -> (Element -> Element -> WD Bool) -> WD ()

@@ -29,7 +28,7 @@ spec :: Spec

29spec = do

28spec = do

30 describe "servant-reflex tests" $ do

29 describe "servant-reflex tests" $ do

32− session "test page" $ using [chromeCaps] $ do

31+ session "test page" $ using Chrome $ do

34 it "opens the page" $ runWD $

33 it "opens the page" $ runWD $

35 openPage "http://localhost:8000"

34 openPage "http://localhost:8000"

testserver/API.hsmode 100644 → 120000+1−69

@@ -1,69 +0,0 @@

1−{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE TypeOperators #-}

4−

5−module API where

6−

7−import Data.Aeson

8−import Data.Aeson.Types (typeMismatch)

9−import Data.Text (Text)

10−import Servant.API

11−

12−newtype Question = Question { unQuestion :: Text } deriving (Show)

13−

14−instance ToJSON Question where

15− toJSON (Question txt) = object ["question" .= txt]

16−

17−instance FromJSON Question where

18− parseJSON (Object v) = Question <$> v .: "question"

19− parseJSON x = typeMismatch "Couldn't find key 'question'" x

20−

21−newtype Answer = Answer { unAnswer :: Text } deriving (Show)

22−

23−instance ToJSON Answer where

24− toJSON (Answer txt) = object ["answer" .= txt]

25−

26−instance FromJSON Answer where

27− parseJSON (Object v) = Answer <$> v .: "answer"

28− parseJSON x = typeMismatch "Couldn't find key 'answer'" x

29−

30−

31−-- | API spec for server, client, and docs

32−type API = "getunit" :> Get '[JSON] ()

33− :<|> "getint" :> Get '[JSON] Int

34− :<|> "sayhi" :> QueryParam "username" Text

35− :> QueryParams "greetings" Text

36− :> QueryFlag "gusto"

37− :> Get '[JSON] Text

38− :<|> "double" :> ReqBody '[JSON] Double

39− :> Post '[JSON] Double

40− :<|> "a" :> "b" :> QueryFlag "gusto" :> Get '[JSON] Text

41− :<|> "qna" :> ReqBody '[JSON] Question

42− :> Post '[JSON] Answer

43− :<|> "secret" :> BasicAuth "realm" () :> Get '[JSON] Int

44− :<|> Raw

45−

46−type GET = Get '[JSON] ()

47−

48−-- Imported the comprehensive API example for testing.

49−-- https://github.com/haskell-servant/servant/blob/master/servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs

50−type ComprehensiveAPI =

51− GET :<|>

52− Get '[JSON] Int :<|>

53− Capture "foo" Int :> GET :<|>

54− Header "foo" Int :> GET :<|>

55− HttpVersion :> GET :<|>

56− IsSecure :> GET :<|>

57− QueryParam "foo" Int :> GET :<|>

58− QueryParams "foo" Int :> GET :<|>

59− QueryFlag "foo" :> GET :<|>

60−-- Raw :<|>

61− RemoteHost :> GET :<|>

62− ReqBody '[JSON] Int :> GET :<|>

63− Get '[JSON] (Headers '[Header "foo" Int] ()) :<|>

64− "foo" :> GET :<|>

65− Vault :> GET :<|>

66− Verb 'POST 204 '[JSON] () :<|>

67− Verb 'POST 204 '[JSON] Int

68−-- This one isn't in scope

69−-- :<|> WithNamedContext "foo" '[] GET

@@ -0,0 +1 @@

1+../exec/API.hs

testserver/Main.hs+3−10

@@ -7,12 +7,10 @@

7{-# LANGUAGE TypeOperators #-}

9import Control.Monad.IO.Class (liftIO)

10−import Control.Monad.Reader (reader)

11import Data.Aeson

10import Data.Aeson

12import Data.Bool

11import Data.Bool

13import Data.Char (toUpper)

12import Data.Char (toUpper)

14import qualified Data.List as L

13import qualified Data.List as L

15−import Data.Maybe (fromMaybe)

16import Data.Monoid

14import Data.Monoid

17import Data.Proxy

15import Data.Proxy

18import Data.Text hiding (head, length, map,

16import Data.Text hiding (head, length, map,

@@ -27,7 +25,6 @@ import Snap.Http.Server

27import Servant

25import Servant

28import Servant.Server

26import Servant.Server

29-- import Snap.Util.FileServe

27-- import Snap.Util.FileServe

30−import System.Environment (lookupEnv)

31import API

28import API

32import Snap

29import Snap

@@ -43,7 +40,7 @@ instance ToJSON Greet

43testApi :: Proxy API

40testApi :: Proxy API

44testApi = Proxy

41testApi = Proxy

46−data App = App { appStaticDir :: String }

43+data App = App

48-- Server-side handlers.

45-- Server-side handlers.

49--

46--

@@ -54,7 +51,7 @@ data App = App { appStaticDir :: String }

54server :: Server API '[BasicAuthCheck (Handler App App) ()] (Handler App App)

51server :: Server API '[BasicAuthCheck (Handler App App) ()] (Handler App App)

55server = return () :<|> return 100 :<|> sayhi :<|> dbl

52server = return () :<|> return 100 :<|> sayhi :<|> dbl

56 :<|> multi :<|> qna :<|> serveSecret

53 :<|> multi :<|> qna :<|> serveSecret

57− :<|> statics

54+ :<|> serveDirectory "static"

58 where sayhi :: Maybe Text -> [Text] -> Bool -> Handler App App Text

55 where sayhi :: Maybe Text -> [Text] -> Bool -> Handler App App Text

59 sayhi nm greetings withGusto = case nm of

56 sayhi nm greetings withGusto = case nm of

60 Nothing -> return ("Sorry, who are you?" :: Text)

57 Nothing -> return ("Sorry, who are you?" :: Text)

@@ -79,9 +76,6 @@ server = return () :<|> return 100 :<|> sayhi :<|> dbl

79 req <- getRequest

76 req <- getRequest

80 liftIO $ putStrLn (show req)

77 liftIO $ putStrLn (show req)

81 return 101

78 return 101

82− statics = do

83− staticDir <- reader appStaticDir

84− serveDirectory staticDir

86-- Turn the server into a WAI app. 'serve' is provided by servant,

80-- Turn the server into a WAI app. 'serve' is provided by servant,

87-- more precisely by the Servant.Server module.

81-- more precisely by the Servant.Server module.

@@ -91,11 +85,10 @@ test = serveSnapWithContext testApi

92initApp :: SnapletInit App App

86initApp :: SnapletInit App App

93initApp = makeSnaplet "myapp" "example" Nothing $ do

87initApp = makeSnaplet "myapp" "example" Nothing $ do

94− staticDir <- fromMaybe "static" <$> liftIO (lookupEnv "STATIC_DIR")

95 addRoutes [("", test)

88 addRoutes [("", test)

96 ,("", serveDirectory "static")

89 ,("", serveDirectory "static")

97 ]

90 ]

98− return (App staticDir)

91+ return App

100-- Put this all to work!

93-- Put this all to work!

101main :: IO ()

94main :: IO ()

testserver/run-wd-tests.shnew file+5

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

1+#!/usr/bin/env bash

3+dist/build/back/back -p 8000 &

4+phantomjs --webdriver=127.0.0.1:4444 &

5+dist/build/spec/spec

testserver/testserver.cabal+4−5

@@ -19,13 +19,12 @@ executable back

19 main-is: Main.hs

20 -- other-modules:

21 -- other-extensions:

22− build-depends: aeson >= 0.9 && < 1.5

22+ build-depends: aeson >= 0.9 && < 1.4

23− , base >=4.8 && < 5

23+ , base >=4.8 && <4.11

24− , mtl

25 , snap >= 1.0 && < 1.2

24 , snap >= 1.0 && < 1.2

26− , snap-server >= 1.0 && < 1.2

25+ , snap-server >= 1.0 && < 1.1

27 , snap-core >= 1.0 && < 1.1

26 , snap-core >= 1.0 && < 1.1

28− , servant >= 0.16 && < 0.18

27+ , servant >= 0.8 && < 0.12

29 , servant-snap >= 0.8 && < 0.9

28 , servant-snap >= 0.8 && < 0.9

30 , text >= 1.0 && < 1.3

29 , text >= 1.0 && < 1.3

31 -- hs-source-dirs:

30 -- hs-source-dirs:

testserver/tr.nixnew file+32

@@ -0,0 +1,32 @@

1+{ reflex-platform, ... }:

2+let

4+ dontCheck = (import <nixpkgs> {}).pkgs.haskell.lib.dontCheck;

5+ cabal2nixResult = reflex-platform.cabal2nixResult;

6+ nixpkgs = (import <nixpkgs> {});

7+in

8+reflex-platform.ghc.override {

9+ overrides = self: super: {

10+ servant-snap = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap) {});

11+ snap = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap) {});

12+ io-streams = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap/deps/io-streams) {});

13+ io-streams-haproxy = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap/deps/io-streams-haproxy) {});

14+ heist = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap/deps/heist) {});

15+ xmlhtml = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap/deps/xmlhtml) {});

16+ snap-core = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap/deps/snap-core) {});

17+ snap-server = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap/deps/snap-server) {});

18+ snap-loader-static = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap-loader-static) {});

19+ snap-loader-dynamic = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap-loader-dynamic) {});

20+ hspec-snap = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/hspec-snap) {});

21+

22+ # servant-foreign = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-foreign) {});

23+ # servant-js = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-js) {});

24+ # servant-docs = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-docs) {});

25+ # servant-client = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-client) {});

26+ # servant-blaze = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-blaze) {});

27+ # servant-lucid = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-lucid) {});

28+ # servant-server = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-server) {});

29+ # servant = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant) {});

30+

31+ };

32+}

travis.nixdeleted−70

@@ -1,70 +0,0 @@

1−{

2− nativeCompiler ? "ghc",

3− # ^ Choose a GHC for compiling backend components (web server, selenium)

4− # (ghc, ghc8_0, ghc8_2, ghc8_4 or ghcHEAD)

5−

6− jsCompiler ? "ghcjs"

7− # ^ Choose a GHCJS for compiling the frontend

8− # (ghcjs, ghcjs8_0, ghcjs8_2 or ghcjs8_4)

9−

10−}:

11−

12−let

13−

14− reflexPlatform = import ./nix/reflex-platform.nix;

15−

16− lib = reflexPlatform.nixpkgs.haskell.lib;

17− do = funs: pkg: builtins.foldl' (a: b: b a) pkg funs;

18−

19− ghcjsPkgs = with lib; reflexPlatform.${jsCompiler}.override {

20− overrides = self: super: {

21− http-media = dontCheck super.http-media;

22− servant = dontCheck super.servant;

23− lens-aeson = dontCheck super.lens-aeson;

24− servant-reflex = lib.appendConfigureFlag

25− (self.callPackage ./default.nix {}) "-fExample";

26− };

27− };

28−

29− ghcPkgs = with lib; reflexPlatform.${nativeCompiler}.override {

30− overrides = self: super: {

31− servant-snap = dontCheck ((import ./nix/servant-snap.nix {}) self super);

32− testdriver = self.callCabal2nix "testdriver" ./testdriver {};

33− testserver = import nix/testserver.nix ghcjsPkgs.servant-reflex self super;

34− servant-reflex = self.callPackage ./default.nix {};

35− };

36− };

37−

38− testresults = import ./nix/testresults.nix

39− { inherit reflexPlatform;

40− inherit (ghcPkgs) testserver testdriver;

41− inherit (reflexPlatform.nixpkgs) curl;

42− phantomjs = reflexPlatform.nixpkgs.phantomjs2;

43− };

44−

45−in

46− rec {

47−

48− inherit reflexPlatform ghcPkgs ghcjsPkgs;

49−

50− build = ghcjsPkgs.servant-reflex;

51− buildGhc = ghcPkgs.servant-reflex;

52− testserver = ghcPkgs.testserver;

53− testdriver = ghcPkgs.testdriver;

54− inherit testresults;

55−

56− cabalBuild = reflexPlatform.${jsCompiler}.shellFor {

57− name = "servant-reflex-cabal-builder";

58−

59− packages = p: [

60− build

61− ];

62−

63− shellHook = ''

64− cabal configure --ghcjs -f Example

65− cabal build

66− exec/toSite.sh

67− exit $?

68− '';

69− };

70− }