master..bf11dea · servant-reflex

git.iko.soy/servant-reflex

on bf11dea help sign in

.gitignore−2

since splitsnapshots

unifiedsplit

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

7*.stats

8out

9/.stack-work/

10−TAGS

11−dist-newstyle

.travis.yml+4−4

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

1language: nix

2−nix: 2.3.6

2+nix: 2.1.1

3sudo: require

5−before_install:

5+install:

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

8before_script:

9− - sudo systemctl restart nix-daemon.service

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

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

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

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

13script:

12script:

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

14+ - cachix use imalsogreg

14 - nix-build travis.nix -A build

15 - nix-build travis.nix -A build

15− - nix-build travis.nix -A buildGhc

16 - nix-build travis.nix -A testserver

17 - nix-build travis.nix -A testresults

ChangeLog.md−8

@@ -1,11 +1,3 @@

1−0.3.5

2−-----

3−

4− - Require reflex-dom-core >= 0.6 (for internal handling of case-insensitive headers)

5− - Require servant >= 0.16

6− - Eliminate use of deprecated widgets from reflex-dom-core

7− - Bump the version of reflex-platform used in nix-shell and test suite

8−

90.3.4

10.3.4

10-----

2-----

README.md+1−1

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

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

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

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

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

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

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

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

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

default.nix+17−9

@@ -1,20 +1,28 @@

