263d844...master · typeable/servant-reflex

.gitignore+2

since splitsnapshots

unifiedsplit

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

7*.stats

8out

9/.stack-work/

10+TAGS

11+dist-newstyle

.gitmodules−12

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

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+7−3

@@ -1,13 +1,17 @@

1language: nix

2−nix: 2.1.1

2+nix: 2.3.6

3sudo: require

4

5−install:

5+before_install:

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

7

8before_script:

9+ - sudo systemctl restart nix-daemon.service

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

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

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

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

11

12

12script:

13script:

13− - nix-build travis.nix -A example

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

changelog.md → ChangeLog.mdrenamed+14−1

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

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+

10.3.3

140.3.3

2-----

15-----

3

16

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

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

5

18

6

19

70.3.2

200.3.2

README.md+70−33

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

4

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

6

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

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

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

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

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

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

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

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

9−

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

10

14

11

15

12## Example

16## Example

13

17

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:

15

20

16```haskell

21```haskell

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

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

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

24 :<|> Raw

29 :<|> Raw

25```

30```

26

31

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

28

34

29```haskell

35```haskell

30

36

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

37 (constDyn (BasePath "/"))

43 (constDyn (BasePath "/"))

38```

44```

39

45

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.

41

56

42```haskell

57```haskell

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

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

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

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

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

63```

78```

64

79

80+`ReqResult tag a` is defined in

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

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

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

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

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

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

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

66

87

67```haskell

88```haskell

68 -- ... continued ...

89 -- ... continued ...

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

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

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

81```

102```

82

103

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

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

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

84

106

85```haskell

107```haskell

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

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

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

103 display =<< holdDyn Nothing outputDouble

125 display =<< holdDyn Nothing outputDouble

104```

126```

105

127

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

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

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

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

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

132+the respective authors of these fabulous libraries.

107

133

108

134

109## Building the library and test server

135## Building the library and test server

110

136

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

138+ghcjs-compiled frontend

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

140+ghc-compiled backend

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

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

112−

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

113−

143+manages the frontend build as a dependency.

114−First build the library:

115

144

116```

145```

117−git submodule update --init --recursive

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

118−./build.sh

119```

147```

120

148

121−Then build the test server:

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

122−

123−```

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

125−```

126−

127−

128−## Running the example site

129−

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

131

150

132```

151```

133−cd testserver

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

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

135```

153```

136

154

137−And simply browse to `localhost:8001`

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

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

157+under the Network tab.

138

158

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

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

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

140

161

141

162

142## Tagging requests

163## Tagging requests

143

164

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

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

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

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

168+relationship by tagging the requests.

145

169

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

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

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

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

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

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

147

175

148```haskell

176```haskell

149 ...

177 ...

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

173

201

174## Simultaneous requests

202## Simultaneous requests

175

203

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

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

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

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

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

177

208

178```haskell

209```haskell

179sayHi

210sayHi

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

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

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

185```

216```

186

217

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

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

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

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

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

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

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

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

default.nixnew file+21

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

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-datadeleted−1

Submodule changed.

deps/reflex-platformdeleted−1

Submodule changed.

deps/servantdeleted−1

Submodule changed.

deps/servant-snapdeleted−1

Submodule changed.

exec/Example.hs+2−2

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

21import API

22import Data.Proxy

23import Text.Read (readMaybe)

24−import Reflex.Dom hiding (run)

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

25+import Reflex.Dom (mainWidget)

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

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

26import Servant.Reflex

27import Servant.Reflex

27import Servant.Reflex.Multi

28import Servant.Reflex.Multi

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

97

98

98 -- Name the computed API client functions

99 -- Name the computed API client functions

99 let tweakRequest = ClientOptions $ \r -> do

100 let tweakRequest = ClientOptions $ \r -> do

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

101 return $ r & withCredentials .~ True

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

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

nix/nix.conf+2−1

@@ -1,2 +1,3 @@

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

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

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

3+trusted-users = travis

nix/reflex-platform.nixnew file+7

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

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

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

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

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

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

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

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.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+22−15

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

1Name: servant-reflex

2−Version: 0.3.3

2+Version: 0.3.6

