bf11dea · typeable/servant-reflex

git.iko.soy/typeable/servant-reflex

Merge branch 'master' into tuple-api-3

commitbf11dea868fd3bbc50f0c95f372e196c61e99bd0 authorGreg Hale <imalsogreg@gmail.com> dateSun 8 Mar 2020, 12:50 (7 years ago) parentfa2a523 71c5440

24 files changed+329−259

compare with master

unifiedsplit

.travis.yml+12−25

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

11language: nix

2−

3−cache: false

4−

5−

6−before_install:

7− - unset CC

2+nix: 2.1.1

3+sudo: require

95install:

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

107

11−script:

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

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

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

8+before_script:

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

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

1511

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

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

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

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

20−

21−cache:

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"

12+script:

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

14+ - cachix use imalsogreg

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

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

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

changelog.md → ChangeLog.mdrenamed+6−1

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

1+0.3.4

2+-----

4+Add selenium-based test suite

160.3.3

27-----

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

510

611

7120.3.2

README.md+70−33

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

55## `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.

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−

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.

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.

1014

1115

1216## Example

1317

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:

1520

1621```haskell

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

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

2429 :<|> Raw

2530```

2631

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

2834

2935```haskell

3036

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

3743 (constDyn (BasePath "/"))

3844```

3945

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.

4156

4257```haskell

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

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

6378```

6479

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:

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:

6687

6788```haskell

6889 -- ... continued ...

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

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

81102```

82103

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:

84106

85107```haskell

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

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

103125 display =<< holdDyn Nothing outputDouble

104126```

105127

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.

107133

108134

109135## Building the library and test server

110136

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:

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.

115144

116145```

117−git submodule update --init --recursive

118−./build.sh

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

119147```

120148

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:

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

131150

132151```

133−cd testserver

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

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

135153```

136154

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.

138158

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

140161

141162

142163## Tagging requests

143164

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.

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.

145169

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:

147175

148176```haskell

149177 ...

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

173201

174202## Simultaneous requests

175203

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:

177208

178209```haskell

179210sayHi

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

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