1−{ mkDerivation, base, bytestring, case-insensitive, containers

1+{ mkDerivation, aeson, base, bytestring, case-insensitive

2−, data-default, exceptions, ghcjs-dom, http-api-data, http-media

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

3−, jsaddle, mtl, network-uri, reflex, reflex-dom, reflex-dom-core

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

4−, safe, servant, servant-auth, stdenv, string-conversions, text

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

5−, transformers

5+, string-conversions, text, transformers

6}:

7mkDerivation {

8 pname = "servant-reflex";

9− version = "0.3.6";

9+ version = "0.3.4";

10+ src = builtins.filterSource

11+ (path: type:

12+ baseNameOf path != "result"

13+ && baseNameOf path != "nix"

10− src = ./.;

14+ ) ./.;

15+ configureFlags = [ "-fexample" ];

11 isLibrary = true;

16 isLibrary = true;

12 isExecutable = true;

17 isExecutable = true;

13 libraryHaskellDepends = [

18 libraryHaskellDepends = [

14 base bytestring case-insensitive containers data-default exceptions

19 base bytestring case-insensitive containers data-default exceptions

15 ghcjs-dom http-api-data http-media jsaddle mtl network-uri reflex

20 ghcjs-dom http-api-data http-media jsaddle mtl network-uri reflex

16− reflex-dom reflex-dom-core safe servant servant-auth string-conversions

21+ reflex-dom-core safe servant servant-auth string-conversions text

17− text transformers

22+ transformers

23+ ];

24+ executableHaskellDepends = [

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

18 ];

26 ];

19 description = "servant API generator for reflex apps";

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

20 license = stdenv.lib.licenses.bsd3;

28 license = stdenv.lib.licenses.bsd3;

exec/API.hs+4−1

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

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

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

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

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

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

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

35 :> QueryParams "greetings" Text

36 :> QueryParams "greetings" Text

36 :> QueryFlag "gusto"

37 :> QueryFlag "gusto"

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

39 :> Post '[JSON] Double

40 :> Post '[JSON] Double

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

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

41 :<|> "qna" :> ReqBody '[JSON] Question

42 :<|> "qna" :> ReqBody '[JSON] Question

43+ :> Header "qnum" Int

44+ :> Header "is-favorite" Bool

42− :> Post '[JSON] Answer

45+ :> Post '[JSON] (Headers '[Header "anum" Int, Header "was-favorite" Bool] Answer)

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

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

44 :<|> Raw

47 :<|> Raw

exec/Example.hs+157−18

@@ -5,6 +5,8 @@

5{-# LANGUAGE RankNTypes #-}

6{-# LANGUAGE RecursiveDo #-}

7{-# LANGUAGE ScopedTypeVariables #-}

8+{-# LANGUAGE TypeApplications #-}

9+{-# LANGUAGE TypeOperators #-}

9module Main where

11module Main where

@@ -21,21 +23,157 @@ import Servant.API

21import API

23import API

22import Data.Proxy

24import Data.Proxy

23import Text.Read (readMaybe)

25import Text.Read (readMaybe)

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

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

25−import Reflex.Dom (mainWidget)

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

27------------------------------------------------------------------------------

27import Servant.Reflex

28import Servant.Reflex

28import Servant.Reflex.Multi

29import Servant.Reflex.Multi

30+import qualified Servant.Reflex.RequestAPI as SR

31api :: Proxy API

33api :: Proxy API

32api = Proxy

34api = Proxy

36+type MyAPI =

37+ "getunit" :> Get '[JSON] ()

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

39+ :<|> "dblint" :> Capture "anint" Int :> Get '[JSON] Int

40+ :<|> "sayhi" :> QueryParam "username" Text

41+ :> QueryParams "greetings" Text

42+ :> QueryFlag "gusto"

43+ :> Get '[JSON] Text

44+ :<|> "double" :> ReqBody '[JSON] Double

45+ :> Post '[JSON] Double

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

47+ :<|> "qna" :> ReqBody '[JSON] Question

48+ :> Header "qnum" Int

49+ :> Header "is-favorite" Bool

50+ :> Post '[JSON] (Headers '[Header "anum" Int, Header "was-favorite" Bool] Answer)

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

52+

34main :: IO ()

53main :: IO ()

35main = mainWidget $ do

54main = mainWidget $ do

55+ divClass "example-tuple" runTuple

36 divClass "example-base" run

56 divClass "example-base" run

37 divClass "example-multi" runMulti

57 divClass "example-multi" runMulti

59+hiWidget :: (SupportsServantReflex t m,

60+ DomBuilder t m,

61+ DomBuilderSpace m ~ GhcjsDomSpace,

62+ PostBuild t m) => m (Dynamic t (Maybe Text),

63+ Dynamic t [Text],

64+ Dynamic t Bool,

65+ Event t ())

66+hiWidget = do

67+ text "Name"

68+ el "br" $ return ()

69+ inp :: Dynamic t Text <- fmap value $ divClass "name-input" $ (textInput def)

70+ let checkedName = fmap (\i -> bool (Just i) Nothing (T.null i)) inp

71+ el "br" $ return ()

72+

73+ text "Greetings (space-separated)"

74+ el "br" $ return ()

75+ greetings <- fmap (fmap T.words . value) $

76+ divClass "greetings-input" $ (textInput def)

77+

78+ el "br" $ return ()

79+

80+ gusto <- fmap value $ divClass "gusto-input" $ checkbox False def

81+

82+ el "br" $ return ()

83+ sayHiClicks :: Event t () <- divClass "hi-button" $ button "Say hi"

84+ return (checkedName, greetings, gusto, sayHiClicks)

85+

86+

87+readWidget :: (SupportsServantReflex t m,

88+ DomBuilder t m,

89+ DomBuilderSpace m ~ GhcjsDomSpace,

90+ PostBuild t m,

91+ Read a

92+ ) => m (Dynamic t (Maybe a))

93+readWidget = fmap (readMaybe . T.unpack) . value <$> textInput def

94+

95+readWidget' :: (SupportsServantReflex t m,

96+ DomBuilder t m,

97+ DomBuilderSpace m ~ GhcjsDomSpace,

98+ PostBuild t m,

99+ Read a

100+ ) => a -> m (Dynamic t a)

101+readWidget' d = fmap (fromMaybe d . readMaybe . T.unpack) . value <$> textInput def

102+

103+basicAuthWidget :: (SupportsServantReflex t m,

104+ DomBuilder t m,

105+ DomBuilderSpace m ~ GhcjsDomSpace,

106+ PostBuild t m

107+ ) => m (Dynamic t BasicAuthData)

108+basicAuthWidget = do

109+ un <- fmap value $ text "Username" >> textArea def

110+ pw <- fmap value $ text "Unhidden PW" >> textArea def

111+ return $ BasicAuthData <$> fmap T.encodeUtf8 un <*> fmap T.encodeUtf8 pw

112+

113+

114+runTuple :: forall t m. (SupportsServantReflex t m,

115+ DomBuilder t m,

116+ DomBuilderSpace m ~ GhcjsDomSpace,

117+ MonadFix m,

118+ PostBuild t m,

119+ MonadHold t m) => m ()

120+runTuple = do

121+ el "h1" (text "Tuple API")

122+ url <- baseUrlWidget

123+

125+ SR.clientR (Proxy @API) (Proxy @m) (Proxy @t) (Proxy @[]) url

126+

127+ u <- divClass "demo-group" $ do

128+ unitBtn <- button "get unit"

129+ getUnit (fmap (:[]) unitBtn)

130+

131+ (giR, diR) <- divClass "demo-group" $ do

132+ int <- readWidget

133+ getIntBtn <- button "get int"

134+ dblIntBtn <- button "double int"

135+ gi <- getInt (fmap (:[]) getIntBtn)

136+ di <- dblInt (fmap (:[]) (fmapMaybe id $ tagPromptlyDyn int dblIntBtn))

137+ return (gi, di)

138+

139+ hiResp <- divClass "demo-group" $ do

140+ (nm, greets, gusto, hiClicks) <- hiWidget

141+ let hiReqs = tagPromptlyDyn ((,,) <$> nm <*> greets <*> gusto) hiClicks

142+ sayHi (fmap (:[]) hiReqs)

143+

144+ dblResp <- divClass "demo-group" $ do

145+ dblInput <- readWidget

146+ dblBtn <- button "double double"

147+ dbl $ (fmap (:[])) $ fmapMaybe id $ tagPromptlyDyn dblInput dblBtn

148+

149+ twoPathResp <- divClass "demo-group" $ do

150+ twoPathInp <- text "Two Path" >> checkbox False def

151+ ab (fmap (:[]) $ updated (value twoPathInp))

152+

153+ qnaR <- divClass "demo-group" $ do

154+ q <- fmap Question . value <$> textInput def

155+ i <- readWidget' 0

156+ f <- readWidget' False

157+ question (fmap (:[]) (updated $ (,,) <$> q <*> i <*> f))

158+

159+ secretR <- divClass "demo-group" $ do

160+ ba <- basicAuthWidget

161+ sBtn <- button "Get secret"

162+ secret (fmap pure $ tagPromptlyDyn ba sBtn)

163+

164+ divClass "demo-group" $ do

165+ el "div" $ text "responses"

166+ dynText =<< holdDyn "No responses yet"

167+ (leftmost [ tshow <$> u , tshow <$> giR

168+ , tshow <$> diR

169+ , tshow <$> hiResp , tshow <$> dblResp

170+ , tshow <$> twoPathResp

171+ , T.concat . fmap (either tshow (\x -> tshow (tshow (getHeaders x), tshow (getResponse x)))) <$> qnaR

172+ , tshow <$> secretR

173+ ])

174+

175+ return ()

176+

177

40runMulti :: forall t m. (SupportsServantReflex t m,

178runMulti :: forall t m. (SupportsServantReflex t m,

41 DomBuilder t m,

179 DomBuilder t m,

@@ -46,7 +184,7 @@ runMulti :: forall t m. (SupportsServantReflex t m,

46runMulti = do

184runMulti = do

47 url <- baseUrlWidget

185 url <- baseUrlWidget

48 el "br" blank

186 el "br" blank

49− let (_ :<|> _ :<|> sayHi :<|> dbl :<|> _ :<|> _ :<|> _ :<|> _ ) =

187+ let (_ :<|> _ :<|> _ :<|> sayHi :<|> dbl :<|> _ :<|> _ :<|> _ :<|> _ ) =

50 clientA api (Proxy :: Proxy m) (Proxy :: Proxy []) (Proxy :: Proxy Int) url

188 clientA api (Proxy :: Proxy m) (Proxy :: Proxy []) (Proxy :: Proxy Int) url

189

52 num :: Dynamic t (Either Text Double) <- fmap (note "No read" . readMaybe . T.unpack) . value <$> textInput def

190 num :: Dynamic t (Either Text Double) <- fmap (note "No read" . readMaybe . T.unpack) . value <$> textInput def

@@ -99,7 +237,7 @@ run = mdo

99 -- Name the computed API client functions

237 -- Name the computed API client functions

100 let tweakRequest = ClientOptions $ \r -> do

238 let tweakRequest = ClientOptions $ \r -> do

101 return $ r & withCredentials .~ True

239 return $ r & withCredentials .~ True

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

240+ let (getUnit :<|> getInt :<|> dblInt :<|> sayhi :<|> dbl

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

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

104 clientWithOpts api (Proxy :: Proxy m) (Proxy :: Proxy Int) url tweakRequest

242 clientWithOpts api (Proxy :: Proxy m) (Proxy :: Proxy Int) url tweakRequest

105

243

@@ -159,7 +297,7 @@ run = mdo

159 holdDyn "(no errors)" (fmapMaybe reqFailure (dblResp))

297 holdDyn "(no errors)" (fmapMaybe reqFailure (dblResp))

160 el "br" (return ())

298 el "br" (return ())

161 divClass "double-result" $ el "p" $ dynText =<<

299 divClass "double-result" $ el "p" $ dynText =<<

162− holdDyn "No number yet" (fmap tShow $

300+ holdDyn "No number yet" (fmap tshow $

163 fmapMaybe reqSuccess (dblResp))

301 fmapMaybe reqSuccess (dblResp))

164 return dblBtn

302 return dblBtn

165

303

@@ -168,7 +306,7 @@ run = mdo

168 b <- value <$> checkbox False def

306 b <- value <$> checkbox False def

169 mpGo <- button "Test"

307 mpGo <- button "Test"

170 multiResp <- multi b (tag (current reqCount) mpGo)

308 multiResp <- multi b (tag (current reqCount) mpGo)

171− dynText =<< holdDyn "No res yet" (fmap tShow $

309+ dynText =<< holdDyn "No res yet" (fmap tshow $

172 fmapMaybe reqSuccess $

310 fmapMaybe reqSuccess $

173 (multiResp))

311 (multiResp))

174 return mpGo

312 return mpGo

@@ -182,14 +320,15 @@ run = mdo

182 txt <- value <$> textInput def

320 txt <- value <$> textInput def

183 ev <- fmap (1 <$) $ button "Question"

321 ev <- fmap (1 <$) $ button "Question"

184 let dQ = Right . Question <$> traceDyn "will send: " txt

322 let dQ = Right . Question <$> traceDyn "will send: " txt

185− rr <- qna dQ ev

323+ -- rr <- qna dQ ev _ _

186 el "p" $

324 el "p" $

325+ return ()

187− dynText =<< holdDyn "No Answer" (unAnswer <$> fmapMaybe reqSuccess rr)

326+ -- dynText =<< holdDyn "No Answer" (unAnswer <$> fmapMaybe reqSuccess rr)

188

327

189 divClass "demo-group" $ do

328 divClass "demo-group" $ do

190 un <- fmap value $ text "Username" >> textArea def

329 un <- fmap value $ text "Username" >> textArea def

191 pw <- fmap value $ text "Unhidden PW" >> textArea def

330 pw <- fmap value $ text "Unhidden PW" >> textArea def

192− let ba :: Dynamic t (BasicAuthData ) = BasicAuthData

331+ let ba :: Dynamic t BasicAuthData = BasicAuthData

193 <$> fmap T.encodeUtf8 un

332 <$> fmap T.encodeUtf8 un

194 <*> fmap T.encodeUtf8 pw

333 <*> fmap T.encodeUtf8 pw

195 b <- button "Get secret"

334 b <- button "Get secret"

@@ -200,20 +339,20 @@ run = mdo

200

339

201showXhrResponse :: XhrResponse -> Text

340showXhrResponse :: XhrResponse -> Text

202showXhrResponse (XhrResponse stat stattxt rbmay rtmay respHeaders) =

341showXhrResponse (XhrResponse stat stattxt rbmay rtmay respHeaders) =

203− T.unlines ["stat: " <> tShow stat

342+ T.unlines ["stat: " <> tshow stat

204− ,"stattxt: " <> tShow stattxt

343+ ,"stattxt: " <> tshow stattxt

205 ,"resp: " <> maybe "" showRB rbmay

344 ,"resp: " <> maybe "" showRB rbmay

206− ,"rtext: " <> tShow rtmay

345+ ,"rtext: " <> tshow rtmay

207− ,"rHeaders: " <> tShow respHeaders]

346+ ,"rHeaders: " <> tshow respHeaders]

208

347

209−tShow :: Show a => a -> Text

348+tshow :: Show a => a -> Text

210−tShow = T.pack . show

349+tshow = T.pack . show

211

350

212showRB :: XhrResponseBody -> Text

351showRB :: XhrResponseBody -> Text

213−showRB (XhrResponseBody_Default t) = tShow t

352+showRB (XhrResponseBody_Default t) = tshow t

214−showRB (XhrResponseBody_Text t) = tShow t

353+showRB (XhrResponseBody_Text t) = tshow t

215showRB (XhrResponseBody_Blob t) = "<Blob>"

354showRB (XhrResponseBody_Blob t) = "<Blob>"

216−showRB (XhrResponseBody_ArrayBuffer t) = tShow t

355+showRB (XhrResponseBody_ArrayBuffer t) = tshow t

217

356

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

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

219note e = maybe (Left e) Right

358note e = maybe (Left e) Right

nix.confnew file+3

@@ -0,0 +1,3 @@

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

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

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

nix/nix.conf+1−2

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

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

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

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

3−trusted-users = travis

nix/reflex-platform.nix+2−2

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

1let

2− rev = "1aba6f367982bd6dd78ec2fda75ab246a62d32c5" ;

2+ rev = "a15d3a2411e7ca7d4ee4853b57c72fe83faee272";

3in import (builtins.fetchTarball

4 {

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

6− sha256 = "137vg6i8yy4lp6rz4wbvvhfcc9d9qf7j1b3fnng3r7sj63k7j664" ;

6+ sha256 = "1dsvw0lah7761vndip1hqal4fjpjv84ravinnfhy83jgfav5ivna";

7 }) {}

nix/servant-reflex.nixnew file+24

@@ -0,0 +1,24 @@

1+{ pkgs ? import <nixpkgs> {}, reflexPlatform, compiler ? "ghcjs" }:

3+let

5+ generic-lens-src = pkgs.fetchFromGitHub {

6+ owner = "kcsongor";

7+ repo = "generic-lens";

8+ rev = "6787a4e85d09ad9fcfe5baae53fea2cccbae5976";

9+ sha256 = "1bvjwxm4ik2zcx9s57ibi376y255vm5mawx12s1sjcn09mv1vvdh";

10+ };

11+

12+ ghcjsPackages = reflexPlatform.${compiler}.override {

13+ overrides = self: super: {

14+ servant = super.servant;

15+ generic-lens = pkgs.haskell.lib.dontCheck (self.callCabal2nix "generic-lens" generic-lens-src {

16+ inspection-testing = null;

17+ });

18+ wai = super.wai;

19+ servant-reflex = pkgs.haskell.lib.appendConfigureFlag

20+ (self.callPackage ../. {}) "-fExample";

21+ };

22+ };

23+

24+in ghcjsPackages.servant-reflex

nix/servant-snap.nix+6−4

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

1−# Servant-snap is marked broken in nixpkgs

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

2{ nixpkgs ? import <nixpkgs> {}}: self: super:

4{ nixpkgs ? import <nixpkgs> {}}: self: super:

3self.callCabal2nix "servant-snap" (nixpkgs.fetchgit {

5self.callCabal2nix "servant-snap" (nixpkgs.fetchgit {

4− url = "https://github.com/haskell-servant/servant-snap.git";

6+ url = "https://github.com/antislava/servant-snap.git";

5− rev = "af5172a6de5bb2a07eb1bf4c85952075ec6ecdf3";

7+ rev = "fc9658e8f52ebce9e4f304ea0c6705d697d4fa84";

6− sha256 = "sha256-fzzQGwG8Ko72OO/kwLMG52eNZSt3F2dxhNgM9gaO4yQ=";

8+ sha256 = "0zlipmx1fb73mhpnndwmdmigxxrsdnsnb1157pgsrxpx89l9pjig";

7}) {}

9}) {}

nix/testdriver.nixnew file+3

@@ -0,0 +1,3 @@

1+{ reflexPlatform }:

3+reflexPlatform.ghc.callPackage ../testdriver/default.nix {}

release.nixnew file+27

@@ -0,0 +1,27 @@

1+{ pkgs ? import <nixpkgs> {}, compiler ? "ghcjs" }:

3+let

4+ reflexPlatform =

5+ import ./nix/reflex-platform.nix {

6+ fetchFromGitHub = pkgs.fetchFromGitHub;

7+ };

9+in rec {

10+

11+ servant-reflex = import ./nix/servant-reflex.nix {

12+ reflexPlatform = reflexPlatform;

13+ compiler = compiler;

14+ };

15+ testserver = import ./nix/testserver.nix

16+ { reflexPlatform = reflexPlatform;

17+ servant-reflex = servant-reflex ;

18+ };

19+ testdriver = import ./nix/testdriver.nix

20+ { reflexPlatform = reflexPlatform;

21+ };

22+ testresults = import ./nix/testresults.nix

23+ { inherit reflexPlatform testserver testdriver;

24+ inherit (pkgs) curl;

25+ phantomjs = pkgs.phantomjs2;

26+ };

27+ }

servant-reflex.cabal+11−16

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

1Name: servant-reflex

2−Version: 0.3.6

2+Version: 0.3.4

3Synopsis: servant API generator for reflex apps

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

5License: BSD3

@@ -17,11 +17,13 @@ Flag Example

18library

19 exposed-modules:

20− Servant.Common.BaseUrl

21− Servant.Common.Req

22 Servant.Reflex

20 Servant.Reflex

23 Servant.Reflex.Multi

21 Servant.Reflex.Multi

23+ other-modules:

24+ Servant.Common.BaseUrl

25+ Servant.Common.Req

26+

25 hs-source-dirs: src

27 hs-source-dirs: src

26 build-depends:

28 build-depends:

27 base >= 4.8 && < 5,

29 base >= 4.8 && < 5,

@@ -29,17 +31,19 @@ library

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

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

30 containers >= 0.5.6 && < 0.7,

32 containers >= 0.5.6 && < 0.7,

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

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

34+ generic-lens,

32 exceptions >= 0.8 && < 0.11,

35 exceptions >= 0.8 && < 0.11,

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

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

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

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

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

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

36 jsaddle >= 0.8 && < 0.10,

39 jsaddle >= 0.8 && < 0.10,

40+ lens,

37 mtl >= 2.2.1 && < 2.3,

41 mtl >= 2.2.1 && < 2.3,

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

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

39− reflex >= 0.5 && < 0.9,

43+ reflex >= 0.5 && < 0.7,

40− reflex-dom-core >= 0.6 && < 0.7,

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

41 safe >= 0.3.9 && < 0.4,

45 safe >= 0.3.9 && < 0.4,

42− servant >= 0.16 && < 0.18,

46+ servant >= 0.8 && < 0.18,

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

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

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

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

45 text >= 1.2 && < 1.3,

49 text >= 1.2 && < 1.3,

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

54 buildable: True

58 buildable: True

55 else

59 else

56 buildable: False

60 buildable: False

57− build-depends:

61+ build-depends: aeson, reflex, servant-reflex, base, scientific, servant, reflex-dom-core, text

58− aeson,

59− reflex,

60− servant-reflex,

61− base,

62− scientific,

63− servant,

64− reflex-dom,

65− reflex-dom-core,

66− text

67 default-language: Haskell2010

62 default-language: Haskell2010

68 main-is: Example.hs

63 main-is: Example.hs

69 other-modules: API

64 other-modules: API

src/Servant/Common/BaseUrl.hs+5−4

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

85 where pathWidget :: m (Dynamic t BaseUrl)

86 pathWidget = do

87 text "Url base path"

88− t <- inputElement def

88+ t <- textInput (def {_textInputConfig_attributes =

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

89 return $ BasePath <$> value t

90 return $ BasePath <$> value t

90 fullUrlWidget :: m (Dynamic t BaseUrl)

91 fullUrlWidget :: m (Dynamic t BaseUrl)

91 fullUrlWidget = do

92 fullUrlWidget = do

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

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

93− srv <- inputElement def

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

94 text ":"

95 text ":"

95− prt <- inputElement def

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

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

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

97− path <- inputElement def

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

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

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

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

@@ -19,7 +19,6 @@ import Control.Monad.IO.Class (MonadIO, liftIO)

19import Data.Bifunctor (first)

20import qualified Data.ByteString.Builder as Builder

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

22−import Data.ByteString (ByteString)

23import qualified Data.Map as Map

22import qualified Data.Map as Map

24import Data.Maybe (catMaybes, fromMaybe)

23import Data.Maybe (catMaybes, fromMaybe)

25import Data.Functor.Compose

24import Data.Functor.Compose

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

245 , _xhrRequestConfig_user = Nothing

244 , _xhrRequestConfig_user = Nothing

246 , _xhrRequestConfig_password = Nothing

245 , _xhrRequestConfig_password = Nothing

247 , _xhrRequestConfig_responseType = Just XhrResponseType_ArrayBuffer

246 , _xhrRequestConfig_responseType = Just XhrResponseType_ArrayBuffer

248− , _xhrRequestConfig_sendData = mempty

247+ , _xhrRequestConfig_sendData = ""

249 , _xhrRequestConfig_withCredentials = False

248 , _xhrRequestConfig_withCredentials = False

250 }

249 }

251 Just rBody -> liftA2 mkConfigBody xhrHeaders rBody

250 Just rBody -> liftA2 mkConfigBody xhrHeaders rBody

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

336

335

337

336

338

337

339−type XhrPayload = ByteString

338+type XhrPayload = T.Text

340bytesToPayload :: BL.ByteString -> XhrPayload

339bytesToPayload :: BL.ByteString -> XhrPayload

341−bytesToPayload = BL.toStrict

340+bytesToPayload = TE.decodeUtf8 . BL.toStrict

342

341

343

342

344performRequestsCT

343performRequestsCT

src/Servant/Reflex.hs+23−42

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

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

41import Control.Applicative

42−import qualified Data.CaseInsensitive as CI

43−import Data.Functor.Identity

44−import qualified Data.Map as Map

45import Data.Monoid ((<>))

42import Data.Monoid ((<>))

46−import Data.Proxy (Proxy (..))

47import qualified Data.Set as Set

43import qualified Data.Set as Set

44+import qualified Data.Text.Encoding as E

45+import Data.CaseInsensitive (mk)

46+import Data.Functor.Identity

47+import Data.Proxy (Proxy (..))

48+import qualified Data.Map as Map

48import Data.Text (Text)

49import Data.Text (Text)

49import qualified Data.Text as T

50import qualified Data.Text as T

50−import qualified Data.Text.Encoding as E

51import GHC.Exts (Constraint)

52import GHC.TypeLits (KnownSymbol, symbolVal)

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

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

54− BasicAuthData, BuildHeadersTo (..),

54+ BasicAuthData, BuildHeadersTo(..),

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

55+ Capture, contentType, Header,

56− HttpVersion, IsSecure,

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

57− MimeRender (..), MimeUnrender,

57+ MimeRender(..), MimeUnrender,

58 NoContent, QueryFlag, QueryParam,

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

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

60 RemoteHost, ReqBody,

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

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

62− contentType)

63−import Servant.API.Description (Summary)

64import qualified Servant.Auth as Auth

62import qualified Servant.Auth as Auth

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

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

67− XhrRequest (..), XhrResponse (..),

65+ XhrRequest(..),

68− XhrResponseHeaders (..),

66+ XhrResponseHeaders(..),

69− attachPromptlyDynWith, constDyn, ffor,

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

70− fmapMaybe, leftmost,

71− performRequestsAsync)

68+ leftmost, performRequestsAsync,

69+ )

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

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

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

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

74 showBaseUrl,

72 showBaseUrl,

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

103-- >

101-- >

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

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

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

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

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

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

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

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

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

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

109client

107client

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

228

226

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

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

230toHeaders r =

228toHeaders r =

229+ let toBS = E.encodeUtf8

231− let hdrs = maybe []

230+ hdrs = maybe []

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

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

233 (Map.toList $ _xhrResponse_headers xhr))

232 (Map.toList $ _xhrResponse_headers xhr))

234 (response r)

233 (response r)

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

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

236

235

237−

238class BuildHeaderKeysTo hs where

236class BuildHeaderKeysTo hs where

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

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

240

238

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

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

242 where buildHeaderKeysTo _ = []

240 where buildHeaderKeysTo _ = []

243

241

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

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

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

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

246− buildHeaderKeysTo _ =

247− let

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

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

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

250−

251

245

252-- HEADERS Verb (Content) --

246-- HEADERS Verb (Content) --

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

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

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

329 clientWithRouteAndResultHandler Proxy =

323 clientWithRouteAndResultHandler Proxy =

330 clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)

324 clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)

331

325

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

333−-- functions.

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

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

336−

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

338− Client t m sublayout tag

339−

340− clientWithRouteAndResultHandler Proxy =

341− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)

