bf11dea · servant-reflex

git.iko.soy/servant-reflex

on master help sign in

Merge branch 'master' into tuple-api-3

bf11deaGreg Hale7 years ago

.travis.yml+12−25

compare with master

unifiedsplit

@@ -1,30 +1,17 @@

1language: nix

2−

2+nix: 2.1.1

3−cache: false

3+sudo: require

4−

5−

6−before_install:

7− - unset CC

9install:

5install:

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

11−script:

8+before_script:

12− - git clone https://github.com/reflex-frp/reflex-platform

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

13− - cd reflex-platform && sudo echo "Yes" | ./try-reflex --command "exit 0"

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

14− - strace nix build -f ../release.nix servant-reflex

16− - nix build -f ./release.nix servant-reflex --substituters https://cache.nixos.org --substituters https://nixcache.reflex-frp.org

12+script:

17− - nix build -f ./release.nix testresults

13+ - nix-env -iA cachix -f https://cachix.org/api/v1/install

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

14+ - cachix use imalsogreg

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

15+ - nix-build travis.nix -A build

20−

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

21−cache:

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

22− directories:

23− - /nix

24− - $HOME/.cabal/packages

25− - $HOME/.cabal/store

26−

27−env:

28− global:

29− - ENCRYPTION_LABEL: "3c89d919c82e"

30− - COMMIT_AUTHOR_EMAIL: "imalsogreg@gmail.com"

changelog.md → ChangeLog.mdrenamed+6−1

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

1+0.3.4

2+-----

4+Add selenium-based test suite

10.3.3

60.3.3

2-----

7-----

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

9+- Fix encoding issue: Explicitly escape reserved characters from path pieces and query parameters

70.3.2

120.3.2

README.md+70−33

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

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

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

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](haskell-servant.readthedocs.io) combinators, you can use

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

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.

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

9−

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

12## Example

16## Example

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:

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

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

16```haskell

21```haskell

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

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

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

24 :<|> Raw

29 :<|> Raw

25```

30```

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

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

33+an `XhrRequest`.

29```haskell

35```haskell

@@ -37,7 +43,16 @@ type API = "getint" :> Get '[JSON] Int

37 (constDyn (BasePath "/"))

43 (constDyn (BasePath "/"))

38```

44```

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.

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

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.

42```haskell

57```haskell

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

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

@@ -62,7 +77,13 @@ These client functions are computed from your API type. They manage serializatio

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

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

63```

78```

80+`ReqResult tag a` is defined in

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:

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

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:

67```haskell

88```haskell

68 -- ... continued ...

89 -- ... continued ...

@@ -80,7 +101,8 @@ These client functions are computed from your API type. They manage serializatio

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

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

81```

102```

103

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

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

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

106

85```haskell

107```haskell

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

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

@@ -103,47 +125,53 @@ This example builds some input fields to enter API parameters, buttons to trigge

103 display =<< holdDyn Nothing outputDouble

125 display =<< holdDyn Nothing outputDouble

104```

126```

105

127

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.

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

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.

107

133

108

134

109## Building the library and test server

135## Building the library and test server

110

136

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

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:

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

112−

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

113−

143+manages the frontend build as a dependency.

114−First build the library:

115

144

116```

145```

117−git submodule update --init --recursive

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

118−./build.sh

119```

147```

120

148

121−Then build the test server:

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

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:

131

150

132```

151```

133−cd testserver

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

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

135```

153```

136

154

137−And simply browse to `localhost:8001`

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

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

157+under the Network tab.

138

158

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

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

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

140

161

141

162

142## Tagging requests

163## Tagging requests

143

164

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

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.

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

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

168+relationship by tagging the requests.

145

169

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:

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

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:

147

175

148```haskell

176```haskell

149 ...

177 ...

@@ -173,7 +201,10 @@ So far we have used an `Event t ()` to trigger sending a request. If we choose e

173

201

174## Simultaneous requests

202## Simultaneous requests

175

203

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:

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

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:

177

208

178```haskell

209```haskell

179sayHi

210sayHi

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

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

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

185```

216```

186

217

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.

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

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.shdeleted−3

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

1−#!/usr/bin/env bash

2−

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

default.nix+9−14

@@ -1,34 +1,29 @@

