on master help sign in
Merge remote-tracking branch 'origin/master' into text-jsstring
commit120c5ca7c672be92af83c2332cf4d530e4e3b4e8 authorMatthew Bauer <mjbauer95@gmail.com> dateFri 17 May 2019, 15:36 (7 years ago) parentc57d77b4459563
28 files changed+350−191
.gitmodules−12 .travis.yml+13−57 changelog.md → ChangeLog.md+6−1 README.md+70−33 build.sh−3 default.nix+29 deps/http-api-data−1 deps/reflex-platform−1 deps/servant−1 deps/servant-snap−1 exec/Example.hs+1−2 nix/nix.conf+2 nix/reflex-platform.nix+7 nix/servant-snap.nix+9 nix/testresults.nix+17 nix/testserver.nix+9 overrides-ghc.nix−11 overrides.nix−9 servant-reflex.cabal+11−12 shell.nix+1 src/Servant/Common/Req.hs+22−2 testdriver/test/Servant/ReflexSpec.hs+2−1 testserver/API.hs+69−1 testserver/Main.hs+10−3 testserver/run-wd-tests.sh−5 testserver/testserver.cabal+4−3 testserver/tr.nix−32 travis.nix+68
.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+13−57
@@ -1,61 +1,17 @@
1−sudo: required
2−
3−before_cache:
4− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
5− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar
6−
7−addons:
8− apt:
9− - phantomjs
10−
11−matrix:
12− include:
13− - env: CABALVER=1.24 GHCVER=7.10.3
14− compiler: ": #GHC 7.10.3"
15− addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.3], sources: [hvr-ghc]}}
16− - env: CABALVER=1.24 GHCVER=8.0.1
17− compiler: ": #GHC 8.0.1"
18− addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
19−
20−
21−
22−before_install:
23− - unset CC
24− - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
25− - git submodule update --init --recursive
1+language: nix
2+nix: 2.1.1
3+sudo: require
264
275install:
28− - cabal --version
29− - BENCH=${BENCH---enable-benchmarks}
30− - TEST=${TEST---enable-tests}
31− - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
32− - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];
33− then
34− zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >
35− $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;
36− fi
37− - travis_retry cabal update -v
38− - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
39− - deps/reflex-platform/work-on ./overrides-ghc.nix ./testserver --command "cd testserver && cabal configure -fExample && cabal build"
40− - deps/reflex-platform/work-on ghc ./testdriver --command "cd testdriver && cabal configure && cabal build"
41− - cd testserver && dist/build/back/back -p 8000 &
42− - sleep 3
43− - phantomjs --webdriver=127.0.0.1:4444 &
44− - sleep 3
45−
46−script:
47− - git config --global user.email "travis-ci@example.com"
48− - git config --global user.name "Travis-CI"
49− - ./build.sh
50− # - testdriver/dist/build/spec/spec
6+ - sudo cp -rT $TRAVIS_BUILD_DIR/nix /etc/nix
517
52−cache:
53− directories:
54− - /nix
55− - $HOME/.cabal/packages
56− - $HOME/.cabal/store
8+before_script:
9+ - git config --global user.email "travis-ci@example.com"
10+ - git config --global user.name "Travis-CI"
5711
58−env:
59− global:
60− - ENCRYPTION_LABEL: "3c89d919c82e"
61− - 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+-----
3+
4+Add selenium-based test suite
5+
160.3.3
27-----
38
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 @@
44
55## `servant-reflex` lets you share your `servant` APIs with the frontend
66
7−Keeping your frontend in sync with your API server can be difficult - when the 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.nixnew file+29
@@ -0,0 +1,29 @@
1+{ mkDerivation, aeson, base, bytestring, case-insensitive
2+, containers, data-default, exceptions, 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
5+, string-conversions, text, transformers, megaparsec, wreq
6+}:
7+mkDerivation {
8+ pname = "servant-reflex";
9+ version = "0.3.4";
10+ src = builtins.filterSource
11+ (path: type:
12+ baseNameOf path != "result"
13+ && baseNameOf path != "nix"
14+ ) ./.;
15+ configureFlags = [ "-fexample" ];
16+ isLibrary = true;
17+ isExecutable = true;
18+ libraryHaskellDepends = [
19+ base bytestring case-insensitive containers data-default exceptions
20+ ghcjs-dom http-api-data http-media jsaddle mtl network-uri reflex
21+ reflex-dom-core safe servant servant-auth string-conversions text
22+ transformers megaparsec wreq
23+ ];
24+ executableHaskellDepends = [
25+ aeson base reflex reflex-dom scientific servant text
26+ ];
27+ description = "Servant reflex API generator";
28+ license = stdenv.lib.licenses.bsd3;
29+}
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+1−2
@@ -21,7 +21,7 @@ import Servant.API
2121import API
2222import Data.Proxy
2323import Text.Read (readMaybe)
24−import Reflex.Dom hiding (run)
24+import Reflex.Dom.Core hiding (run)
2525------------------------------------------------------------------------------
2626import Servant.Reflex
2727import Servant.Reflex.Multi
@@ -97,7 +97,6 @@ run = mdo
9797
9898 -- Name the computed API client functions
9999 let tweakRequest = ClientOptions $ \r -> do
100− putStrLn ("Got req: " ++ show r)
101100 return $ r & withCredentials .~ True
102101 let (getUnit :<|> getInt :<|> sayhi :<|> dbl
103102 :<|> 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.nixnew file+7
@@ -0,0 +1,7 @@
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.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+11−12
@@ -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
@@ -17,30 +17,29 @@ Flag Example
1717
1818library
1919 exposed-modules:
20− Servant.Reflex
21− Servant.Reflex.Multi
22−
23− other-modules:
2420 Servant.Common.BaseUrl
2521 Servant.Common.Req
22+ Servant.Reflex
23+ Servant.Reflex.Multi
2624
2725 hs-source-dirs: src
2826 build-depends:
2927 base >= 4.8 && < 4.10,
3028 aeson >= 0.11 && < 1.3,
29+ base >= 4.8 && < 5,
3130 bytestring >= 0.10 && < 0.11,
3231 case-insensitive >= 1.2.0.4 && < 1.3,
3332 containers >= 0.5.6 && < 0.6,
3433 data-default >= 0.5 && < 0.8,
35− exceptions >= 0.8 && < 0.9,
34+ exceptions >= 0.8 && < 0.11,
3635 ghcjs-dom >= 0.2 && < 0.10,
3736 http-api-data >= 0.3.6 && < 0.4,
3837 http-media >= 0.6 && < 0.8,
3938 jsaddle >= 0.8 && < 0.10,
4039 mtl >= 2.2.1 && < 2.3,
4140 network-uri >= 2.6 && < 2.7,
42− reflex >= 0.5 && < 0.6,
43− reflex-dom-core == 0.4 && < 0.5,
41+ reflex >= 0.5 && < 0.7,
42+ reflex-dom-core >= 0.4 && < 0.6,
4443 safe >= 0.3.9 && < 0.4,
4544 servant >= 0.13 && < 0.14,
4645 servant-checked-exceptions >= 1.1.0.0 && < 1.2,
@@ -49,7 +48,7 @@ library
4948 text >= 1.2 && < 1.3,
5049 transformers >= 0.4 && < 0.6
5150
52− ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
51+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields
5352
5453 default-language: Haskell2010
5554
@@ -58,7 +57,7 @@ executable example
5857 buildable: True
5958 else
6059 buildable: False
61− build-depends: aeson, reflex, servant-reflex, base, scientific, servant, reflex-dom, text
60+ build-depends: aeson, reflex, servant-reflex, base, scientific, servant, reflex-dom-core, text
6261 default-language: Haskell2010
6362 main-is: Example.hs
6463 other-modules: API
shell.nixnew file+1
@@ -0,0 +1 @@
1+(import ./travis.nix {nativeCompiler = "ghc";}).ghcPkgs.servant-reflex.env
src/Servant/Common/Req.hs+22−2
@@ -18,13 +18,14 @@ module Servant.Common.Req where
1818
1919-------------------------------------------------------------------------------
2020import Control.Applicative (liftA2, liftA3)
21+import Control.Arrow ((&&&))
2122import Control.Concurrent
2223import Control.Monad (join)
2324import Control.Monad.IO.Class (MonadIO, liftIO)
2425import Data.Aeson
2526import Data.Bifunctor (first)
2627import qualified Data.ByteString as BS
27−import qualified Data.ByteString.Builder as BB
28+import qualified Data.ByteString.Builder as Builder
2829import Data.ByteString.Lazy (ByteString)
2930import qualified Data.ByteString.Lazy.Char8 as BL
3031import Data.Functor.Compose
@@ -112,6 +113,13 @@ reqFailure (ResponseFailure _ s _) = Just s
112113reqFailure (RequestFailure _ s) = Just s
113114reqFailure _ = Nothing
114115
116+------------------------------------------------------------------------------
117+-- | Simple filter/accessor like 'reqFailure', but keeping the request tag
118+reqFailure' :: ReqResult tag a -> Maybe (tag,Text)
119+reqFailure' (ResponseFailure tag s _) = Just (tag,s)
120+reqFailure' (RequestFailure tag s) = Just (tag,s)
121+reqFailure' _ = Nothing
122+
115123
116124------------------------------------------------------------------------------
117125-- | Simple filter/accessor for the raw XHR response
@@ -415,6 +423,18 @@ evalResponse decodeRes (tag, xhr) =
415423 else ResponseFailure tag errMsg xhr
416424 in respPayld
417425
426+------------------------------------------------------------------------------
427+-- | Utility for simultaneously accessing/filtering Success and Failure
428+-- response 'Event's,
429+fanReqResult :: Reflex t => Event t (ReqResult tag a) -> (Event t Text, Event t a)
430+fanReqResult = fmapMaybe reqFailure &&& fmapMaybe reqSuccess
431+
432+------------------------------------------------------------------------------
433+-- | Utility for simultaneously accessing/filtering Success and Failure
434+-- response 'Event's, but keeping the request tag
435+fanReqResult' :: Reflex t => Event t (ReqResult tag a) -> (Event t (tag, Text), Event t (tag, a))
436+fanReqResult' = fmapMaybe reqFailure' &&& fmapMaybe reqSuccess'
437+
418438
419439-- | Similar to 'Servant.API.ContentType.MimeUnrender' but with the differnce that
420440-- the second argument expects a JSString instead of ByteString.
@@ -463,4 +483,4 @@ builderToText :: BB.Builder -> T.Text
463483builderToText = T.decodeUtf8 . BL.toStrict . BB.toLazyByteString
464484
465485escape :: T.Text -> T.Text
466−escape = T.pack . N.escapeURIString (not . N.isReserved) . T.unpack . T.decodeUtf8 . BL.toStrict . BB.toLazyByteString . toEncodedUrlPiece
486+escape = T.pack . N.escapeURIString (not . N.isReserved) . T.unpack . TE.decodeUtf8 . BL.toStrict . Builder.toLazyByteString . toEncodedUrlPiece
testdriver/test/Servant/ReflexSpec.hs+2−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 ()
@@ -28,7 +29,7 @@ spec :: Spec
2829spec = do
2930 describe "servant-reflex tests" $ do
3031
31− session "test page" $ using Chrome $ do
32+ session "test page" $ using [chromeCaps] $ do
3233
3334 it "opens the page" $ runWD $
3435 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 @@
77{-# LANGUAGE TypeOperators #-}
88
99import Control.Monad.IO.Class (liftIO)
10+import Control.Monad.Reader (reader)
1011import Data.Aeson
1112import Data.Bool
1213import Data.Char (toUpper)
1314import qualified Data.List as L
15+import Data.Maybe (fromMaybe)
1416import Data.Monoid
1517import Data.Proxy
1618import Data.Text hiding (head, length, map,
@@ -25,6 +27,7 @@ import Snap.Http.Server
2527import Servant
2628import Servant.Server
2729-- import Snap.Util.FileServe
30+import System.Environment (lookupEnv)
2831import API
2932import Snap
3033
@@ -40,7 +43,7 @@ instance ToJSON Greet
4043testApi :: Proxy API
4144testApi = Proxy
4245
43−data App = App
46+data App = App { appStaticDir :: String }
4447
4548-- Server-side handlers.
4649--
@@ -51,7 +54,7 @@ data App = App
5154server :: Server API '[BasicAuthCheck (Handler App App) ()] (Handler App App)
5255server = return () :<|> return 100 :<|> sayhi :<|> dbl
5356 :<|> multi :<|> qna :<|> serveSecret
54− :<|> serveDirectory "static"
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)
@@ -76,6 +79,9 @@ server = return () :<|> return 100 :<|> sayhi :<|> dbl
7679 req <- getRequest
7780 liftIO $ putStrLn (show req)
7881 return 101
82+ statics = do
83+ staticDir <- reader appStaticDir
84+ serveDirectory staticDir
7985
8086-- Turn the server into a WAI app. 'serve' is provided by servant,
8187-- more precisely by the Servant.Server module.
@@ -85,10 +91,11 @@ test = serveSnapWithContext testApi
8591
8692initApp :: SnapletInit App App
8793initApp = makeSnaplet "myapp" "example" Nothing $ do
94+ staticDir <- fromMaybe "static" <$> liftIO (lookupEnv "STATIC_DIR")
8895 addRoutes [("", test)
8996 ,("", serveDirectory "static")
9097 ]
91− return App
98+ return (App staticDir)
9299
93100-- Put this all to work!
94101main :: 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−3
@@ -20,11 +20,12 @@ executable back
2020 -- other-modules:
2121 -- other-extensions:
2222 build-depends: aeson >= 0.9 && < 1.4
23− , base >=4.8 && <4.11
23+ , base >=4.8 && <4.12
24+ , mtl
2425 , snap >= 1.0 && < 1.2
25− , snap-server >= 1.0 && < 1.1
26+ , snap-server >= 1.0 && < 1.2
2627 , snap-core >= 1.0 && < 1.1
27− , servant >= 0.8 && < 0.12
28+ , servant >= 0.8 && < 0.15
2829 , servant-snap >= 0.8 && < 0.9
2930 , text >= 1.0 && < 1.3
3031 -- 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+68
@@ -0,0 +1,68 @@
1+{
2+ nativeCompiler ? "ghc",
3+ # ^ Choose a GHC for compiling backend components (web server, selenium)
4+ # (ghc, ghc8_0, ghc8_2, ghc8_4 or ghcHEAD)
5+
6+ jsCompiler ? "ghcjs"
7+ # ^ Choose a GHCJS for compiling the frontend
8+ # (ghcjs, ghcjs8_0, ghcjs8_2 or ghcjs8_4)
9+
10+}:
11+
12+let
13+
14+ reflexPlatform = import ./nix/reflex-platform.nix;
15+
16+ lib = reflexPlatform.nixpkgs.haskell.lib;
17+ do = funs: pkg: builtins.foldl' (a: b: b a) pkg funs;
18+
19+ ghcjsPkgs = with lib; reflexPlatform.${jsCompiler}.override {
20+ overrides = self: super: {
21+ http-media = dontCheck super.http-media;
22+ servant = dontCheck super.servant;
23+ lens-aeson = dontCheck super.lens-aeson;
24+ servant-reflex = lib.appendConfigureFlag
25+ (self.callPackage ./default.nix {}) "-fExample";
26+ };
27+ };
28+
29+ ghcPkgs = with lib; reflexPlatform.${nativeCompiler}.override {
30+ overrides = self: super: {
31+ servant-snap = dontCheck ((import ./nix/servant-snap.nix {}) self super);
32+ testdriver = self.callCabal2nix "testdriver" ./testdriver {};
33+ testserver = import nix/testserver.nix ghcjsPkgs.servant-reflex self super;
34+ };
35+ };
36+
37+ testresults = import ./nix/testresults.nix
38+ { inherit reflexPlatform;
39+ inherit (ghcPkgs) testserver testdriver;
40+ inherit (reflexPlatform.nixpkgs) curl;
41+ phantomjs = reflexPlatform.nixpkgs.phantomjs2;
42+ };
43+
44+in
45+ rec {
46+
47+ inherit reflexPlatform ghcPkgs ghcjsPkgs;
48+
49+ build = ghcjsPkgs.servant-reflex;
50+ testserver = ghcPkgs.testserver;
51+ testdriver = ghcPkgs.testdriver;
52+ inherit testresults;
53+
54+ cabalBuild = reflexPlatform.${jsCompiler}.shellFor {
55+ name = "servant-reflex-cabal-builder";
56+
57+ packages = p: [
58+ build
59+ ];
60+
61+ shellHook = ''
62+ cabal configure --ghcjs -f Example
63+ cabal build
64+ exec/toSite.sh
65+ exit $?
66+ '';
67+ };
68+ }