3−Synopsis: Servant reflex API generator

3+Synopsis: servant API generator for reflex apps

4−Description: Servant reflex API generator

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

5License: BSD3

6License-file: LICENSE.md

7Author: Greg Hale, Doug Beardsley

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

17

18library

19 exposed-modules:

20− Servant.Reflex

21− Servant.Reflex.Multi

22−

23− other-modules:

24 Servant.Common.BaseUrl

20 Servant.Common.BaseUrl

25 Servant.Common.Req

21 Servant.Common.Req

22+ Servant.Reflex

23+ Servant.Reflex.Multi

26

24

27 hs-source-dirs: src

25 hs-source-dirs: src

28 build-depends:

26 build-depends:

29 base >= 4.8 && < 5,

27 base >= 4.8 && < 5,

30 bytestring >= 0.10 && < 0.11,

28 bytestring >= 0.10 && < 0.11,

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

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

32− containers >= 0.5.6 && < 0.6,

30+ containers >= 0.5.6 && < 0.7,

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

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

34 exceptions >= 0.8 && < 0.11,

32 exceptions >= 0.8 && < 0.11,

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

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

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

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

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

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

38 jsaddle >= 0.8 && < 0.10,

36 jsaddle >= 0.8 && < 0.10,

39 mtl >= 2.2.1 && < 2.3,

37 mtl >= 2.2.1 && < 2.3,

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

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

41− reflex >= 0.5 && < 0.6,

39+ reflex >= 0.5 && < 0.9,

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

40+ reflex-dom-core >= 0.6 && < 0.8,

43 safe >= 0.3.9 && < 0.4,

41 safe >= 0.3.9 && < 0.4,

44− servant >= 0.8 && < 0.15,

42+ servant >= 0.16 && < 0.19,

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

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

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

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

47 text >= 1.2 && < 1.3,

45 text >= 1.2 && < 1.3,

48 transformers >= 0.4 && < 0.6

46 transformers >= 0.4 && < 0.6

49

47

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

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

51

49

52 default-language: Haskell2010

50 default-language: Haskell2010

53

51

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

56 buildable: True

54 buildable: True

57 else

55 else

58 buildable: False

56 buildable: False

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

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

60 default-language: Haskell2010

67 default-language: Haskell2010

61 main-is: Example.hs

68 main-is: Example.hs

62 other-modules: API

69 other-modules: API

shell.nixnew file+1

@@ -0,0 +1 @@

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

src/Servant/Common/BaseUrl.hs+9−6

@@ -1,4 +1,5 @@