1{ mkDerivation, aeson, base, bytestring, case-insensitive

2−, containers, data-default, exceptions, generic-lens, ghcjs-dom, http-api-data

2+, containers, data-default, exceptions, ghcjs-dom, http-api-data

3−, http-media, jsaddle, mtl, network-uri, reflex, reflex-dom

3+, http-media, jsaddle, mtl, network-uri, reflex, reflex-dom-core

4−, reflex-dom-core, safe, scientific, servant, servant-auth, stdenv

4+, safe, scientific, servant, servant-auth, stdenv

5, string-conversions, text, transformers

6}:

7mkDerivation {

8 pname = "servant-reflex";

9− version = "0.3.3";

9+ version = "0.3.4";

10− # src = ./.;

11 src = builtins.filterSource

10 src = builtins.filterSource

12 (path: type:

11 (path: type:

13 baseNameOf path != "result"

12 baseNameOf path != "result"

14− && baseNameOf path != "nix"

13+ && baseNameOf path != "nix"

15− # baseNameOf (toString path) == "src" ||

16− # baseNameOf (toString path) == "exec" ||

17− # baseNameOf (toString path) == "servant-reflex.cabal"

18−

19− ) ./.;

14+ ) ./.;

20 configureFlags = [ "-fexample" ];

15 configureFlags = [ "-fexample" ];

21 isLibrary = true;

16 isLibrary = true;

22 isExecutable = true;

17 isExecutable = true;

23 libraryHaskellDepends = [

18 libraryHaskellDepends = [

24 base bytestring case-insensitive containers data-default exceptions

19 base bytestring case-insensitive containers data-default exceptions

25− generic-lens ghcjs-dom http-api-data http-media jsaddle mtl network-uri reflex

20+ ghcjs-dom http-api-data http-media jsaddle mtl network-uri reflex

26 reflex-dom-core safe servant servant-auth string-conversions text

21 reflex-dom-core safe servant servant-auth string-conversions text

27 transformers

22 transformers

28 ];

23 ];

29 executableHaskellDepends = [

24 executableHaskellDepends = [

30− aeson base reflex reflex-dom scientific servant text

25+ aeson base reflex reflex-dom-core scientific servant text

31 ];

26 ];

32− description = "Servant reflex API generator";

27+ description = "servant API generator for reflex apps";

33 license = stdenv.lib.licenses.bsd3;

28 license = stdenv.lib.licenses.bsd3;

34}

29}

exec/Example.hs+1−2

@@ -23,7 +23,7 @@ import Servant.API

23import API

24import Data.Proxy

25import Text.Read (readMaybe)

26−import Reflex.Dom hiding (run)

26+import Reflex.Dom.Core hiding (run)

27------------------------------------------------------------------------------

28import Servant.Reflex

29import Servant.Reflex.Multi

@@ -236,7 +236,6 @@ run = mdo

236

237 -- Name the computed API client functions

238 let tweakRequest = ClientOptions $ \r -> do

239− -- putStrLn ("Got req: " ++ show r)

240 return $ r & withCredentials .~ True

239 return $ r & withCredentials .~ True