185216```

186217

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

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

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

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

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

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

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

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

55, string-conversions, text, transformers

66}:

77mkDerivation {

88 pname = "servant-reflex";

9− version = "0.3.3";

10− # src = ./.;

9+ version = "0.3.4";

1110 src = builtins.filterSource

1211 (path: type:

1312 baseNameOf path != "result"

14− && baseNameOf path != "nix"

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

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

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

18−

19− ) ./.;

13+ && baseNameOf path != "nix"

14+ ) ./.;

2015 configureFlags = [ "-fexample" ];

2116 isLibrary = true;

2217 isExecutable = true;

2318 libraryHaskellDepends = [

2419 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

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

2722 transformers

2823 ];

2924 executableHaskellDepends = [

30− aeson base reflex reflex-dom scientific servant text

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

3126 ];

32− description = "Servant reflex API generator";

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

3328 license = stdenv.lib.licenses.bsd3;

3429}

exec/Example.hs+1−2

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

2323import API

2424import Data.Proxy

2525import Text.Read (readMaybe)

26−import Reflex.Dom hiding (run)

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

2727------------------------------------------------------------------------------

2828import Servant.Reflex

2929import Servant.Reflex.Multi

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

236236

237237 -- Name the computed API client functions

238238 let tweakRequest = ClientOptions $ \r -> do

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

240239 return $ r & withCredentials .~ True

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

242241 :<|> 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 }:

2−

3−

4−import (fetchFromGitHub {

5− owner = "reflex-frp";

6− repo = "reflex-platform";

7− rev = "04aa7c00d79a2fac81f5b302b919e1b630c20e7f";

8− sha256 = "1ckz07a839h3f8k94x2ybi9c89hqbkwnn1zxjxb0bfim8f2wqar7";

9− }) { }

1+let

2+ rev = "a15d3a2411e7ca7d4ee4853b57c72fe83faee272";

3+in import (builtins.fetchTarball

4+ {

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

6+ sha256 = "1dsvw0lah7761vndip1hqal4fjpjv84ravinnfhy83jgfav5ivna";

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" {} ''

44 echo About to phantom

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

66 sleep 3

7−

8− echo About to server

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

7+ echo About to Server

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

109 sleep 3

11−

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

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

14−

1512 echo About to testdrive

16− ${testdriver}/bin/spec

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

1714 echo Done

18− mkdir $out

19− echo Done > $out/out.txt

2015 trap "exit" INT TERM

2116 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:

11− { 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

16− mkdir $out/static

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

18− '';

19− }

20− );

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

22− };

23− };

24−

25−in ghcPackages.testserver

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

11Name: servant-reflex

2−Version: 0.3.3

3−Synopsis: Servant reflex API generator

4−Description: Servant reflex API generator

2+Version: 0.3.4

3+Synopsis: servant API generator for reflex apps

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

55License: BSD3

66License-file: LICENSE.md

77Author: Greg Hale, Doug Beardsley

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

1919 exposed-modules:

2020 Servant.Reflex

2121 Servant.Reflex.Multi

22− Servant.Reflex.RequestAPI

23− Servant.Reflex.RequestAPI2

2422

2523 other-modules:

2624 Servant.Common.BaseUrl

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

2826

2927 hs-source-dirs: src

3028 build-depends:

31− base >= 4.8 && < 4.10,

29+ base >= 4.8 && < 5,

3230 bytestring >= 0.10 && < 0.11,

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

34− containers >= 0.5.6 && < 0.6,

32+ containers >= 0.5.6 && < 0.7,

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

36− exceptions >= 0.8 && < 0.9,

3734 generic-lens,

35+ exceptions >= 0.8 && < 0.11,

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

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

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

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

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

4139 jsaddle >= 0.8 && < 0.10,

4240 lens,

4341 mtl >= 2.2.1 && < 2.3,

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

45− reflex >= 0.5 && < 0.6,

46− -- Temporary

47− reflex-dom,

48−

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

43+ reflex >= 0.5 && < 0.7,

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

5045 safe >= 0.3.9 && < 0.4,

51− servant >= 0.8 && < 0.13,

46+ servant >= 0.8 && < 0.18,

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

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

5449 text >= 1.2 && < 1.3,

5550 transformers >= 0.4 && < 0.6

5651

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

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

5853

5954 default-language: Haskell2010

6055

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

6358 buildable: True

6459 else

6560 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

6762 default-language: Haskell2010

6863 main-is: Example.hs

6964 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

1212

1313-------------------------------------------------------------------------------

1414import Control.Applicative (liftA2, liftA3)

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

1516import Control.Concurrent

1617import Control.Monad (join)

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

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

9192reqFailure (RequestFailure _ s) = Just s

9293reqFailure _ = Nothing

9394

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+

94102

95103------------------------------------------------------------------------------

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

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

394402 else ResponseFailure tag errMsg xhr

395403 in respPayld

396404

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+

397417

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

399419note e = maybe (Left e) Right

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

407427

408428escape :: T.Text -> T.Text

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

88{-# LANGUAGE MultiParamTypeClasses #-}

99{-# LANGUAGE OverloadedStrings #-}

1010{-# LANGUAGE PolyKinds #-}

11+{-# LANGUAGE Rank2Types #-}

1112{-# LANGUAGE ScopedTypeVariables #-}

1213{-# LANGUAGE TupleSections #-}

1314{-# LANGUAGE TypeFamilies #-}

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

2526module Servant.Reflex

2627 ( client

2728 , clientWithOpts

29+ , clientWithOptsAndResultHandler

2830 , clientWithRoute

31+ , clientWithRouteAndResultHandler

2932 , BuildHeaderKeysTo(..)

3033 , toHeaders

3134 , HasClient

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

120123 -> Client t m layout tag

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

122125

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+

123140

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

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

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

128145 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

130165

131166

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

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

134169

135− clientWithRoute Proxy q pTag req baseurl opts =

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

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

170+ clientWithRouteAndResultHandler Proxy q pTag req baseurl opts wrap =

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

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

138173

139174

140175-- Capture. Example:

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

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

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

157192

158− clientWithRoute Proxy q t req baseurl opts val =

159− clientWithRoute (Proxy :: Proxy sublayout)

160− q t

161− (prependToPathParts p req)

162− baseurl opts

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

194+ clientWithRouteAndResultHandler

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

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

164197

165198

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

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

173206 -- TODO how to access input types here?

174207 -- ExceptT ServantError IO a

175− clientWithRoute Proxy _ _ req baseurl opts trigs =

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

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

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

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

178211 req' = req { reqMethod = method }

179212

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

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

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

188221 -- ExceptT ServantError IO NoContent

189− clientWithRoute Proxy _ _ req baseurl opts =

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

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

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

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

192225

193226

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

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

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

225258 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

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

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

229− return $ toHeaders <$> resp

262+ wrap $ toHeaders <$> resp

230263 where req' = req { respHeaders =

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

232265 }

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

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

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

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

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

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

245− return $ toHeaders <$> resp

278+ wrap $ toHeaders <$> resp

246279 where req' = req {respHeaders =

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

248281 }

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

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

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

271304

272− clientWithRoute Proxy q t req baseurl opts eVal =

273− clientWithRoute (Proxy :: Proxy sublayout)

274− q t

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

276− baseurl opts

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

306+ clientWithRouteAndResultHandler

307+ (Proxy :: Proxy sublayout) q t

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

309+ baseurl opts wrap

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

278311

279312

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

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

288321 Client t m sublayout tag

289322

290− clientWithRoute Proxy q t =

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

323+ clientWithRouteAndResultHandler Proxy =

324+ clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)

292325

293326

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

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

325358

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

327− clientWithRoute Proxy q t req baseurl opts mparam =

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

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

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

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

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

330363

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

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

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

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

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

372405

373− clientWithRoute Proxy q t req baseurl opts paramlist =

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

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

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

375408

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

377410 pname = symbolVal (Proxy :: Proxy sym)

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

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

411444 Dynamic t Bool -> Client t m sublayout tag

412445

413− clientWithRoute Proxy q t req baseurl opts flag =

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

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

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

415448

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

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

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

425458 -> Event t tag

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

427460

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

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

429462

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

431464 Left e -> Left e

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

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

437470

438471 resps <- performRequestsAsync okReq

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

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

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

441474 ]

442475

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

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

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

469502

470− clientWithRoute Proxy q t req baseurl opts body =

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

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

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

472505 where req' = req { reqBody = bodyBytesCT }

473506 ctProxy = Proxy :: Proxy ct

474507 ctString = T.pack $ show $ contentType ctProxy

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

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

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

484517

485− clientWithRoute Proxy q t req baseurl opts =

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

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

518+ clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap =

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

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

488521

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

490523

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

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

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

494527

495− clientWithRoute Proxy q t req baseurl =

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

528+ clientWithRouteAndResultHandler Proxy =

529+ clientWithRouteAndResultHandler (Proxy :: Proxy api)

497530

498531

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

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

501534

502− clientWithRoute Proxy q t req baseurl =

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

535+ clientWithRouteAndResultHandler Proxy =

536+ clientWithRouteAndResultHandler (Proxy :: Proxy api)

504537

505538

506539

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

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

509542

510− clientWithRoute Proxy q t req baseurl =

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

543+ clientWithRouteAndResultHandler Proxy =

544+ clientWithRouteAndResultHandler (Proxy :: Proxy api)

512545

513546

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

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

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

518551 -> Client t m api tag

519552

520− clientWithRoute Proxy q t req baseurl opts authdata =

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

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

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

522555 where

523556 req' = req { authData = Just authdata }

524557

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

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

562595

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

565598

566599

567600type family HasCookieAuth xs :: Constraint where

testdriver/test/Servant/ReflexSpec.hs+1

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

99import Data.Foldable

1010import Test.WebDriver.Commands.Wait

1111import Test.Hspec.WebDriver

12+import Test.Hspec.WebDriver (chromeCaps)

1213

1314

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

testserver/API.hs+1−4

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

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

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

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

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

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

3635 :> QueryParams "greetings" Text

3736 :> QueryFlag "gusto"

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

4039 :> Post '[JSON] Double

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

4241 :<|> "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

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

4744 :<|> Raw

4845

testserver/Main.hs+10−5

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

77{-# LANGUAGE TypeOperators #-}

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

10+import Control.Monad.Reader (reader)

1011import Data.Aeson

1112import Data.Bool

1213import Data.Char (toUpper)

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

2627import Servant.Server ()

2728import System.Directory

2829-- import Snap.Util.FileServe

30+import System.Environment (lookupEnv)

2931import API

3032import Snap hiding (addHeader)

3133

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

4143testApi :: Proxy API

4244testApi = Proxy

4345

44−data App = App

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

4547

4648-- Server-side handlers.

4749--

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

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

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

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

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

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

57+ :<|> statics

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

5659 sayhi nm greetings withGusto = case nm of

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

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

7780 req <- getRequest

7881 liftIO $ putStrLn (show req)

7982 return 101

83+ statics = do

84+ staticDir <- reader appStaticDir

85+ serveDirectory staticDir

8086

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

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

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

8692

8793initApp :: SnapletInit App App

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

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

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

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

9196 addRoutes [("", test)

9297 ,("", serveDirectory "static")

9398 ]

94− return App

99+ return (App staticDir)

95100

96101-- Put this all to work!

97102main :: 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

2020 -- other-modules:

2121 -- other-extensions:

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

23− , base >=4.8 && <4.11

24− , directory >= 1.2 && < 1.4

23+ , base >=4.8 && <4.14

24+ , mtl

2525 , snap >= 1.0 && < 1.2

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

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

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

28− , servant >= 0.8 && < 0.12

28+ , servant >= 0.8 && < 0.15

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

3030 , text >= 1.0 && < 1.3

3131 -- 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+ }