342−

343−

344−

345

326

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

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

347-- the corresponding querying function will automatically take

328-- the corresponding querying function will automatically take

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

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

37 ) where

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

40−import Control.Applicative (liftA2)

40+import Control.Applicative (liftA2)

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

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

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

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

43−import qualified Data.Set as Set

43+import qualified Data.Set as Set

44−import Data.Text (Text)

44+import Data.Text (Text)

45−import qualified Data.Text as T

45+import qualified Data.Text as T

46−import qualified Data.Text.Encoding as E

46+import qualified Data.Text.Encoding as E

47−import GHC.TypeLits (KnownSymbol, symbolVal)

47+import GHC.TypeLits (KnownSymbol, symbolVal)

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

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

49− BasicAuthData, BuildHeadersTo (..),

49+ BasicAuthData, BuildHeadersTo (..),

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

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

51− HttpVersion, IsSecure,

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

52− MimeRender (..), MimeUnrender,

53− NoContent, QueryFlag, QueryParam,

52+ MimeUnrender, NoContent, QueryFlag,

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

53+ QueryParam, QueryParams, Raw,

55− RemoteHost, ReqBody,

54+ ReflectMethod (..), RemoteHost,

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

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

57− contentType)

56+ Verb, contentType)

58−import Servant.API.Description (Summary)