241 let (getUnit :<|> getInt :<|> dblInt :<|> sayhi :<|> dbl

240 let (getUnit :<|> getInt :<|> dblInt :<|> sayhi :<|> dbl

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

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

nix/nix.confnew file+2

@@ -0,0 +1,2 @@

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

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

nix/reflex-platform.nix+7−9

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

1−{ fetchFromGitHub }:

1+let

2−

2+ rev = "a15d3a2411e7ca7d4ee4853b57c72fe83faee272";

3−

3+in import (builtins.fetchTarball

4−import (fetchFromGitHub {

4+ {

5− owner = "reflex-frp";

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

6− repo = "reflex-platform";

6+ sha256 = "1dsvw0lah7761vndip1hqal4fjpjv84ravinnfhy83jgfav5ivna";

7− rev = "04aa7c00d79a2fac81f5b302b919e1b630c20e7f";

8− sha256 = "1ckz07a839h3f8k94x2ybi9c89hqbkwnn1zxjxb0bfim8f2wqar7";

9− }) { }

7+ }) {}

nix/servant-snap.nixnew file+9

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

1+# Servant-snap is stuck a bit behind atm. But we have a fork that mostly works

2+# except for streaming, which is good enough for this test server. See:

3+# https://github.com/haskell-servant/servant-snap/issues/20

4+{ nixpkgs ? import <nixpkgs> {}}: self: super:

5+self.callCabal2nix "servant-snap" (nixpkgs.fetchgit {

6+ url = "https://github.com/antislava/servant-snap.git";

7+ rev = "fc9658e8f52ebce9e4f304ea0c6705d697d4fa84";

8+ sha256 = "0zlipmx1fb73mhpnndwmdmigxxrsdnsnb1157pgsrxpx89l9pjig";

9+}) {}

nix/testresults.nix+4−9

@@ -4,19 +4,14 @@ 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−

8− echo About to server

7+ echo About to Server

9− cd ${testserver} && ./back -q --no-access-log --no-error-log &

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

10 sleep 3

9 sleep 3

11−

12 ${curl}/bin/curl localhost:8000

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

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

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

14−

15 echo About to testdrive

12 echo About to testdrive

16− ${testdriver}/bin/spec

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

17 echo Done

14 echo Done

18− mkdir $out

19− echo Done > $out/out.txt

20 trap "exit" INT TERM

15 trap "exit" INT TERM

21 trap "kill 0" EXIT

16 trap "kill 0" EXIT

22− ''

17+ ''

nix/testserver.nix+8−24

@@ -1,25 +1,9 @@

1−{ servant-reflex, reflexPlatform }:

1+servant-reflex: self: super:

3−let

4− ghcPackages = reflexPlatform.ghc.override {

5− overrides = self: super: {

6− snap = reflexPlatform.lib.doJailbreak (self.callCabal2nix "snap" ../../snap {});

7− hspec-snap = reflexPlatform.lib.doJailbreak (super.hspec-snap);

8− servant-snap = reflexPlatform.lib.doJailbreak (super.servant-snap);

9− skylighting = reflexPlatform.lib.dontCheck super.skylighting;

10− testserver = (self.callPackage ../testserver/default.nix {}).overrideDerivation (old:

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

11− { postInstall = ''

4+ postInstall = ''

12− echo "SOURCE IS: $src"

13− echo "ls IS: $ls"

14− echo "EXAMPLE IS: ${servant-reflex}"

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

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

16− mkdir $out/static

6+ mkdir $out/static

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

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

18− '';

8+ '';

19− }

9+})

20− );

21− heist = reflexPlatform.lib.doJailbreak super.heist;

22− };

23− };

24−

25−in ghcPackages.testserver

overrides-ghc.nixdeleted−11

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

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.nixdeleted−9

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

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+13−18

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

1Name: servant-reflex

2−Version: 0.3.3

2+Version: 0.3.4

3−Synopsis: Servant reflex API generator

3+Synopsis: servant API generator for reflex apps

4−Description: Servant reflex API generator

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

5License: BSD3

6License-file: LICENSE.md

7Author: Greg Hale, Doug Beardsley

@@ -19,8 +19,6 @@ library

19 exposed-modules:

20 Servant.Reflex

21 Servant.Reflex.Multi

22− Servant.Reflex.RequestAPI

23− Servant.Reflex.RequestAPI2

25 other-modules:

23 other-modules:

26 Servant.Common.BaseUrl

24 Servant.Common.BaseUrl

@@ -28,33 +26,30 @@ library

29 hs-source-dirs: src

27 hs-source-dirs: src

30 build-depends:

28 build-depends:

31− base >= 4.8 && < 4.10,

29+ base >= 4.8 && < 5,

32 bytestring >= 0.10 && < 0.11,

30 bytestring >= 0.10 && < 0.11,

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

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

34− containers >= 0.5.6 && < 0.6,

32+ containers >= 0.5.6 && < 0.7,

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

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

36− exceptions >= 0.8 && < 0.9,

37 generic-lens,

34 generic-lens,

35+ exceptions >= 0.8 && < 0.11,

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

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

39− http-api-data >= 0.3.6 && < 0.4,

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

40− http-media >= 0.6 && < 0.8,

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

41 jsaddle >= 0.8 && < 0.10,

39 jsaddle >= 0.8 && < 0.10,

42 lens,

40 lens,

43 mtl >= 2.2.1 && < 2.3,

41 mtl >= 2.2.1 && < 2.3,

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

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

45− reflex >= 0.5 && < 0.6,

43+ reflex >= 0.5 && < 0.7,

