master..e18d6bd · servant-reflex

.gitignore−2

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

77*.stats

88out

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

2−nix: 2.3.6

3−sudo: require

1+sudo: required

2+

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

6+

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+

421

522before_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

726

8−before_script:

9− - sudo systemctl restart nix-daemon.service

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

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

27+install:

28+ - cabal --version

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

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

1245

1346script:

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

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

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

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

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

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

49+ - ./build.sh

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

44

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

66

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

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

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+Syncronization between is checked at compile time, and rather than building XHR requests by hand, API endpoints are available behind `reflex`'s FRP semantics.

9+

1410

1511

1612## Example

1713

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:

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:

2015

2116```haskell

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

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

2924 :<|> Raw

3025```

3126

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

33−an `XhrRequest`.

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

3428

3529```haskell

3630

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

4337 (constDyn (BasePath "/"))

4438```

4539

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.

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.

5641

5742```haskell

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

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

7863```

7964

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)

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:

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:

8766

8867```haskell

8968 -- ... continued ...

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

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

10281```

10382

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:

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

10684

10785```haskell

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

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

125103 display =<< holdDyn Nothing outputDouble

126104```

127105

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.

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.

133107

134108

135109## Building the library and test server

136110

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

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

143−manages the frontend build as a dependency.

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:

112+

113+

114+First build the library:

144115

145116```

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

117+git submodule update --init --recursive

118+./build.sh

147119```

148120

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:

150131

151132```

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

133+cd testserver

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

153135```

154136

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.

137+And simply browse to `localhost:8001`

158138

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

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

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

161140

162141

163142## Tagging requests

164143

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

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

168−relationship by tagging the requests.

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.

169145

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:

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:

175147

176148```haskell

177149 ...

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

201173

202174## Simultaneous requests

203175

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:

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:

208177

209178```haskell

210179sayHi

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

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