1{-# LANGUAGE ConstraintKinds #-}

2+{-# LANGUAGE CPP #-}

2{-# LANGUAGE DeriveDataTypeable #-}

3{-# LANGUAGE DeriveDataTypeable #-}

3{-# LANGUAGE DeriveGeneric #-}

4{-# LANGUAGE DeriveGeneric #-}

4{-# LANGUAGE FlexibleContexts #-}

5{-# LANGUAGE FlexibleContexts #-}

@@ -31,8 +32,11 @@ import Reflex

31import Reflex.Dom.Core

32import Reflex.Dom.Core

32import Text.Read

33import Text.Read

33

34

34−

35+#if !MIN_VERSION_reflex_dom_core(0,7,0)

35type SupportsServantReflex t m = (Reflex t, TriggerEvent t m, PerformEvent t m, HasWebView (Performable m), MonadJSM (Performable m))

36type SupportsServantReflex t m = (Reflex t, TriggerEvent t m, PerformEvent t m, HasWebView (Performable m), MonadJSM (Performable m))

37+#else

38+type SupportsServantReflex t m = (Reflex t, TriggerEvent t m, PerformEvent t m, MonadJSM (Performable m))

39+#endif

36

40

37-- | URI scheme to use

41-- | URI scheme to use

38data Scheme =

42data Scheme =

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

85 where pathWidget :: m (Dynamic t BaseUrl)

89 where pathWidget :: m (Dynamic t BaseUrl)

86 pathWidget = do

90 pathWidget = do

87 text "Url base path"

91 text "Url base path"

88− t <- textInput (def {_textInputConfig_attributes =

92+ t <- inputElement def

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

90 return $ BasePath <$> value t

93 return $ BasePath <$> value t

91 fullUrlWidget :: m (Dynamic t BaseUrl)

94 fullUrlWidget :: m (Dynamic t BaseUrl)

92 fullUrlWidget = do

95 fullUrlWidget = do

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

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

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

97+ srv <- inputElement def

95 text ":"

98 text ":"

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

99+ prt <- inputElement def

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

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

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

101+ path <- inputElement def

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

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

src/Servant/Common/Req.hs+26−3

@@ -12,12 +12,14 @@ module Servant.Common.Req where

12

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

14import Control.Applicative (liftA2, liftA3)

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

15import Control.Concurrent

16import Control.Concurrent

16import Control.Monad (join)

17import Control.Monad (join)

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

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

18import Data.Bifunctor (first)

19import Data.Bifunctor (first)

19import qualified Data.ByteString.Builder as Builder

20import qualified Data.ByteString.Builder as Builder

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

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

22+import Data.ByteString (ByteString)

21import qualified Data.Map as Map

23import qualified Data.Map as Map

22import Data.Maybe (catMaybes, fromMaybe)

24import Data.Maybe (catMaybes, fromMaybe)

23import Data.Functor.Compose

25import Data.Functor.Compose

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

91reqFailure (RequestFailure _ s) = Just s

93reqFailure (RequestFailure _ s) = Just s

92reqFailure _ = Nothing

94reqFailure _ = Nothing

93

95

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+

94

103

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

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

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

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

@@ -236,7 +245,7 @@ reqToReflexRequest reqMeth reqHost req =

236 , _xhrRequestConfig_user = Nothing

245 , _xhrRequestConfig_user = Nothing

237 , _xhrRequestConfig_password = Nothing

246 , _xhrRequestConfig_password = Nothing

238 , _xhrRequestConfig_responseType = Just XhrResponseType_ArrayBuffer

247 , _xhrRequestConfig_responseType = Just XhrResponseType_ArrayBuffer

239− , _xhrRequestConfig_sendData = ""

248+ , _xhrRequestConfig_sendData = mempty

240 , _xhrRequestConfig_withCredentials = False

249 , _xhrRequestConfig_withCredentials = False

241 }

250 }

242 Just rBody -> liftA2 mkConfigBody xhrHeaders rBody

251 Just rBody -> liftA2 mkConfigBody xhrHeaders rBody

@@ -289,7 +298,9 @@ performRequests reqMeth rs reqHost opts trigger = do

289performSomeRequestsAsync

298performSomeRequestsAsync

290 :: (MonadIO (Performable m),

299 :: (MonadIO (Performable m),

291 MonadJSM (Performable m),

300 MonadJSM (Performable m),

301+#if !MIN_VERSION_reflex_dom_core(0,7,0)

292 HasWebView (Performable m),

302 HasWebView (Performable m),

303+#endif

293 PerformEvent t m,

304 PerformEvent t m,

294 TriggerEvent t m,

305 TriggerEvent t m,

295 Traversable f,

306 Traversable f,

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

327

338

328

339

329

340

330−type XhrPayload = T.Text

341+type XhrPayload = ByteString

331bytesToPayload :: BL.ByteString -> XhrPayload

342bytesToPayload :: BL.ByteString -> XhrPayload

332−bytesToPayload = TE.decodeUtf8 . BL.toStrict

343+bytesToPayload = BL.toStrict

333

344

334

345

335performRequestsCT

346performRequestsCT

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

394 else ResponseFailure tag errMsg xhr

405 else ResponseFailure tag errMsg xhr

395 in respPayld

406 in respPayld

396

407

408+------------------------------------------------------------------------------

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

410+-- response 'Event's,

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

412+fanReqResult = fmapMaybe reqFailure &&& fmapMaybe reqSuccess

413+

414+------------------------------------------------------------------------------

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

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

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

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

419+

397

420

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

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

399note e = maybe (Left e) Right

422note e = maybe (Left e) Right

src/Servant/Reflex.hs+45−27

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

39

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

41import Control.Applicative

42−import Data.Monoid ((<>))

43−import qualified Data.Set as Set

44−import qualified Data.Text.Encoding as E

45−import Data.CaseInsensitive (mk)

42+import qualified Data.CaseInsensitive as CI

46import Data.Functor.Identity

43import Data.Functor.Identity

47−import Data.Proxy (Proxy (..))

48import qualified Data.Map as Map

44import qualified Data.Map as Map

45+import Data.Monoid ((<>))

46+import Data.Proxy (Proxy (..))

47+import qualified Data.Set as Set

49import Data.Text (Text)

48import Data.Text (Text)

50import qualified Data.Text as T

49import qualified Data.Text as T

50+import qualified Data.Text.Encoding as E

51import GHC.Exts (Constraint)

52import GHC.TypeLits (KnownSymbol, symbolVal)

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

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

54− BasicAuthData, BuildHeadersTo(..),

54+ BasicAuthData, BuildHeadersTo (..),

55− Capture, contentType, Header,

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

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

56+ HttpVersion, IsSecure,

57− MimeRender(..), MimeUnrender,

57+ MimeRender (..), MimeUnrender,

58− NoContent, QueryFlag, QueryParam,

58+ NoContent, QueryFlag, QueryParam',

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

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

60 RemoteHost, ReqBody,

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

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

62+ contentType)

63+import Servant.API.Description (Summary)

62import qualified Servant.Auth as Auth

64import qualified Servant.Auth as Auth

63

65

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

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

65− XhrRequest(..),

67+ XhrRequest (..), XhrResponse (..),

66− XhrResponseHeaders(..),

68+ XhrResponseHeaders (..),

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

69+ attachPromptlyDynWith, constDyn, ffor,

70+ fmapMaybe, leftmost,

68− leftmost, performRequestsAsync,

71+ performRequestsAsync)

69− )

70------------------------------------------------------------------------------

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

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

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

72 showBaseUrl,

74 showBaseUrl,

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

101-- >

103-- >

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

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

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

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

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

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

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

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

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

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

107client

109client

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

226

228

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

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

228toHeaders r =

230toHeaders r =

229− let toBS = E.encodeUtf8

230− hdrs = maybe []

231+ let hdrs = maybe []

231− (\xhr -> fmap (\(h,v) -> (mk (toBS h), toBS v))

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

232 (Map.toList $ _xhrResponse_headers xhr))

233 (Map.toList $ _xhrResponse_headers xhr))

233 (response r)

234 (response r)

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

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

235

236

237+

236class BuildHeaderKeysTo hs where

238class BuildHeaderKeysTo hs where

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

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

238

240

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

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

240 where buildHeaderKeysTo _ = []

242 where buildHeaderKeysTo _ = []

241

243

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

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

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

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

246+ buildHeaderKeysTo _ =

247+ let

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

244− buildHeaderKeysTo _ = T.pack (symbolVal (Proxy :: Proxy h)) : buildHeaderKeysTo (Proxy :: Proxy xs)

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

250+

245

251

246-- HEADERS Verb (Content) --

252-- HEADERS Verb (Content) --

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

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

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

323 clientWithRouteAndResultHandler Proxy =

329 clientWithRouteAndResultHandler Proxy =

324 clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)

330 clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)

325

331

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

333+-- functions.

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

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

336+

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

338+ Client t m sublayout tag

339+

340+ clientWithRouteAndResultHandler Proxy =

341+ clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)

342+

343+

344+

326

345

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

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

328-- the corresponding querying function will automatically take

347-- the corresponding querying function will automatically take

@@ -351,9 +370,9 @@ instance HasClient t m sublayout tag

351-- > -- 'getBooksBy Nothing' for all books

370-- > -- 'getBooksBy Nothing' for all books

352-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov

371-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov

353instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex t)

372instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex t)

354− => HasClient t m (QueryParam sym a :> sublayout) tag where

373+ => HasClient t m (QueryParam' mods sym a :> sublayout) tag where

355

374

356− type Client t m (QueryParam sym a :> sublayout) tag =

375+ type Client t m (QueryParam' mods sym a :> sublayout) tag =

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

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

358

377

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

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

@@ -603,4 +622,3 @@ type family HasCookieAuth xs :: Constraint where

603 HasCookieAuth '[] = CookieAuthNotEnabled

622 HasCookieAuth '[] = CookieAuthNotEnabled

604

623

605class CookieAuthNotEnabled

624class CookieAuthNotEnabled

606−

src/Servant/Reflex/Multi.hs+35−22

@@ -37,28 +37,30 @@ module Servant.Reflex.Multi (

37 ) where

38

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

40−import Control.Applicative (liftA2)

40+import Control.Applicative (liftA2)

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

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

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

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

43−import qualified Data.Set as Set

43+import qualified Data.Set as Set

44−import Data.Text (Text)

44+import Data.Text (Text)

45−import qualified Data.Text as T

45+import qualified Data.Text as T

46−import qualified Data.Text.Encoding as E

46+import qualified Data.Text.Encoding as E

47−import GHC.TypeLits (KnownSymbol, symbolVal)

47+import GHC.TypeLits (KnownSymbol, symbolVal)

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

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

49− BasicAuthData, BuildHeadersTo (..),

49+ BasicAuthData, BuildHeadersTo (..),

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

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

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

51+ HttpVersion, IsSecure,

52+ MimeRender (..), MimeUnrender,

52− MimeUnrender, NoContent, QueryFlag,

53+ NoContent, QueryFlag, QueryParam,

53− QueryParam, QueryParams, Raw,

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

54− ReflectMethod (..), RemoteHost,

55+ RemoteHost, ReqBody,

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

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

56− Verb, contentType)

57+ contentType)

57−

58+import Servant.API.Description (Summary)

59+

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

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

59− XhrRequest (..),

61+ XhrRequest (..),

60− XhrResponseHeaders (..),

62+ XhrResponseHeaders (..),

61− attachPromptlyDynWith, constDyn)