46− -- Temporary

47− reflex-dom,

48−

49− reflex-dom-core == 0.4 && < 0.5,

44+ reflex-dom-core >= 0.4 && < 0.6,

50 safe >= 0.3.9 && < 0.4,

45 safe >= 0.3.9 && < 0.4,

51− servant >= 0.8 && < 0.13,

46+ servant >= 0.8 && < 0.18,

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

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

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

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

54 text >= 1.2 && < 1.3,

49 text >= 1.2 && < 1.3,

55 transformers >= 0.4 && < 0.6

50 transformers >= 0.4 && < 0.6

57− ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2

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

59 default-language: Haskell2010

54 default-language: Haskell2010

@@ -63,7 +58,7 @@ executable example

63 buildable: True

58 buildable: True

64 else

59 else

65 buildable: False

60 buildable: False

66− build-depends: aeson, reflex, servant-reflex, base, scientific, servant, reflex-dom, text

61+ build-depends: aeson, reflex, servant-reflex, base, scientific, servant, reflex-dom-core, 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.nix+1−3

@@ -1,3 +1 @@

1−{ compiler ? "ghcjs" }:

2−

3−(import ./release.nix { inherit compiler; }).servant-reflex.env

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

src/Servant/Common/Req.hs+21

@@ -12,6 +12,7 @@ module Servant.Common.Req where

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

14import Control.Applicative (liftA2, liftA3)

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

15import Control.Concurrent

16import Control.Concurrent

16import Control.Monad (join)

17import Control.Monad (join)

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

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

@@ -91,6 +92,13 @@ reqFailure (ResponseFailure _ s _) = Just s

91reqFailure (RequestFailure _ s) = Just s

92reqFailure (RequestFailure _ s) = Just s

92reqFailure _ = Nothing

93reqFailure _ = Nothing

95+------------------------------------------------------------------------------

96+-- | Simple filter/accessor like 'reqFailure', but keeping the request tag

97+reqFailure' :: ReqResult tag a -> Maybe (tag,Text)

98+reqFailure' (ResponseFailure tag s _) = Just (tag,s)

99+reqFailure' (RequestFailure tag s) = Just (tag,s)

100+reqFailure' _ = Nothing

101+

102

95------------------------------------------------------------------------------

103------------------------------------------------------------------------------

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

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

@@ -394,6 +402,18 @@ evalResponse decode (tag, xhr) =

394 else ResponseFailure tag errMsg xhr

402 else ResponseFailure tag errMsg xhr

395 in respPayld

403 in respPayld

396

404

405+------------------------------------------------------------------------------

406+-- | Utility for simultaneously accessing/filtering Success and Failure

407+-- response 'Event's,

408+fanReqResult :: Reflex t => Event t (ReqResult tag a) -> (Event t Text, Event t a)

409+fanReqResult = fmapMaybe reqFailure &&& fmapMaybe reqSuccess

410+

411+------------------------------------------------------------------------------

412+-- | Utility for simultaneously accessing/filtering Success and Failure

413+-- response 'Event's, but keeping the request tag

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

415+fanReqResult' = fmapMaybe reqFailure' &&& fmapMaybe reqSuccess'

416+

397

417

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

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

399note e = maybe (Left e) Right

419note e = maybe (Left e) Right

@@ -407,3 +427,4 @@ builderToText = TE.decodeUtf8 . BL.toStrict . Builder.toLazyByteString

407

427

408escape :: T.Text -> T.Text

428escape :: T.Text -> T.Text

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

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

430+

src/Servant/Reflex.hs+81−48

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

