git.iko.soy/typeable/servant-reflex
on master help sign in
Add selenium tests to travis CI, update build documentation
commit013eab13ace1d63f1cb17d1ce126a5d9b829363f authorGreg Hale <imalsogreg@gmail.com> dateSun 16 Sep 2018, 15:10 (8 years ago) parent990660b
23 files changed+320−126
.gitmodules−12 .travis.yml+3−1 README.md+70−33 default.nix+29 deps/http-api-data−1 deps/reflex-platform−1 deps/servant−1 deps/servant-snap−1 exec/Example.hs−1 nix/hspec-webdriver.patch+36 nix/reflex-platform.nix+7 nix/testresults.nix+17 nix/testserver.nix+9 overrides-ghc.nix−11 overrides.nix−9 servant-reflex.cabal+4−4 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+60−6
.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+3−1
@@ -10,4 +10,6 @@ before_script:
1010 - git config --global user.name "Travis-CI"
1111
1212script:
13− - nix-build travis.nix -A example
13+ - nix-build travis.nix -A build
14+ - nix-build travis.nix -A testserver
15+ - nix-build travis.nix -A testresults
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.
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
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
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
@@ -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/hspec-webdriver.patchnew file+36
@@ -0,0 +1,36 @@
1+diff --git a/Test/Hspec/WebDriver.hs b/Test/Hspec/WebDriver.hs
2+index 3162656..313360c 100644
3+--- a/Test/Hspec/WebDriver.hs
4++++ b/Test/Hspec/WebDriver.hs
5+@@ -111,7 +111,8 @@ import Data.Traversable (traverse)
6+
7+ import qualified Test.Hspec as H
8+ import Test.Hspec hiding (shouldReturn, shouldBe, shouldSatisfy, shouldThrow, pending, pendingWith, example)
9+-import Test.Hspec.Core.Spec (Result(..), Item(..), Example(..), SpecTree, Tree(..), fromSpecList, runSpecM)
10++import qualified Test.Hspec.Core as H
11++import Test.Hspec.Core.Spec (Result(..), ResultStatus(..), Item(..), Example(..), SpecTree, Tree(..), fromSpecList, runSpecM)
12+
13+ import Test.WebDriver (WD, Capabilities)
14+ import qualified Test.WebDriver as W
15+@@ -398,7 +399,7 @@ procTestSession cfg cap s = do
16+
17+ instance Eq multi => Example (WdExample multi) where
18+ type Arg (WdExample multi) = WdTestSession multi
19+- evaluateExample (WdPending msg) _ _ _ = return $ Pending msg
20++ evaluateExample (WdPending msg) _ _ _ = return $ Result "" $ Pending Nothing msg
21+ evaluateExample (WdExample multi (WdOptions {skipRemainingTestsAfterFailure}) wd) _ act _ = do
22+ prevHadError <- newIORef False
23+ aborted <- newIORef False
24+@@ -445,9 +446,9 @@ instance Eq multi => Example (WdExample multi) where
25+ merr <- readIORef prevHadError
26+ mabort <- readIORef aborted
27+ return $ case (merr, mabort) of
28+- (True, _) -> Pending (Just "Previous example had an error")
29+- (_, True) -> Pending (Just "Session has been aborted")
30+- _ -> Success
31++ (True, _) -> Result "" $ Pending Nothing (Just "Previous example had an error")
32++ (_, True) -> Result "" $ Pending Nothing (Just "Session has been aborted")
33++ _ -> Result "" $ Success
34+
35+ --------------------------------------------------------------------------------
36+ --- Utils
nix/reflex-platform.nixnew file+7
@@ -0,0 +1,7 @@
1+let
2+ rev = "3d232e2d1d8e8d10fbafc928972c901c764ae324";
3+in import (builtins.fetchTarball
4+ {
5+ url = "https://github.com/reflex-frp/reflex-platform/archive/${rev}.tar.gz";
6+ sha256 = "15ysjn0aknbl06spn4qls7xapm0d3qw2awx6k8jl28zwkaid45yg";
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+4−4
@@ -1,5 +1,5 @@
11Name: servant-reflex
2−Version: 0.3.3
2+Version: 0.3.4
33Synopsis: Servant reflex API generator
44Description: Servant reflex API generator
55License: BSD3
@@ -26,12 +26,12 @@ library
2626
2727 hs-source-dirs: src
2828 build-depends:
29− base >= 4.8 && < 4.10,
29+ base >= 4.8 && < 5,
3030 bytestring >= 0.10 && < 0.11,
3131 case-insensitive >= 1.2.0.4 && < 1.3,
3232 containers >= 0.5.6 && < 0.6,
3333 data-default >= 0.5 && < 0.8,
34− exceptions >= 0.8 && < 0.9,
34+ exceptions >= 0.8 && < 0.11,
3535 ghcjs-dom >= 0.2 && < 0.10,
3636 http-api-data >= 0.3.6 && < 0.4,
3737 http-media >= 0.6 && < 0.8,
@@ -41,7 +41,7 @@ library
4141 reflex >= 0.5 && < 0.6,
4242 reflex-dom-core == 0.4 && < 0.5,
4343 safe >= 0.3.9 && < 0.4,
44− servant >= 0.8 && < 0.13,
44+ servant >= 0.8 && < 0.15,
4545 servant-auth >= 0.2.1 && < 0.4,
4646 string-conversions >= 0.4 && < 0.5,
4747 text >= 1.2 && < 1.3,
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.nix+60−6
@@ -1,12 +1,66 @@
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+
112let
2− reflex-platform = import ./deps/reflex-platform { };
3− pkgs = reflex-platform.nixpkgs;
4− ghcjs = reflex-platform.ghcjs;
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 = do [ dontCheck doJailbreak ] super.servant;
23+ servant-reflex = lib.appendConfigureFlag
24+ (self.callPackage ./default.nix {}) "-fExample";
25+ uri-bytestring = doJailbreak super.uri-bytestring;
26+ http-api-data = dontHaddock super.http-api-data;
27+ };
28+ };
29+
30+ ghcPkgs = with lib; reflexPlatform.${nativeCompiler}.override {
31+ overrides = self: super: {
32+ heist = do [ doJailbreak dontCheck ] super.heist;
33+ http-media = dontCheck super.http-media;
34+ snap = doJailbreak (self.callHackage "snap" "1.1.1.0" {});
35+ hspec-webdriver = lib.appendPatch super.hspec-webdriver
36+ ./nix/hspec-webdriver.patch;
37+ hspec-snap = doJailbreak super.hspec-snap;
38+ snap-server = dontCheck super.snap-server;
39+ servant-snap = do [ dontCheck doJailbreak ] (self.callHackage "servant-snap" "0.8.1" {});
40+ skylighting = dontCheck super.skylighting;
41+ testdriver = self.callCabal2nix "testdriver" ./testdriver {};
42+ testserver = import nix/testserver.nix ghcjsPkgs.servant-reflex self super;
43+ };
44+ };
45+
46+ testresults = import ./nix/testresults.nix
47+ { inherit reflexPlatform;
48+ inherit (ghcPkgs) testserver testdriver;
49+ inherit (reflexPlatform.nixpkgs) curl;
50+ phantomjs = reflexPlatform.nixpkgs.phantomjs2;
51+ };
52+
553in
654 rec {
7− build = ghcjs.callCabal2nix "servant-reflex" ./. {};
8− example = pkgs.haskell.lib.appendConfigureFlag build "-f Example";
9− cabalBuild = ghcjs.shellFor {
55+
56+ inherit reflexPlatform ghcPkgs ghcjsPkgs;
57+
58+ build = ghcjsPkgs.servant-reflex;
59+ testserver = ghcPkgs.testserver;
60+ testdriver = ghcPkgs.testdriver;
61+ inherit testresults;
62+
63+ cabalBuild = reflexPlatform.${jsCompiler}.shellFor {
1064 name = "servant-reflex-cabal-builder";
1165
1266 packages = p: [