63+ attachPromptlyDynWith, constDyn)

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

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

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

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

64 SupportsServantReflex)

66 SupportsServantReflex)

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

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

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

241

243

242

244

245+------------------------------------------------------------------------------

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

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

248+

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

250+ ClientMulti t m sublayout f tag

251+

252+ clientWithRouteMulti Proxy q f tag =

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

254+

255+

243------------------------------------------------------------------------------

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

244instance (KnownSymbol sym,

257instance (KnownSymbol sym,

245 ToHttpApiData a,

258 ToHttpApiData a,

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

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

9import Data.Foldable

10import Test.WebDriver.Commands.Wait

11import Test.Hspec.WebDriver

12+import Test.Hspec.WebDriver (chromeCaps)

12

13

14

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

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

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

28spec = do

29spec = do

29 describe "servant-reflex tests" $ do

30 describe "servant-reflex tests" $ do

30

31

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

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

32

33

33 it "opens the page" $ runWD $

34 it "opens the page" $ runWD $

34 openPage "http://localhost:8000"

35 openPage "http://localhost:8000"

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

@@ -1 +0,0 @@

1−../exec/API.hs

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

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

testserver/Main.hs+10−3

@@ -7,10 +7,12 @@

7{-# LANGUAGE TypeOperators #-}

8

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

10+import Control.Monad.Reader (reader)

10import Data.Aeson

11import Data.Aeson

11import Data.Bool

12import Data.Bool

12import Data.Char (toUpper)

13import Data.Char (toUpper)

13import qualified Data.List as L

14import qualified Data.List as L

15+import Data.Maybe (fromMaybe)

14import Data.Monoid

16import Data.Monoid

15import Data.Proxy

17import Data.Proxy

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

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

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

25import Servant

27import Servant

26import Servant.Server

28import Servant.Server

27-- import Snap.Util.FileServe

29-- import Snap.Util.FileServe

30+import System.Environment (lookupEnv)

28import API

31import API

29import Snap

32import Snap

30

33

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

40testApi :: Proxy API

43testApi :: Proxy API

41testApi = Proxy

44testApi = Proxy

42

45

43−data App = App

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

44

47

45-- Server-side handlers.

48-- Server-side handlers.

46--

49--

@@ -51,7 +54,7 @@ data App = App

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

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

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

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

53 :<|> multi :<|> qna :<|> serveSecret

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

54− :<|> serveDirectory "static"

57+ :<|> statics

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

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

56 sayhi nm greetings withGusto = case nm of

59 sayhi nm greetings withGusto = case nm of

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

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

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

76 req <- getRequest

79 req <- getRequest

77 liftIO $ putStrLn (show req)

80 liftIO $ putStrLn (show req)

78 return 101

81 return 101

82+ statics = do

83+ staticDir <- reader appStaticDir

84+ serveDirectory staticDir

79

85

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

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

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

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

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

85

91

86initApp :: SnapletInit App App

92initApp :: SnapletInit App App

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

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

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

88 addRoutes [("", test)

95 addRoutes [("", test)

89 ,("", serveDirectory "static")

96 ,("", serveDirectory "static")

90 ]

97 ]

91− return App

98+ return (App staticDir)

92

99

93-- Put this all to work!

100-- Put this all to work!

94main :: IO ()

101main :: 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+5−4

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

19 main-is: Main.hs

20 -- other-modules:

21 -- other-extensions:

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

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

23− , base >=4.8 && <4.11

23+ , base >=4.8 && < 5

24+ , mtl

24 , snap >= 1.0 && < 1.2

25 , snap >= 1.0 && < 1.2

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

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

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

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

27− , servant >= 0.8 && < 0.12

28+ , servant >= 0.16 && < 0.18

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

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

29 , text >= 1.0 && < 1.3

30 , text >= 1.0 && < 1.3

30 -- hs-source-dirs:

31 -- hs-source-dirs:

testserver/tr.nixdeleted−32

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

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

2−let

3−

4− dontCheck = (import <nixpkgs> {}).pkgs.haskell.lib.dontCheck;

5− cabal2nixResult = reflex-platform.cabal2nixResult;

6− nixpkgs = (import <nixpkgs> {});

7−in

8−reflex-platform.ghc.override {

9− overrides = self: super: {

10− servant-snap = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap) {});

11− snap = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap) {});

12− io-streams = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap/deps/io-streams) {});

