9a3b58c · typeable/servant-reflex

.gitmodules−12

compare with master

unifiedsplit

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

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

11

12script:

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

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

97

98 -- Name the computed API client functions

99 let tweakRequest = ClientOptions $ \r -> do

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

101 return $ r & withCredentials .~ True

100 return $ r & withCredentials .~ True

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

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

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

102 :<|> 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+1−1

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

1Name: servant-reflex

2−Version: 0.3.3

2+Version: 0.3.4

3Synopsis: Servant reflex API generator

4Description: Servant reflex API generator

5License: BSD3

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

@@ -20,11 +20,12 @@ executable back

20 -- other-modules:

21 -- other-extensions:

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

23− , base >=4.8 && <4.11

23+ , base >=4.8 && <4.12

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.8 && < 0.15

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

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

5in

53in

6 rec {

54 rec {

55+

56+ inherit reflexPlatform ghcPkgs ghcjsPkgs;

57+

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

58+ build = ghcjsPkgs.servant-reflex;

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

59+ testserver = ghcPkgs.testserver;

60+ testdriver = ghcPkgs.testdriver;

61+ inherit testresults;

62+

9− cabalBuild = ghcjs.shellFor {

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

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

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

11

65

12 packages = p: [

66 packages = p: [