57+

59−

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

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

61− XhrRequest (..),

59+ XhrRequest (..),

62− XhrResponseHeaders (..),

60+ XhrResponseHeaders (..),

63− attachPromptlyDynWith, constDyn)

61+ attachPromptlyDynWith, constDyn)

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

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

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

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

66 SupportsServantReflex)

64 SupportsServantReflex)

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

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

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

243

241

244

242

245−------------------------------------------------------------------------------

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

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

248−

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

250− ClientMulti t m sublayout f tag

251−

252− clientWithRouteMulti Proxy q f tag =

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

254−

255−

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

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

257instance (KnownSymbol sym,

244instance (KnownSymbol sym,

258 ToHttpApiData a,

245 ToHttpApiData a,

src/Servant/Reflex/RequestAPI.hsnew file+567

@@ -0,0 +1,567 @@

1+{-# LANGUAGE AllowAmbiguousTypes #-}

2+{-# LANGUAGE CPP #-}

3+{-# LANGUAGE DataKinds #-}

4+{-# LANGUAGE DeriveGeneric #-}

5+{-# LANGUAGE FlexibleContexts #-}

6+{-# LANGUAGE FlexibleInstances #-}

7+{-# LANGUAGE GADTs #-}

8+{-# LANGUAGE InstanceSigs #-}

9+{-# LANGUAGE MultiParamTypeClasses #-}

10+{-# LANGUAGE OverloadedStrings #-}

11+{-# LANGUAGE PolyKinds #-}

12+{-# LANGUAGE RankNTypes #-} -- Temporary

13+{-# LANGUAGE ScopedTypeVariables #-}

14+{-# LANGUAGE TupleSections #-}

15+{-# LANGUAGE TypeApplications #-}

16+{-# LANGUAGE TypeFamilies #-}

17+{-# LANGUAGE TypeOperators #-}

18+{-# LANGUAGE UndecidableInstances #-}

19+

20+module Servant.Reflex.RequestAPI where

21+

22+import Control.Arrow (first, second)

23+import Control.Lens

24+import Data.Generics.Product

25+import Data.Proxy

26+import Data.CaseInsensitive (mk)

27+import qualified Data.List as L

28+import qualified Data.Map as M

29+import Data.Maybe (catMaybes)

30+import Data.Semigroup ((<>))

31+import qualified Data.Set as Set

32+import qualified Data.Text.Encoding as E

33+import Data.Text (Text)

34+import qualified Data.Text as T

35+import qualified Data.ByteString.Lazy as BL

36+import GHC.Generics

37+import GHC.TypeLits (KnownSymbol, symbolVal)

38+import Reflex hiding (HList(..))

39+import Language.Javascript.JSaddle (MonadJSM)

40+import Servant.API hiding (HList(..))

41+import Servant.Common.Req hiding (QueryPart(..))

42+import Servant.Common.BaseUrl

43+

44+import Reflex.Dom hiding (HList(..))

45+

46+import Servant.Reflex (BuildHeaderKeysTo (..), toHeaders)

47+

48+{-

49+TODO:

50+ - [x] :<|>

51+ - [x] Verb content

52+ - [x] Verb nocontent

53+ - [x] Verb (Headers content)

54+ - [x] Verb (Headers nocontent)

55+ - [ ] Stream

56+ - [X] Capture :> ...

57+ - [ ] Capture' :> ...

58+ - [x] CaptureAll :> ...

59+ - [x] QueryParam :> ...

60+ - [x] QueryParams :> ...

61+ - [x] QueryFlag :> ...

62+ - [x] ReqBody :> ...

63+ - [ ] Header' :> ...

64+ - [x] Header :> ...

65+ - [x] Summary :> ...

66+ - [x] Description :> ...

67+ - [x] path :> ...

68+ - [ ] RemoteHost :> ...

69+ - [x] IsSecure :> ...

70+ - [x] Vault :> ...

71+ - [ ] WithNamedContext :> ...

72+ - [ ] AuthenticatedRequest :> ...

73+ - [x] BasicAuth :> ...

74+ - [ ] EmptyClient :> ...

75+ - [ ] EmptyClient

76+ - [ ] HttpVersion :> ...

77+-}

78+data HList xs where

79+ HNil :: HList '[]

80+ HCons :: x -> HList xs -> HList (x ': xs)

81+

82+clientR :: forall t m layout f . (HasClientR t m (Seal layout) f, Applicative f, Reflex t)

83+ => Proxy layout -> Proxy (m :: * -> *) -> Proxy t -> Proxy f

84+ -> Dynamic t BaseUrl -> ClientR t m (Seal layout) f

85+clientR _ mP tP fP url =

86+ clientRWithRoute (Proxy :: Proxy (Seal layout)) mP fP undefined url undefined

87+

88+-- | A class for generating top-level the API client function

89+class HasClientR t (m :: * -> *) api (f :: * -> *) where

90+ type ClientR t m api f :: *

91+ clientRWithRoute :: Proxy api -> Proxy m -> Proxy f

92+ -> Dynamic t (f (Req t)) -> Dynamic t BaseUrl

93+ -> ClientOptions -> ClientR t m api f

94+

95+-- instance EndpointR t m Raw f where

96+-- type EInputs t m Raw f = '[XhrRequest T.Text]

97+-- type EOutput t m Raw f = XhrResponse

98+

99+-- mkReq (HCons (XhrRequest method url conf) NHil) =

100+-- ReqR method

101+

102+

103+-- | A class for generating endpoint-level API client functions

104+-- We need two separate type classes because the needs of endpoints

105+-- and top-level clients are incompatible

106+--

107+-- Endpoints need to accumulate a list of their input types from

108+-- the API definition (the @EInputs@ associated type) when building

109+-- up a function from a sequence of @:>@ combinators. But for

110+-- sequences of @:<|>@ combinators, such a listing doesn't make

111+-- sense. So, we use one class for endpoint-level recursion and

112+-- another for collecting endpoints into the top-level API

113+class EndpointR t m api f where

114+

115+ type EInputs t m api f :: [*]

116+ type EOutput t m api f :: *

117+

118+ mkReq :: HList (EInputs t m api f) -> ReqR

119+ getResp :: XhrResponse -> EOutput t m api f

120+

121+

122+------------------------------------------------------------------------------

123+-- | :<|> APIs

124+instance {-# OVERLAPPING #-}

125+ (HasClientR t m (layoutLeft) f,

126+ HasClientR t m (layoutRight) f

127+ ) => HasClientR t m (layoutLeft :<|> layoutRight) f where

128+ type ClientR t m (layoutLeft :<|> layoutRight) f =

129+ ClientR t m layoutLeft f :<|> ClientR t m layoutRight f

130+ clientRWithRoute _ tP mP _ url opts =

131+ clientRWithRoute (Proxy @layoutLeft) tP mP undefined url opts

132+ :<|>

133+ clientRWithRoute (Proxy @layoutRight) tP mP undefined url opts

134+

135+#if MIN_VERSION_servant (0,13,0)

136+-- TODO: Untested

137+instance HasClientR t m EmptyClient f where

138+ type ClientR t m api f = EmptyClient

139+ clientRWithRoute _ _ _ _ _ _ = EmptyClient

140+#endif

141+

142+

143+class ToTuple xs where

144+ type Tuple xs :: *

145+ toTuple :: xs -> Tuple xs

146+ fromTuple :: Tuple xs -> xs

147+

148+data Sealed a

149+data SealedRaw

150+

151+type family Seal a where

152+ Seal (a :<|> b) = Seal a :<|> Seal b

153+ Seal Raw = SealedRaw

154+ Seal a = Sealed a

155+

156+

157+-- | Turn a single Endpoint into a client, by turning the input HList

158+-- into a tuple

159+instance {-# OVERLAPPING #-} forall t m layout f .(EndpointR t m layout f,

160+ ToTuple (HList (EInputs t m layout f)),

161+ Monad m

162+ , Traversable f

163+ , SupportsServantReflex t m

164+ ) => HasClientR t (m :: * -> *) (Sealed layout) (f :: * -> *) where

165+ type ClientR t m (Sealed layout) f =

166+ Event t (f (Tuple (HList (EInputs t m layout f))))

167+ -> m (Event t (f (EOutput t m layout f)))

168+ clientRWithRoute _ mP fP dReq url opts (reqs :: Event t (f (Tuple (HList (EInputs t m layout f ))))) = do

169+ let reqTuples = fmap (fromTuple @(HList (EInputs t m layout f ))) <$> reqs

170+

171+ -- TODO: replace these 2 lines w/ the next 2. The trace is for library debugging

172+ reqRs = traceEventWith (concat . fmap ((<> "\n") . show)) $ fmap (mkReq @t @m @layout @f) <$> reqTuples

173+ reqs' = ffor (attachPromptlyDyn url reqRs) $ \(bUrl, rs) -> mkXhrRequest bUrl <$> rs

174+ -- reqs' = ffor (attachPromptlyDyn url reqTuples) $ \(bUrl, inputs) ->

175+ -- mkXhrRequest bUrl . mkReq @t @m @layout @f <$> inputs

176+ resps <- performRequestsAsync $ reqs'

177+ return (fmap (getResp @t @m @layout @f) <$> resps)

178+

179+

180+instance (SupportsServantReflex t m, Traversable f) => HasClientR t m SealedRaw f where

181+ type ClientR t m SealedRaw f = Event t (f (XhrRequest T.Text)) -> m (Event t (f XhrResponse))

182+ clientRWithRoute _ mP fP dReq url opts reqs = performRequestsAsync reqs

183+

184+

185+instance {-# OVERLAPPING #-}(MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts), SupportsServantReflex t m, Applicative f

186+ ) => EndpointR t m (Verb method status cts' a) f where

187+ type EInputs t m (Verb method status cts' a) f = '[]

188+ type EOutput t m (Verb method status cts' a) f = Either String a

189+

190+ mkReq _ = emptyReqR . E.decodeUtf8 $ reflectMethod (Proxy @method)

191+ getResp resp = case _xhrResponse_response resp of

192+ Just (XhrResponseBody_ArrayBuffer x) -> mimeUnrender (Proxy @ct) (BL.fromStrict x)

193+

194+instance {-# OVERLAPPING #-}(ReflectMethod method, SupportsServantReflex t m, Applicative f

195+ ) => EndpointR t m (Verb method status cts' NoContent) f where

196+ type EInputs t m (Verb method status cts' NoContent) f = '[]

197+ type EOutput t m (Verb method status cts' NoContent) f = Either String NoContent

198+

199+ mkReq _ = emptyReqR . E.decodeUtf8 $ reflectMethod (Proxy @method)

200+ getResp resp = Right NoContent -- TODO: Should EOutput be `NoContent` rather than Either... ?

201+

202+

203+instance {-# OVERLAPPING #-}

204+ (MimeUnrender ct a,

205+ BuildHeadersTo hs,

206+ ReflectMethod method, cts' ~ (ct ': cts),

207+ SupportsServantReflex t m,

208+ Applicative f,

209+ BuildHeaderKeysTo hs

210+ ) => EndpointR t m (Verb method status cts' (Headers hs a)) f where

211+ type EInputs t m (Verb method status cts' (Headers hs a)) f = '[]

212+ type EOutput t m (Verb method status cts' (Headers hs a)) f = Either String (Headers hs a)

213+

214+ mkReq _ = set (field @"reqRRespHeaders") (OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy @hs)))) $ emptyReqR $ E.decodeUtf8 $ reflectMethod (Proxy @method)

215+ getResp resp = case _xhrResponse_response resp of

216+ Just (XhrResponseBody_ArrayBuffer x) ->

217+ let hs = buildHeadersTo

218+ . fmap (first (mk . E.encodeUtf8) . second E.encodeUtf8)

219+ . M.toList

220+ $ _xhrResponse_headers resp

221+ in fmap (flip Headers (hs)) $ mimeUnrender (Proxy @ct) (BL.fromStrict x)

222+

223+

224+instance {-# OVERLAPPING #-}(MimeUnrender ct a,

225+ BuildHeadersTo hs,

226+ BuildHeaderKeysTo hs,

227+ ReflectMethod method,

228+ SupportsServantReflex t m,

229+ Applicative f

230+ ) => EndpointR t m (Verb method status cts' (Headers hs NoContent)) f where

231+ type EInputs t m (Verb method status cts' (Headers hs NoContent)) f = '[]

232+ type EOutput t m (Verb method status cts' (Headers hs NoContent)) f = Either String (Headers hs NoContent)

233+

234+ mkReq _ = set (field @"reqRRespHeaders") (OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy @hs)))) $ emptyReqR . E.decodeUtf8 $ reflectMethod (Proxy @method)

235+ getResp resp = case _xhrResponse_response resp of

236+ Just (XhrResponseBody_ArrayBuffer x) ->

237+ let hs = buildHeadersTo

238+ . fmap (first (mk . E.encodeUtf8) . second E.encodeUtf8)

239+ . M.toList

240+ $ _xhrResponse_headers resp

241+ in Right (Headers NoContent hs)

242+

243+

244+instance (SupportsServantReflex t m,

245+ ToHttpApiData a,

246+ EndpointR t m sublayout f,

247+ Applicative f

248+ ) => EndpointR t m (Capture capture a :> sublayout) f where

249+

250+ type EInputs t m (Capture capture a :> sublayout) f = a ': EInputs t m sublayout f

251+ type EOutput t m (Capture capture a :> sublayout) f = EOutput t m sublayout f

252+

253+ mkReq (HCons x xs) = (\a -> over (field @"reqRPathParts") (toUrlPiece a:)) x $

254+ mkReq @t @m @sublayout @f xs

255+

256+ getResp = getResp @t @m @sublayout @f

257+

258+instance (SupportsServantReflex t m,

259+ ToHttpApiData a,

260+ EndpointR t m sublayout f,

261+ Applicative f

262+ ) => EndpointR t m (CaptureAll capture a :> sublayout) f where

263+

264+ type EInputs t m (CaptureAll capture a :> sublayout) f = [a] ': EInputs t m sublayout f

265+ type EOutput t m (CaptureAll capture a :> sublayout) f = EOutput t m sublayout f

266+

267+ mkReq (HCons x xs) = (\a -> over (field @"reqRPathParts") (fmap toUrlPiece a <>)) x $

268+ mkReq @t @m @sublayout @f xs

269+

270+ getResp = getResp @t @m @sublayout @f

271+

272+

273+instance (SupportsServantReflex t m,

274+ KnownSymbol sym,

275+ EndpointR t m sublayout f,

276+ Applicative f

277+ ) => EndpointR t m (sym :> sublayout) f where

278+

279+ type EInputs t m (sym :> sublayout) f = EInputs t m sublayout f

280+ type EOutput t m (sym :> sublayout) f = EOutput t m sublayout f

281+

282+ mkReq r = over (field @"reqRPathParts") (T.pack (symbolVal (Proxy @sym)) :) $ mkReq @t @m @sublayout @f r

283+

284+ getResp = getResp @t @m @sublayout @f

285+

286+instance (SupportsServantReflex t m,

287+ ToHttpApiData a,

288+ EndpointR t m sublayout f,

289+ KnownSymbol sym,

290+ Applicative f

291+ ) => EndpointR t m (QueryParam sym a :> sublayout) f where

292+

293+ type EInputs t m (QueryParam sym a :> sublayout) f = Maybe a ': EInputs t m sublayout f

294+ type EOutput t m (QueryParam sym a :> sublayout) f = EOutput t m sublayout f

295+

296+ mkReq (HCons x xs) = over (field @"reqRParams") ((T.pack $ symbolVal (Proxy @sym),

297+ QueryPartParam $ fmap (toQueryParam) x) : ) $

298+ mkReq @t @m @sublayout @f xs

299+

300+

301+ getResp = getResp @t @m @sublayout @f

302+

303+instance (SupportsServantReflex t m,

304+ ToHttpApiData a,

305+ EndpointR t m sublayout f,

306+ KnownSymbol sym,

307+ Applicative f

308+ ) => EndpointR t m (QueryParams sym a :> sublayout) f where

309+

310+ type EInputs t m (QueryParams sym a :> sublayout) f = [a] ': EInputs t m sublayout f

311+ type EOutput t m (QueryParams sym a :> sublayout) f = EOutput t m sublayout f

312+

313+ mkReq (HCons x xs) =

314+ let newParams = (T.pack (symbolVal (Proxy @sym)), QueryPartParams (toQueryParam <$> x))

315+ in over (field @"reqRParams") (newParams :) $ mkReq @t @m @sublayout @f xs

316+

317+ getResp = getResp @t @m @sublayout @f

318+

319+instance (SupportsServantReflex t m,

320+ EndpointR t m sublayout f,

321+ KnownSymbol sym,

322+ Applicative f

323+ ) => EndpointR t m (QueryFlag sym :> sublayout) f where

324+

325+ type EInputs t m (QueryFlag sym :> sublayout) f = Bool ': EInputs t m sublayout f

326+ type EOutput t m (QueryFlag sym :> sublayout) f = EOutput t m sublayout f

327+

328+ mkReq (HCons x xs) =

329+ let newParam = (T.pack (symbolVal (Proxy @sym)), QueryPartFlag x)

330+ in over (field @"reqRParams") (newParam :) $ mkReq @t @m @sublayout @f xs

331+

332+ getResp = getResp @t @m @sublayout @f

333+

334+instance (SupportsServantReflex t m,

335+ EndpointR t m sublayout f,

336+ MimeRender ct a,

337+ Applicative f

338+ ) => EndpointR t m (ReqBody (ct ': cts) a :> sublayout) f where

339+

340+

341+ type EInputs t m (ReqBody (ct ': cts) a :> sublayout) f = a ': EInputs t m sublayout f

342+ type EOutput t m (ReqBody (ct ': cts) a :> sublayout) f = EOutput t m sublayout f

343+

344+ mkReq (HCons x xs) =

345+ set (field @"reqRBody") (Just (mimeRender (Proxy @ct) x, T.pack (show (contentType (Proxy @ct))))) $ mkReq @t @m @sublayout @f xs

346+

347+ getResp = getResp @t @m @sublayout @f

348+

349+

350+instance (SupportsServantReflex t m,

351+ EndpointR t m sublayout f,

352+ KnownSymbol sym,

353+ ToHttpApiData a,

354+ Applicative f

355+ ) => EndpointR t m (Header sym a :> sublayout) f where

356+

357+

358+ type EInputs t m (Header sym a :> sublayout) f = a ': EInputs t m sublayout f

359+ type EOutput t m (Header sym a :> sublayout) f = EOutput t m sublayout f

360+

361+ mkReq (HCons x xs) =

362+ over (field @"reqRHeaders")

363+ -- ((symbolVal (Proxy @sym), (mimeRender (Proxy @a) x)) :)

364+ ((T.pack $ symbolVal (Proxy @sym), E.decodeUtf8 $ toHeader x) :)

365+ $ mkReq @t @m @sublayout @f xs

366+

367+ getResp = getResp @t @m @sublayout @f

368+

369+#if MIN_VERSION_servant(0,13,0)

370+-- TODO: Untested

371+instance (SupportsServantReflex t m,

372+ EndpointR t m sublayout f,

373+ KnownSymbol sym,

374+ ToHttpApiData a,

375+ Applicative f

376+ ) => EndpointR t m (Summary desc :> sublayout) f where

377+

378+ type EInputs t m (Summary desc :> sublayout) f = EInputs t m sublayout f

379+ type EOutput t m (Summary desc :> sublayout) f = EOutput t m sublayout f

380+

381+ mkReq = mkReq @t @m @sublayout @f

382+

383+ getResp = getResp @t @m @sublayout @f

384+#endif

385+

386+

387+#if MIN_VERSION_servant(0,13,0)

388+-- TODO: Untested

389+instance (SupportsServantReflex t m,

390+ EndpointR t m sublayout f,

391+ KnownSymbol sym,

392+ ToHttpApiData a,

393+ Applicative f

394+ ) => EndpointR t m (Description desc :> sublayout) f where

395+

396+ type EInputs t m (Descriptiok desc :> sublayout) f = EInputs t m sublayout f

397+ type EOutput t m (Description desc :> sublayout) f = EOutput t m sublayout f

398+

399+ mkReq = mkReq @t @m @sublayout @f

400+

401+ getResp = getResp @t @m @sublayout @f

402+#endif

403+

404+instance (SupportsServantReflex t m,

405+ EndpointR t m sublayout f,

406+ KnownSymbol sym,

407+ ToHttpApiData a,

408+ Applicative f

409+ ) => EndpointR t m (IsSecure :> sublayout) f where

410+

411+

412+ type EInputs t m (IsSecure :> sublayout) f = EInputs t m sublayout f

413+ type EOutput t m (IsSecure :> sublayout) f = EOutput t m sublayout f

414+

415+ mkReq = mkReq @t @m @sublayout @f

416+

417+ getResp = getResp @t @m @sublayout @f

418+

419+instance (SupportsServantReflex t m,

420+ EndpointR t m sublayout f,

421+ KnownSymbol sym,

422+ ToHttpApiData a,

423+ Applicative f

424+ ) => EndpointR t m (Vault :> sublayout) f where

425+

426+

427+ type EInputs t m (Vault :> sublayout) f = EInputs t m sublayout f

428+ type EOutput t m (Vault :> sublayout) f = EOutput t m sublayout f

429+

430+ mkReq = mkReq @t @m @sublayout @f

431+

432+ getResp = getResp @t @m @sublayout @f

433+

434+instance (SupportsServantReflex t m,

435+ EndpointR t m sublayout f,

436+ Applicative f

437+ ) => EndpointR t m (BasicAuth realm usr :> sublayout) f where

438+

439+ type EInputs t m (BasicAuth realm usr :> sublayout) f = BasicAuthData ': EInputs t m sublayout f

440+ type EOutput t m (BasicAuth realm usr :> sublayout) f = EOutput t m sublayout f

441+

442+ mkReq (HCons x xs) =

443+ set (field @"reqRAuthData") (Just x) $ mkReq @t @m @sublayout @f xs

444+

445+ getResp = getResp @t @m @sublayout @f

446+

447+

448+instance ToTuple (HList '[]) where

449+ type Tuple (HList '[]) = ()

450+ toTuple _ = ()

451+ fromTuple _ = HNil

452+

453+instance ToTuple (HList '[a]) where

454+ type Tuple (HList '[a]) = a

455+ toTuple (HCons a HNil) = a

456+ fromTuple a = HCons a HNil

457+

458+instance ToTuple (HList '[a,b]) where

459+ type Tuple (HList '[a,b]) = (a,b)

460+ toTuple (HCons a (HCons b HNil)) = (a,b)

461+ fromTuple (a,b) = HCons a (HCons b HNil)

462+

463+instance ToTuple (HList '[a,b,c]) where

464+ type Tuple (HList '[a,b,c]) = (a,b,c)

465+ toTuple (HCons a (HCons b (HCons c HNil))) = (a,b,c)

466+ fromTuple (a,b,c) = HCons a (HCons b (HCons c HNil))

467+

468+type MyAPI = Header "hi" Int :> Capture "hello" Int :> Capture "hello2" Bool :> Get '[JSON] (Headers '[Header "hi" Int] Int)

469+ :<|> Get '[JSON] Bool

470+

471+type MyAPI2 = Raw

472+

473+

474+m :: forall t m.MonadWidget t m => m ()

475+m = do

476+ let (a :<|> b) = clientR (Proxy @MyAPI) (Proxy :: Proxy m) (Proxy :: Proxy t)

477+ (Proxy @[]) undefined

478+ btn <- button "Hello"

479+ resA <- a (fmap (:[]) ((2, 5,True) <$ btn))

480+ resB <- b (fmap (:[]) (() <$ btn))

481+ display =<< holdDyn "waiting" (leftmost [show <$> resB ])

482+ -- [show <$> resA

483+ -- , show <$> resB

484+ -- ])

485+

486+ let rawR = clientR (Proxy @MyAPI2) (Proxy @m) (Proxy @t) (Proxy @[]) undefined

487+ return ()

488+

489+data ReqR = ReqR

490+ { reqRMethod :: T.Text

491+ , reqRPathParts :: [T.Text]

492+ , reqRParams :: [(T.Text, QueryPart)]

493+ , reqRBody :: Maybe (BL.ByteString, T.Text)

494+ , reqRHeaders :: [(T.Text, T.Text)]

495+ , reqRRespHeaders :: XhrResponseHeaders

496+ , reqRAuthData :: Maybe BasicAuthData

497+ } deriving (Generic)

498+

499+instance Show ReqR where

500+ show (ReqR m pp ps b hs hs' a) = concat $ L.intersperse "\n" [

501+ "ReqR {"

502+ , ("reqRMethod = " <> show m)

503+ , ("reqRPathParts = " <> show pp)

504+ , ("reqRParams = " <> show ps)

505+ , ("reqRBody = " <> show b)

506+ , ("reqRHeaders = " <> show hs)

507+ , ("reqRRespHeaders = " <> show hs')

508+ , ("reqRAuthData = " <> maybe "Nothing" (const "Just <<redacted>>") a)

509+ ]

510+

511+emptyReqR :: T.Text -> ReqR

512+emptyReqR method = ReqR method [] [] Nothing [] (OnlyHeaders mempty) Nothing

513+

514+data QueryPart = QueryPartParam (Maybe Text)

515+ | QueryPartParams [Text]

516+ | QueryPartFlag Bool

517+ deriving (Show)

518+

519+mkXhrRequest :: BaseUrl -> ReqR -> XhrRequest T.Text

520+mkXhrRequest reqHost req =

521+ let path = T.intercalate "/" $ reqRPathParts req

522+

523+ queryPartString :: (Text, QueryPart) -> Maybe Text

524+ queryPartString (pName, qp) = case qp of

525+

526+ QueryPartParam Nothing -> Nothing

527+ QueryPartParam (Just a) -> Just (pName <> "=" <> escape a)

528+

529+ QueryPartParams ps -> Just . T.intercalate "&"

530+ $ fmap (\p -> pName <> "=" <> escape p)

531+ ps

532+

533+ QueryPartFlag True -> Just pName

534+ QueryPartFlag False -> Nothing

535+

536+ (</>) :: Text -> Text -> Text

537+ x </> y | ("/" `T.isSuffixOf` x) || ("/" `T.isPrefixOf` y) = x <> y

538+ | otherwise = x <> "/" <> y

539+

540+ queryString = T.intercalate "&" . catMaybes . map queryPartString $ reqRParams req

541+ url = showBaseUrl reqHost </> path <> if T.null queryString then "" else (T.cons '?' queryString)

542+

543+ (headers, body) =

544+ let headers0 = M.fromList $ reqRHeaders req

545+ in case reqRBody req of

546+ Nothing -> (headers0, "")

547+ Just (rb,ct) -> (M.insert "Content-Type" ct headers0,

548+ E.decodeUtf8 $ BL.toStrict rb)

549+

550+ xhrReqConfig = def

551+ { _xhrRequestConfig_headers = headers

552+ , _xhrRequestConfig_user = E.decodeUtf8 . basicAuthUsername <$> reqRAuthData req

553+ , _xhrRequestConfig_password = E.decodeUtf8 . basicAuthPassword <$> reqRAuthData req

554+ , _xhrRequestConfig_responseType = Just XhrResponseType_ArrayBuffer

555+ , _xhrRequestConfig_sendData = body

556+ , _xhrRequestConfig_responseHeaders = reqRRespHeaders req

557+ , _xhrRequestConfig_withCredentials = False

558+ }

559+ xhrReq = XhrRequest (reqRMethod req) url xhrReqConfig

560+ in xhrReq

561+

562+transformExample :: MonadWidget t m => ((Int, Char) -> Performable m Bool) -> Event t (Int, Char) -> m (Event t Bool)

563+transformExample f = \triggers -> performEvent (f <$> triggers)

564+-- transformExample = undefined -- let x = performEvent :: _ in undefined

565+

566+transform :: MonadWidget t m => forall a. (inp -> IO outp) -> (Event t inp -> m (Event t outp))

567+transform = undefined

testdriver/default.nixnew file+16

@@ -0,0 +1,16 @@

1+{ mkDerivation, base, hspec, hspec-webdriver, stdenv, text

2+, webdriver

3+}:

4+mkDerivation {

5+ pname = "testdriver";

6+ version = "0.2";

7+ src = ./.;

8+ isLibrary = false;

9+ isExecutable = true;

10+ executableHaskellDepends = [

11+ base hspec hspec-webdriver text webdriver

12+ ];

13+ description = "Selenium test driver for Servant reflex";

14+ license = stdenv.lib.licenses.bsd3;

15+ hydraPlatforms = stdenv.lib.platforms.none;

16+}

testdriver/shell.nixnew file+1

@@ -0,0 +1 @@

1+(import ../release3.nix {}).testdriver.env

testserver/Main.hs+12−8

@@ -20,16 +20,16 @@ import Data.Text hiding (head, length, map,

20import qualified Data.Text as T

21import qualified Data.Text.IO as T

22import GHC.Generics

23−import Servant.Server.Internal.SnapShims

23+import Snap.Core hiding (addHeader)

24−import Snap.Core

25import Snap.Http.Server

24import Snap.Http.Server

27import Servant

26import Servant

28−import Servant.Server

27+import Servant.Server ()

28+import System.Directory

29-- import Snap.Util.FileServe

30import System.Environment (lookupEnv)

31import API

32−import Snap

32+import Snap hiding (addHeader)

34-- * Example

@@ -52,7 +52,7 @@ data App = App { appStaticDir :: String }

52--

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

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

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

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

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

57 :<|> statics

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

@@ -66,15 +66,16 @@ server = return () :<|> return 100 :<|> sayhi :<|> dbl

66 | otherwise = T.intercalate ", " (L.init greetings)

67 <> ", and " <> L.last greetings <> ", "

68 return . modifier $ greetPart <> n

69+ dblint = return . (* 2)

69 dbl x = if x `elem` [4,13]

70 dbl x = if x `elem` [4,13]

70 then throwError $ err500 { errBody = "No unlucky numbers please" }

71 then throwError $ err500 { errBody = "No unlucky numbers please" }

71 else return $ x * 2

72 else return $ x * 2

72 multi = return . bool "Box unchecked" "Box Checked"

73 multi = return . bool "Box unchecked" "Box Checked"

73− qna q = do

74+ qna q nm fav = do

74 liftIO $ do

75 liftIO $ do

75 putStrLn $ "qna got: " ++ show q

76 putStrLn $ "qna got: " ++ show q

76 T.putStrLn $ unQuestion q

77 T.putStrLn $ unQuestion q

77− return $ Answer $ unQuestion q

78+ return $ addHeader (fromMaybe 10 nm) $ addHeader (fromMaybe False fav) $ (Answer $ unQuestion q)

78 serveSecret _ = do

79 serveSecret _ = do

79 req <- getRequest

80 req <- getRequest

80 liftIO $ putStrLn (show req)

81 liftIO $ putStrLn (show req)

@@ -99,4 +100,7 @@ initApp = makeSnaplet "myapp" "example" Nothing $ do

100

100-- Put this all to work!

101-- Put this all to work!

101main :: IO ()

102main :: IO ()

102−main = serveSnaplet mempty initApp

103+main = commandLineConfig emptyConfig >>= \cfg -> print cfg >> serveSnaplet cfg initApp

104+-- main = serveSnaplet (defaultConfig { accessLog = "/tmp/log/testserver-access.log"

105+-- , errorLog = "/tmp/log/testserver-error.log"

106+-- }) initApp

testserver/default.nixnew file+14

@@ -0,0 +1,14 @@

1+{ mkDerivation, aeson, base, servant, servant-snap, snap, snap-core

2+, snap-server, stdenv, text

3+}:

4+mkDerivation {

5+ pname = "testserver";

6+ version = "0.1.0.0";

7+ src = ./.;

8+ isLibrary = false;

9+ isExecutable = true;

10+ executableHaskellDepends = [

11+ aeson base servant servant-snap snap snap-core snap-server text

12+ ];

13+ license = stdenv.lib.licenses.bsd3;

14+}

testserver/shell.nixnew file+1

@@ -0,0 +1 @@

1+(import ../release.nix {}).testserver.env

testserver/testserver.cabal+3−3

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

19 main-is: Main.hs

20 -- other-modules:

21 -- other-extensions:

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

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

23− , base >=4.8 && < 5

23+ , base >=4.8 && <4.14

24 , mtl

25 , snap >= 1.0 && < 1.2

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

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

28− , servant >= 0.16 && < 0.18

28+ , servant >= 0.8 && < 0.15

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

30 , text >= 1.0 && < 1.3

31 -- hs-source-dirs:

travis.nix−1

@@ -48,7 +48,6 @@ in

48 inherit reflexPlatform ghcPkgs ghcjsPkgs;

50 build = ghcjsPkgs.servant-reflex;

51− buildGhc = ghcPkgs.servant-reflex;

52 testserver = ghcPkgs.testserver;

51 testserver = ghcPkgs.testserver;

53 testdriver = ghcPkgs.testdriver;

52 testdriver = ghcPkgs.testdriver;

54 inherit testresults;

53 inherit testresults;