8{-# LANGUAGE MultiParamTypeClasses #-}

9{-# LANGUAGE OverloadedStrings #-}

10{-# LANGUAGE PolyKinds #-}

11+{-# LANGUAGE Rank2Types #-}

11{-# LANGUAGE ScopedTypeVariables #-}

12{-# LANGUAGE ScopedTypeVariables #-}

12{-# LANGUAGE TupleSections #-}

13{-# LANGUAGE TupleSections #-}

13{-# LANGUAGE TypeFamilies #-}

14{-# LANGUAGE TypeFamilies #-}

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

25module Servant.Reflex

26module Servant.Reflex

26 ( client

27 ( client

27 , clientWithOpts

28 , clientWithOpts

29+ , clientWithOptsAndResultHandler

28 , clientWithRoute

30 , clientWithRoute

31+ , clientWithRouteAndResultHandler

29 , BuildHeaderKeysTo(..)

32 , BuildHeaderKeysTo(..)

30 , toHeaders

33 , toHeaders

31 , HasClient

34 , HasClient

@@ -120,21 +123,53 @@ clientWithOpts

120 -> Client t m layout tag

123 -> Client t m layout tag

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

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

122

125

126+-- | Like 'clientWithOpts' but allows passing a function which will process the

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

128+-- across call sites.

129+clientWithOptsAndResultHandler

130+ :: (HasClient t m layout tag)

131+ => Proxy layout

132+ -> Proxy m

133+ -> Proxy tag

134+ -> Dynamic t BaseUrl

135+ -> ClientOptions

136+ -> (forall a. Event t (ReqResult tag a) -> m (Event t (ReqResult tag a)))

137+ -> Client t m layout tag

138+clientWithOptsAndResultHandler p q t = clientWithRouteAndResultHandler p q t defReq

139+

123

140

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

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

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

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

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

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

127−class HasClient t m layout (tag :: *) where

144+class Monad m => HasClient t m layout (tag :: *) where

128 type Client t m layout tag :: *

145 type Client t m layout tag :: *

129− clientWithRoute :: Proxy layout -> Proxy m -> Proxy tag -> Req t -> Dynamic t BaseUrl -> ClientOptions -> Client t m layout tag

146+ clientWithRoute

147+ :: Proxy layout

148+ -> Proxy m

149+ -> Proxy tag

150+ -> Req t

151+ -> Dynamic t BaseUrl

152+ -> ClientOptions

153+ -> Client t m layout tag

154+ clientWithRoute l m t r b o = clientWithRouteAndResultHandler l m t r b o return

155+

156+ clientWithRouteAndResultHandler

157+ :: Proxy layout

158+ -> Proxy m

159+ -> Proxy tag

160+ -> Req t

161+ -> Dynamic t BaseUrl

162+ -> ClientOptions

163+ -> (forall a. Event t (ReqResult tag a) -> m (Event t (ReqResult tag a)))

164+ -> Client t m layout tag

130

165

131

166

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

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

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

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

134

169

135− clientWithRoute Proxy q pTag req baseurl opts =

170+ clientWithRouteAndResultHandler Proxy q pTag req baseurl opts wrap =

136− clientWithRoute (Proxy :: Proxy a) q pTag req baseurl opts :<|>

171+ clientWithRouteAndResultHandler (Proxy :: Proxy a) q pTag req baseurl opts wrap :<|>

137− clientWithRoute (Proxy :: Proxy b) q pTag req baseurl opts

172+ clientWithRouteAndResultHandler (Proxy :: Proxy b) q pTag req baseurl opts wrap

138

173

139

174

140-- Capture. Example:

175-- Capture. Example:

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

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

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

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

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

157

192

158− clientWithRoute Proxy q t req baseurl opts val =

193+ clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap val =

159− clientWithRoute (Proxy :: Proxy sublayout)

194+ clientWithRouteAndResultHandler

160− q t

161− (prependToPathParts p req)

195+ (Proxy :: Proxy sublayout) q t (prependToPathParts p req) baseurl opts wrap

162− baseurl opts

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

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

164

197

165

198

@@ -172,8 +205,8 @@ instance {-# OVERLAPPABLE #-}

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

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

173 -- TODO how to access input types here?

206 -- TODO how to access input types here?

174 -- ExceptT ServantError IO a

207 -- ExceptT ServantError IO a

175− clientWithRoute Proxy _ _ req baseurl opts trigs =

208+ clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs =

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

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

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

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

178 req' = req { reqMethod = method }

211 req' = req { reqMethod = method }

179

212

@@ -186,8 +219,8 @@ instance {-# OVERLAPPING #-}

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

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

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

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

188 -- ExceptT ServantError IO NoContent

221 -- ExceptT ServantError IO NoContent

189− clientWithRoute Proxy _ _ req baseurl opts =

222+ clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs =

190− (fmap . fmap) runIdentity . performRequestsNoBody method (constDyn $ Identity req) baseurl opts

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

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

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

192

225

193

226

@@ -223,10 +256,10 @@ instance {-# OVERLAPPABLE #-}

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

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

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

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

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

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

226− clientWithRoute Proxy _ _ req baseurl opts trigs = do

259+ clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs = do

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

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

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

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

229− return $ toHeaders <$> resp

262+ wrap $ toHeaders <$> resp

230 where req' = req { respHeaders =

263 where req' = req { respHeaders =

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

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

232 }

265 }

@@ -239,10 +272,10 @@ instance {-# OVERLAPPABLE #-}

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

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

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

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

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

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

242− clientWithRoute Proxy _ _ req baseurl opts trigs = do

275+ clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs = do

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

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

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

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

245− return $ toHeaders <$> resp

278+ wrap $ toHeaders <$> resp

246 where req' = req {respHeaders =

279 where req' = req {respHeaders =

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

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

248 }

281 }

@@ -269,11 +302,11 @@ instance (KnownSymbol sym, ToHttpApiData a,

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

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

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

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

271

304

272− clientWithRoute Proxy q t req baseurl opts eVal =

305+ clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap eVal =

306+ clientWithRouteAndResultHandler

273− clientWithRoute (Proxy :: Proxy sublayout)

307+ (Proxy :: Proxy sublayout) q t

274− q t

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

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

276− baseurl opts

309+ baseurl opts wrap

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

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

278

311

279

312

@@ -287,8 +320,8 @@ instance HasClient t m sublayout tag

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

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

288 Client t m sublayout tag

321 Client t m sublayout tag

289

322

290− clientWithRoute Proxy q t =

323+ clientWithRouteAndResultHandler Proxy =

291− clientWithRoute (Proxy :: Proxy sublayout) q t

324+ clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)

292

325

293

326

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

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

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

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

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

325

358

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

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

327− clientWithRoute Proxy q t req baseurl opts mparam =

360+ clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap mparam =

328− clientWithRoute (Proxy :: Proxy sublayout) q t

361+ clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t

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

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

330

363

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

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

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

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

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

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

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

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

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

372

405

373− clientWithRoute Proxy q t req baseurl opts paramlist =

406+ clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap paramlist =

374− clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl opts

407+ clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap

375

408

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

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

377 pname = symbolVal (Proxy :: Proxy sym)

410 pname = symbolVal (Proxy :: Proxy sym)

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

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

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

411 Dynamic t Bool -> Client t m sublayout tag

444 Dynamic t Bool -> Client t m sublayout tag

412

445

413− clientWithRoute Proxy q t req baseurl opts flag =

446+ clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap flag =

414− clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl opts

447+ clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap

415

448

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

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

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

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

@@ -425,7 +458,7 @@ instance SupportsServantReflex t m => HasClient t m Raw tag where

425 -> Event t tag

458 -> Event t tag

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

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

427

460

428− clientWithRoute _ _ _ _ baseurl _ xhrs triggers = do

461+ clientWithRouteAndResultHandler _ _ _ _ baseurl _ wrap xhrs triggers = do

429

462

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

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

431 Left e -> Left e

464 Left e -> Left e

@@ -436,7 +469,7 @@ instance SupportsServantReflex t m => HasClient t m Raw tag where

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

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

437

470

438 resps <- performRequestsAsync okReq

471 resps <- performRequestsAsync okReq

439− return $ leftmost [ uncurry RequestFailure <$> badReq

472+ wrap $ leftmost [ uncurry RequestFailure <$> badReq

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

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

441 ]

474 ]

442

475

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

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

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

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

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

469

502

470− clientWithRoute Proxy q t req baseurl opts body =

503+ clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap body =

471− clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl opts

504+ clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap

472 where req' = req { reqBody = bodyBytesCT }

505 where req' = req { reqBody = bodyBytesCT }

473 ctProxy = Proxy :: Proxy ct

506 ctProxy = Proxy :: Proxy ct

474 ctString = T.pack $ show $ contentType ctProxy

507 ctString = T.pack $ show $ contentType ctProxy

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

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

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

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

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

484

517

485− clientWithRoute Proxy q t req baseurl opts =

518+ clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap =

486− clientWithRoute (Proxy :: Proxy sublayout) q t

519+ clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t

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

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

488

521

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

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

490

523

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

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

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

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

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

494

527

495− clientWithRoute Proxy q t req baseurl =

528+ clientWithRouteAndResultHandler Proxy =

496− clientWithRoute (Proxy :: Proxy api) q t req baseurl

529+ clientWithRouteAndResultHandler (Proxy :: Proxy api)

497

530

498

531

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

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

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

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

501

534

502− clientWithRoute Proxy q t req baseurl =

535+ clientWithRouteAndResultHandler Proxy =

503− clientWithRoute (Proxy :: Proxy api) q t req baseurl

536+ clientWithRouteAndResultHandler (Proxy :: Proxy api)

504

537

505

538

506

539

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

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

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

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

509

542

510− clientWithRoute Proxy q t req baseurl =

543+ clientWithRouteAndResultHandler Proxy =

511− clientWithRoute (Proxy :: Proxy api) q t req baseurl

544+ clientWithRouteAndResultHandler (Proxy :: Proxy api)

512

545

513

546

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

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

@@ -517,8 +550,8 @@ instance (HasClient t m api tag, Reflex t)

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

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

518 -> Client t m api tag

551 -> Client t m api tag

519

552

520− clientWithRoute Proxy q t req baseurl opts authdata =

553+ clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap authdata =

521− clientWithRoute (Proxy :: Proxy api) q t req' baseurl opts

554+ clientWithRouteAndResultHandler (Proxy :: Proxy api) q t req' baseurl opts wrap

522 where

555 where

523 req' = req { authData = Just authdata }

556 req' = req { authData = Just authdata }

524

557

@@ -561,7 +594,7 @@ for empty and one for non-empty lists).

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

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

562

595

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

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

564− clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy api)

597+ clientWithRouteAndResultHandler Proxy = clientWithRouteAndResultHandler (Proxy :: Proxy api)

565

598

566

599

567type family HasCookieAuth xs :: Constraint where

600type family HasCookieAuth xs :: Constraint where

testdriver/test/Servant/ReflexSpec.hs+1

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

9import Data.Foldable

10import Test.WebDriver.Commands.Wait

11import Test.Hspec.WebDriver

12+import Test.Hspec.WebDriver (chromeCaps)

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

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

testserver/API.hs+1−4

@@ -31,7 +31,6 @@ instance FromJSON Answer where

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

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

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

34− :<|> "dblint" :> Capture "anint" Int :> Get '[JSON] Int

35 :<|> "sayhi" :> QueryParam "username" Text

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

36 :> QueryParams "greetings" Text

35 :> QueryParams "greetings" Text

37 :> QueryFlag "gusto"

36 :> QueryFlag "gusto"

@@ -40,9 +39,7 @@ type API = "getunit" :> Get '[JSON] ()

40 :> Post '[JSON] Double

39 :> Post '[JSON] Double

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

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

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

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

43− :> Header "qnum" Int

44− :> Header "is-favorite" Bool

45− :> Post '[JSON] (Headers '[Header "anum" Int, Header "was-favorite" Bool] Answer)

42+ :> Post '[JSON] Answer

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

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

47 :<|> Raw

44 :<|> Raw

testserver/Main.hs+10−5

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

7{-# LANGUAGE TypeOperators #-}

9import Control.Monad.IO.Class (liftIO)

10+import Control.Monad.Reader (reader)

10import Data.Aeson

11import Data.Aeson

11import Data.Bool

12import Data.Bool

12import Data.Char (toUpper)

13import Data.Char (toUpper)

@@ -26,6 +27,7 @@ import Servant

26import Servant.Server ()

27import Servant.Server ()

27import System.Directory

28import System.Directory

28-- import Snap.Util.FileServe

29-- import Snap.Util.FileServe

30+import System.Environment (lookupEnv)

29import API

31import API

30import Snap hiding (addHeader)

32import Snap hiding (addHeader)

@@ -41,7 +43,7 @@ instance ToJSON Greet

41testApi :: Proxy API

43testApi :: Proxy API

42testApi = Proxy

44testApi = Proxy

44−data App = App

46+data App = App { appStaticDir :: String }

46-- Server-side handlers.

48-- Server-side handlers.

47--

49--

@@ -51,7 +53,8 @@ data App = App

51-- Each handler runs in the 'ExceptT ServantErr IO' monad.

53-- Each handler runs in the 'ExceptT ServantErr IO' monad.

52server :: Server API '[BasicAuthCheck (Handler App App) ()] (Handler App App)

54server :: Server API '[BasicAuthCheck (Handler App App) ()] (Handler App App)

53server = return () :<|> return 100 :<|> dblint :<|> sayhi :<|> dbl

55server = return () :<|> return 100 :<|> dblint :<|> sayhi :<|> dbl

54− :<|> multi :<|> qna :<|> serveSecret :<|> serveDirectory "static"

56+ :<|> multi :<|> qna :<|> serveSecret

57+ :<|> statics

55 where sayhi :: Maybe Text -> [Text] -> Bool -> Handler App App Text

58 where sayhi :: Maybe Text -> [Text] -> Bool -> Handler App App Text

56 sayhi nm greetings withGusto = case nm of

59 sayhi nm greetings withGusto = case nm of

57 Nothing -> return ("Sorry, who are you?" :: Text)

60 Nothing -> return ("Sorry, who are you?" :: Text)

@@ -77,6 +80,9 @@ server = return () :<|> return 100 :<|> dblint :<|> sayhi :<|> dbl

77 req <- getRequest

80 req <- getRequest

78 liftIO $ putStrLn (show req)

81 liftIO $ putStrLn (show req)

79 return 101

82 return 101

83+ statics = do

84+ staticDir <- reader appStaticDir

85+ serveDirectory staticDir

81-- Turn the server into a WAI app. 'serve' is provided by servant,

87-- Turn the server into a WAI app. 'serve' is provided by servant,

82-- more precisely by the Servant.Server module.

88-- more precisely by the Servant.Server module.

@@ -86,12 +92,11 @@ test = serveSnapWithContext testApi

87initApp :: SnapletInit App App

93initApp :: SnapletInit App App

88initApp = makeSnaplet "myapp" "example" Nothing $ do

94initApp = makeSnaplet "myapp" "example" Nothing $ do

89− liftIO $ print =<< listDirectory "."

95+ staticDir <- fromMaybe "static" <$> liftIO (lookupEnv "STATIC_DIR")

90− liftIO $ print =<< listDirectory "static"

91 addRoutes [("", test)

96 addRoutes [("", test)

92 ,("", serveDirectory "static")

97 ,("", serveDirectory "static")

93 ]

98 ]

94− return App

99+ return (App staticDir)

100

96-- Put this all to work!

101-- Put this all to work!

97main :: IO ()

102main :: IO ()

testserver/run-wd-tests.shdeleted−5

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

1−#!/usr/bin/env bash

2−

3−dist/build/back/back -p 8000 &

4−phantomjs --webdriver=127.0.0.1:4444 &

5−dist/build/spec/spec

testserver/testserver.cabal+4−4

@@ -20,12 +20,12 @@ executable back

20 -- other-modules:

21 -- other-extensions:

22 build-depends: aeson >= 0.9 && < 1.4

23− , base >=4.8 && <4.11

23+ , base >=4.8 && <4.14

24− , directory >= 1.2 && < 1.4

24+ , mtl

25 , snap >= 1.0 && < 1.2

26− , snap-server >= 1.0 && < 1.1

26+ , snap-server >= 1.0 && < 1.2

27 , snap-core >= 1.0 && < 1.1

28− , servant >= 0.8 && < 0.12

28+ , servant >= 0.8 && < 0.15

29 , servant-snap >= 0.8 && < 0.9

30 , text >= 1.0 && < 1.3

31 -- hs-source-dirs:

testserver/tr.nixdeleted−32

@@ -1,32 +0,0 @@

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

2−let

3−

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.nixnew file+69

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

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)

6+ jsCompiler ? "ghcjs"

7+ # ^ Choose a GHCJS for compiling the frontend

8+ # (ghcjs, ghcjs8_0, ghcjs8_2 or ghcjs8_4)

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+ testserver = ghcPkgs.testserver;

52+ testdriver = ghcPkgs.testdriver;

53+ inherit testresults;

54+

55+ cabalBuild = reflexPlatform.${jsCompiler}.shellFor {

56+ name = "servant-reflex-cabal-builder";

57+

58+ packages = p: [

59+ build

60+ ];

61+

62+ shellHook = ''

63+ cabal configure --ghcjs -f Example

64+ cabal build

65+ exec/toSite.sh

66+ exit $?

67+ '';

68+ };

69+ }