13− io-streams-haproxy = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap/deps/io-streams-haproxy) {});

14− heist = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap/deps/heist) {});

15− xmlhtml = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap/deps/xmlhtml) {});

16− snap-core = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap/deps/snap-core) {});

17− snap-server = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap/deps/snap-server) {});

18− snap-loader-static = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap-loader-static) {});

19− snap-loader-dynamic = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/snap-loader-dynamic) {});

20− hspec-snap = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/hspec-snap) {});

21−

22− # servant-foreign = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-foreign) {});

23− # servant-js = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-js) {});

24− # servant-docs = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-docs) {});

25− # servant-client = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-client) {});

26− # servant-blaze = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-blaze) {});

27− # servant-lucid = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-lucid) {});

28− # servant-server = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant-server) {});

29− # servant = dontCheck (self.callPackage (cabal2nixResult ../deps/servant-snap/deps/servant/servant) {});

30−

31− };

32−}

travis.nix+53−6

@@ -1,12 +1,59 @@

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+

1let

12let

13+

2− reflex-platform = import ./deps/reflex-platform { };

14+ reflexPlatform = import ./nix/reflex-platform.nix;

3− pkgs = reflex-platform.nixpkgs;

15+

4− ghcjs = reflex-platform.ghcjs;

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+

5in

45in

6 rec {

46 rec {

47+

48+ inherit reflexPlatform ghcPkgs ghcjsPkgs;

49+

7− build = ghcjs.callCabal2nix "servant-reflex" ./. {};

50+ build = ghcjsPkgs.servant-reflex;

8− example = pkgs.haskell.lib.appendConfigureFlag build "-f Example";

51+ buildGhc = ghcPkgs.servant-reflex;

52+ testserver = ghcPkgs.testserver;

53+ testdriver = ghcPkgs.testdriver;

54+ inherit testresults;

55+

9− cabalBuild = ghcjs.shellFor {

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

10 name = "servant-reflex-cabal-builder";

57 name = "servant-reflex-cabal-builder";

11

58

12 packages = p: [

59 packages = p: [