216185```

217186

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.

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.

build.shnew file+3

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

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"

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−

1410.3.3

152-----

163

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

185

196

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

2121import API

2222import Data.Proxy

2323import Text.Read (readMaybe)

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

25−import Reflex.Dom (mainWidget)

24+import Reflex.Dom hiding (run)

2625------------------------------------------------------------------------------

2726import Servant.Reflex

2827import Servant.Reflex.Multi

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

9897

9998 -- Name the computed API client functions

10099 let tweakRequest = ClientOptions $ \r -> do

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

101101 return $ r & withCredentials .~ True

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

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

11Name: servant-reflex

2−Version: 0.3.6

3−Synopsis: servant API generator for reflex apps

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

2+Version: 0.3.3

3+Synopsis: Servant reflex API generator

4+Description: Servant reflex API generator

55License: BSD3

66License-file: LICENSE.md

77Author: Greg Hale, Doug Beardsley

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

1717

1818library

1919 exposed-modules:

20− Servant.Common.BaseUrl

21− Servant.Common.Req

2220 Servant.Reflex

2321 Servant.Reflex.Multi

2422

23+ other-modules:

24+ Servant.Common.BaseUrl

25+ Servant.Common.Req

26+

2527 hs-source-dirs: src

2628 build-depends:

27− base >= 4.8 && < 5,

29+ base >= 4.8 && < 4.10,

30+ aeson >= 0.11 && < 1.3,

2831 bytestring >= 0.10 && < 0.11,

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

30− containers >= 0.5.6 && < 0.7,

33+ containers >= 0.5.6 && < 0.6,

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

32− exceptions >= 0.8 && < 0.11,

35+ exceptions >= 0.8 && < 0.9,

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

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

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

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

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

3639 jsaddle >= 0.8 && < 0.10,

3740 mtl >= 2.2.1 && < 2.3,

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

39− reflex >= 0.5 && < 0.9,

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

42+ reflex >= 0.5 && < 0.6,

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

4144 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,

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

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

4549 text >= 1.2 && < 1.3,

4650 transformers >= 0.4 && < 0.6

4751

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

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

4953

5054 default-language: Haskell2010

5155

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

5458 buildable: True

5559 else

5660 buildable: False

57− build-depends:

58− aeson,

59− reflex,

60− servant-reflex,

61− base,

62− scientific,

63− servant,

64− reflex-dom,

65− reflex-dom-core,

66− text

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

6762 default-language: Haskell2010

6863 main-is: Example.hs

6964 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

8585 where pathWidget :: m (Dynamic t BaseUrl)

8686 pathWidget = do

8787 text "Url base path"

88− t <- inputElement def

88+ t <- textInput (def {_textInputConfig_attributes =

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

8990 return $ BasePath <$> value t

9091 fullUrlWidget :: m (Dynamic t BaseUrl)

9192 fullUrlWidget = do

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

93− srv <- inputElement def

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

9495 text ":"

95− prt <- inputElement def

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

9697 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" }

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

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

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

88{-# LANGUAGE ScopedTypeVariables #-}

99{-# LANGUAGE TupleSections #-}

1010

11+{-# LANGUAGE MultiParamTypeClasses #-}

12+{-# LANGUAGE FlexibleInstances #-}

1113module Servant.Common.Req where

1214

1315-------------------------------------------------------------------------------

1416import Control.Applicative (liftA2, liftA3)

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

1617import Control.Concurrent

1718import Control.Monad (join)

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

20+import Data.Aeson

1921import 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)

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

22−import Data.ByteString (ByteString)

2326import qualified Data.Map as Map

2427import Data.Maybe (catMaybes, fromMaybe)

2528import Data.Functor.Compose

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

2730import Data.Proxy (Proxy(..))

2831import Data.Text (Text)

2932import 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

3135import Data.Traversable (forM)

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

37+import qualified Language.Javascript.JSaddle as JS

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

3339import qualified Network.URI as N

3440import Reflex.Dom.Core hiding (tag)

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

3642 SupportsServantReflex)

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

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

44+ , OctetStream, PlainText

45+ , FormUrlEncoded)

3846import Web.HttpApiData (ToHttpApiData(..))

47+import Web.FormUrlEncoded (FromForm, urlDecodeAsForm)

3948-------------------------------------------------------------------------------

4049import Servant.API.BasicAuth

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

4151

4252

4353------------------------------------------------------------------------------

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

93103reqFailure (RequestFailure _ s) = Just s

94104reqFailure _ = Nothing

95105

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−

103106

104107------------------------------------------------------------------------------

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

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

159162 req { reqPathParts = p : reqPathParts req }

160163

161164addHeader :: (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 }

163166

164167

165168reqToReflexRequest

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

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

233236 , _xhrRequestConfig_user = Nothing

234237 , _xhrRequestConfig_password = Nothing

235− , _xhrRequestConfig_responseType = Just XhrResponseType_ArrayBuffer

238+ , _xhrRequestConfig_responseType = Nothing

236239 , _xhrRequestConfig_withCredentials = False

237240 , _xhrRequestConfig_responseHeaders = def

238241 }

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

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

245248 , _xhrRequestConfig_user = Nothing

246249 , _xhrRequestConfig_password = Nothing

247− , _xhrRequestConfig_responseType = Just XhrResponseType_ArrayBuffer

248− , _xhrRequestConfig_sendData = mempty

250+ , _xhrRequestConfig_responseType = Nothing

251+ , _xhrRequestConfig_sendData = ""

249252 , _xhrRequestConfig_withCredentials = False

250253 }

251254 Just rBody -> liftA2 mkConfigBody xhrHeaders rBody

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

254257 mkAuth _ (Left e) = Left e

255258 mkAuth Nothing r = r

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

257− { _xhrRequestConfig_user = Just $ TE.decodeUtf8 u

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

260+ { _xhrRequestConfig_user = Just $ T.decodeUtf8 u

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

259262

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

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

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

335338 return ()

336339

337340

338−

339−type XhrPayload = ByteString

341+type XhrPayload = T.Text

340342bytesToPayload :: BL.ByteString -> XhrPayload

341−bytesToPayload = BL.toStrict

343+bytesToPayload = T.decodeUtf8 . BL.toStrict

342344

343345

344346performRequestsCT

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

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

354356performRequestsCT ct reqMeth reqs reqHost opts trigger = do

355357 resps <- performRequests reqMeth reqs reqHost opts trigger

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

357− first T.pack .

358− mimeUnrender ct $

359− BL.fromStrict x

360− decodeResp _ = Left "No body"

358+ let decodeResp x = first T.pack

359+ . mimeUnrender ct

360+ . JS.textToJSString

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

361362 return $ fmap

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

363364 Left e -> RequestFailure t e

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

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

365366 )

366367 resps

367368

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

388389 :: (XhrResponse -> Either Text a)

389390 -> (tag, XhrResponse)

390391 -> ReqResult tag a

391−evalResponse decode (tag, xhr) =

392+evalResponse decodeRes (tag, xhr) =

392393 let status = _xhrResponse_status xhr

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

394395 errMsg = fromMaybe

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

399400 then either

400401 (\e -> ResponseFailure tag e xhr)

401402 (\v -> ResponseSuccess tag v xhr)

402− (decode xhr)

403+ (decodeRes xhr)

403404 else ResponseFailure tag errMsg xhr

404405 in respPayld

405406

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

411407

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

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

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

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

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

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

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

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

411+class Accept contentType => MimeUnrender contentType a where

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

417416

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

418442

419443note :: 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

421446

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

423448fmapL _ (Right a) = Right a

424449fmapL f (Left e) = Left (f e)

425450

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

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

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

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

428453

429454escape :: T.Text -> T.Text

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

431−

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

src/Servant/Reflex.hs+166−43

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

3939

4040------------------------------------------------------------------------------

4141import Control.Applicative

42−import qualified Data.CaseInsensitive as CI

43−import Data.Functor.Identity

44−import qualified Data.Map as Map

4542import Data.Monoid ((<>))

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

4743import qualified Data.Set as Set

44+import qualified Data.Text.Encoding as E

45+import Data.CaseInsensitive (mk)

46+import Data.Functor.Identity

47+import Data.Proxy (Proxy (..))

48+import qualified Data.Map as Map

4849import Data.Text (Text)

4950import qualified Data.Text as T

50−import qualified Data.Text.Encoding as E

5151import GHC.Exts (Constraint)

5252import GHC.TypeLits (KnownSymbol, symbolVal)

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

54− BasicAuthData, BuildHeadersTo (..),

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

56− HttpVersion, IsSecure,

57− MimeRender (..), MimeUnrender,

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

54+ BasicAuthData, BuildHeadersTo(..),

55+ Capture, contentType, Header,

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

57+ MimeRender(..),

5858 NoContent, QueryFlag, QueryParam,

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

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

6060 RemoteHost, ReqBody,

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

62− contentType)

63−import Servant.API.Description (Summary)

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

6462import qualified Servant.Auth as Auth

6563

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

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

68− XhrResponseHeaders (..),

69− attachPromptlyDynWith, constDyn, ffor,

70− fmapMaybe, leftmost,

71− performRequestsAsync)

65+ XhrRequest(..),

66+ XhrResponseHeaders(..),

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

68+ leftmost, performRequestsAsync,

69+ )

7270------------------------------------------------------------------------------

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

7472 showBaseUrl,

7573 SupportsServantReflex)

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

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

7775 defaultClientOptions,

7876 Req, ReqResult(..), QParam(..),

7977 QueryPart(..), addHeader, authData,

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

8987 response,

9088 reqTag,

9189 qParams, withCredentials)

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

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

9292

9393

9494-- * Accessing APIs as a Client

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

103103-- >

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

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

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

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

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

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

109109client

@@ -228,26 +228,22 @@ instance {-# OVERLAPPING #-}

228228

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

230230toHeaders r =

231− let hdrs = maybe []

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

231+ let toBS = E.encodeUtf8

232+ hdrs = maybe []

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

233234 (Map.toList $ _xhrResponse_headers xhr))

234235 (response r)

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

236237

237−

238238class BuildHeaderKeysTo hs where

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

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

240240

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

242242 where buildHeaderKeysTo _ = []

243243

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

245245 => 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)

250−

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

251247

252248-- HEADERS Verb (Content) --

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

@@ -329,19 +325,6 @@ instance HasClient t m sublayout tag

329325 clientWithRouteAndResultHandler Proxy =

330326 clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)

331327

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−

345328

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

347330-- the corresponding querying function will automatically take

@@ -623,3 +606,143 @@ type family HasCookieAuth xs :: Constraint where

623606

624607class CookieAuthNotEnabled

625608

609+{- servant-checked-exceptions

610+~~~~~~~~~~~~~~~~~~~~~

611+-}

612+

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

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

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

616+

617+ clientWithRouteAndResultHandler

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

619+ -> Proxy m

620+ -> Proxy tag

621+ -> Req t

622+ -> Dynamic t BaseUrl

623+ -> ClientOptions

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

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

626+ clientWithRouteAndResultHandler _ = clientWithRouteAndResultHandler (Proxy :: Proxy (Throwing '[e] :> api))

627+

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

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

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

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

632+

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

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

635+

636+ clientWithRouteAndResultHandler

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

638+ -> Proxy m

639+ -> Proxy tag

640+ -> Req t

641+ -> Dynamic t BaseUrl

642+ -> ClientOptions

643+ -> (forall x. Event t (ReqResult tag x) -> m (Event t (ReqResult tag x)))

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

645+ clientWithRouteAndResultHandler Proxy =

646+ clientWithRouteAndResultHandler (Proxy :: Proxy (Verb method status ctypes (Envelope es a)))

647+

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

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

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

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

652+

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

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

655+

656+ clientWithRouteAndResultHandler

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

658+ -> Proxy m

659+ -> Proxy tag

660+ -> Req t

661+ -> Dynamic t BaseUrl

662+ -> ClientOptions

663+ -> (forall x. Event t (ReqResult tag x) -> m (Event t (ReqResult tag x)))

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

665+ clientWithRouteAndResultHandler Proxy =

666+ clientWithRouteAndResultHandler (Proxy :: Proxy (Verb method status ctypes (Envelope '[] a)))

667+

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

669+-- branch of the API.

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

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

672+

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

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

675+

676+ clientWithRouteAndResultHandler

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

678+ -> Proxy m

679+ -> Proxy tag

680+ -> Req t

681+ -> Dynamic t BaseUrl

682+ -> ClientOptions

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

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

685+ clientWithRouteAndResultHandler _ =

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

687+

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

689+-- API.

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

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

692+

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

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

695+

696+ clientWithRouteAndResultHandler

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

698+ -> Proxy m

699+ -> Proxy tag

700+ -> Req t

701+ -> Dynamic t BaseUrl

702+ -> ClientOptions

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

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

705+ clientWithRouteAndResultHandler _ =

706+ clientWithRouteAndResultHandler (Proxy :: Proxy ((NoThrow :> api1) :<|> (NoThrow :> api2)))

707+

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

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

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

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

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

713+

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

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

716+

717+ clientWithRouteAndResultHandler

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

719+ -> Proxy m

720+ -> Proxy tag

721+ -> Req t

722+ -> Dynamic t BaseUrl

723+ -> ClientOptions

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

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

726+ clientWithRouteAndResultHandler _ =

727+ clientWithRouteAndResultHandler (Proxy :: Proxy (ThrowingNonterminal (Throwing es :> api :> apis)))

728+

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

730+-- closer to the 'Verb'.

731+instance (Monad m, HasClient t m (api :> NoThrow :> apis) tag) =>

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

733+

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

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

736+

737+ clientWithRouteAndResultHandler

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

739+ -> Proxy m

740+ -> Proxy tag

741+ -> Req t

742+ -> Dynamic t BaseUrl

743+ -> ClientOptions

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

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

746+ clientWithRouteAndResultHandler _ =

747+ clientWithRouteAndResultHandler (Proxy :: Proxy (api :> NoThrow :> apis))

748+

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

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

3737 ) where

3838

3939------------------------------------------------------------------------------

40−import Control.Applicative (liftA2)

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

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

43−import qualified Data.Set as Set

44−import Data.Text (Text)

45−import qualified Data.Text as T

46−import qualified Data.Text.Encoding as E

47−import GHC.TypeLits (KnownSymbol, symbolVal)

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

49− BasicAuthData, BuildHeadersTo (..),

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

51− HttpVersion, IsSecure,

52− MimeRender (..), MimeUnrender,

53− NoContent, QueryFlag, QueryParam,

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

55− RemoteHost, ReqBody,

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

57− contentType)

58−import Servant.API.Description (Summary)

59−

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

61− XhrRequest (..),

62− XhrResponseHeaders (..),

63− attachPromptlyDynWith, constDyn)

40+import Control.Applicative (liftA2)

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

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

43+import qualified Data.Set as Set

44+import Data.Text (Text)

45+import qualified Data.Text as T

46+import qualified Data.Text.Encoding as E

47+import GHC.TypeLits (KnownSymbol, symbolVal)

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

49+ BasicAuthData, BuildHeadersTo (..),

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

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

52+ NoContent, QueryFlag,

53+ QueryParam, QueryParams, Raw,

54+ ReflectMethod (..), RemoteHost,

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

56+ Verb, contentType)

57+

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

59+ XhrRequest (..),

60+ XhrResponseHeaders (..),

61+ attachPromptlyDynWith, constDyn)

6462------------------------------------------------------------------------------

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

6664 SupportsServantReflex)

67−import Servant.Common.Req (ClientOptions,

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

6866 QParam (..), QueryPart (..), Req,

6967 ReqResult (..), addHeader, authData,

7068 defReq,

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

7674 qParams, reqBody, reqFailure,

7775 reqMethod, reqSuccess, reqSuccess',

7876 respHeaders, response, withCredentials)

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

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

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

8080

8181

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

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

243243

244244

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−

256245------------------------------------------------------------------------------

257246instance (KnownSymbol sym,

258247 ToHttpApiData a,

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

399388 where

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

401390 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

99import Data.Foldable

1010import Test.WebDriver.Commands.Wait

1111import Test.Hspec.WebDriver

12−import Test.Hspec.WebDriver (chromeCaps)

1312

1413

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

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

2928spec = do

3029 describe "servant-reflex tests" $ do

3130

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

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

3332

3433 it "opens the page" $ runWD $

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

77{-# LANGUAGE TypeOperators #-}

88

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

10−import Control.Monad.Reader (reader)

1110import Data.Aeson

1211import Data.Bool

1312import Data.Char (toUpper)

1413import qualified Data.List as L

15−import Data.Maybe (fromMaybe)

1614import Data.Monoid

1715import Data.Proxy

1816import Data.Text hiding (head, length, map,

@@ -27,7 +25,6 @@ import Snap.Http.Server

2725import Servant

2826import Servant.Server

2927-- import Snap.Util.FileServe

30−import System.Environment (lookupEnv)

3128import API

3229import Snap

3330

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

4340testApi :: Proxy API

4441testApi = Proxy

4542

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

43+data App = App

4744

4845-- Server-side handlers.

4946--

@@ -54,7 +51,7 @@ data App = App { appStaticDir :: String }

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

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

5653 :<|> multi :<|> qna :<|> serveSecret

57− :<|> statics

54+ :<|> serveDirectory "static"

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

5956 sayhi nm greetings withGusto = case nm of

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

@@ -79,9 +76,6 @@ server = return () :<|> return 100 :<|> sayhi :<|> dbl

7976 req <- getRequest

8077 liftIO $ putStrLn (show req)

8178 return 101

82− statics = do

83− staticDir <- reader appStaticDir

84− serveDirectory staticDir

8579

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

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

@@ -91,11 +85,10 @@ test = serveSnapWithContext testApi

9185

9286initApp :: SnapletInit App App

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

94− staticDir <- fromMaybe "static" <$> liftIO (lookupEnv "STATIC_DIR")

9588 addRoutes [("", test)

9689 ,("", serveDirectory "static")

9790 ]

98− return (App staticDir)

91+ return App

9992

10093-- Put this all to work!

10194main :: IO ()

testserver/run-wd-tests.shnew file+5

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

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−5

@@ -19,13 +19,12 @@ executable back

1919 main-is: Main.hs

2020 -- other-modules:

2121 -- other-extensions:

22− build-depends: aeson >= 0.9 && < 1.5

23− , base >=4.8 && < 5

24− , mtl

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

23+ , base >=4.8 && <4.11

2524 , snap >= 1.0 && < 1.2

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

25+ , snap-server >= 1.0 && < 1.1

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

28− , servant >= 0.16 && < 0.18

27+ , servant >= 0.8 && < 0.12

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

3029 , text >= 1.0 && < 1.3

3130 -- hs-source-dirs:

testserver/tr.nixnew file+32

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

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