013eab1...master · typeable/servant-reflex

.gitignore+2

since splitsnapshots

unifiedsplit

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

7*.stats

8out

9/.stack-work/

10+TAGS

11+dist-newstyle

.travis.yml+4−2

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

1language: nix

2−nix: 2.1.1

2+nix: 2.3.6

3sudo: require

4

5−install:

5+before_install:

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

7

8before_script:

9+ - sudo systemctl restart nix-daemon.service

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

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

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

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

11

12

12script:

13script:

13 - nix-build travis.nix -A build

14 - nix-build travis.nix -A build

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

14 - nix-build travis.nix -A testserver

16 - nix-build travis.nix -A testserver

15 - nix-build travis.nix -A testresults

17 - nix-build travis.nix -A testresults

changelog.md → ChangeLog.mdrenamed+14−1

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

1+0.3.5

2+-----

3+

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

5+ - Require servant >= 0.16

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

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

8+

9+0.3.4

10+-----

11+

12+Add selenium-based test suite

13+

10.3.3

140.3.3

2-----

15-----

3

16

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

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

5

18

6

19

70.3.2

200.3.2

README.md+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](haskell-servant.readthedocs.io) combinators, you can use

10+[servant](https://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+11−19

@@ -1,29 +1,21 @@

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

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

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

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

3−, http-media, jsaddle, mtl, network-uri, reflex, reflex-dom

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

4−, reflex-dom-core, safe, scientific, servant, servant-auth, stdenv

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

5−, string-conversions, text, transformers

5+, transformers

6}:

7mkDerivation {

8 pname = "servant-reflex";

9− version = "0.3.4";

9+ version = "0.3.6";

10− src = builtins.filterSource

11− (path: type:

12− baseNameOf path != "result"

13− && baseNameOf path != "nix"

14− ) ./.;

10+ src = ./.;

15− configureFlags = [ "-fexample" ];

16 isLibrary = true;

11 isLibrary = true;

17 isExecutable = true;

12 isExecutable = true;

18 libraryHaskellDepends = [

13 libraryHaskellDepends = [

19 base bytestring case-insensitive containers data-default exceptions

14 base bytestring case-insensitive containers data-default exceptions

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

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

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

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

22− transformers

17+ text transformers

23 ];

18 ];

24− executableHaskellDepends = [

25− aeson base reflex reflex-dom scientific servant text

26− ];

27− description = "Servant reflex API generator";

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

28 license = stdenv.lib.licenses.bsd3;

20 license = stdenv.lib.licenses.bsd3;

29−}

21+}

exec/Example.hs+2−1

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

21import API

22import Data.Proxy

23import Text.Read (readMaybe)

24−import Reflex.Dom hiding (run)

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

25+import Reflex.Dom (mainWidget)

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

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

26import Servant.Reflex

27import Servant.Reflex

27import Servant.Reflex.Multi

28import Servant.Reflex.Multi

nix/hspec-webdriver.patchdeleted−36

@@ -1,36 +0,0 @@

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/nix.conf+2−1

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

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

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

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

3+trusted-users = travis

nix/reflex-platform.nix+2−2

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

1let

2− rev = "3d232e2d1d8e8d10fbafc928972c901c764ae324";

2+ rev = "1aba6f367982bd6dd78ec2fda75ab246a62d32c5" ;

3in import (builtins.fetchTarball

4 {

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

6− sha256 = "15ysjn0aknbl06spn4qls7xapm0d3qw2awx6k8jl28zwkaid45yg";

6+ sha256 = "137vg6i8yy4lp6rz4wbvvhfcc9d9qf7j1b3fnng3r7sj63k7j664" ;

7 }) {}

nix/servant-snap.nixnew file+7

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

1+# Servant-snap is marked broken in nixpkgs

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

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

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

5+ rev = "af5172a6de5bb2a07eb1bf4c85952075ec6ecdf3";

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

7+}) {}

servant-reflex.cabal+22−15

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

1Name: servant-reflex

2−Version: 0.3.4

2+Version: 0.3.6

3−Synopsis: Servant reflex API generator

3+Synopsis: servant API generator for reflex apps

4−Description: Servant reflex API generator

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

5License: BSD3

6License-file: LICENSE.md

7Author: Greg Hale, Doug Beardsley

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

17

18library

19 exposed-modules:

20− Servant.Reflex

21− Servant.Reflex.Multi

22−

23− other-modules:

24 Servant.Common.BaseUrl

20 Servant.Common.BaseUrl

25 Servant.Common.Req

21 Servant.Common.Req

22+ Servant.Reflex

23+ Servant.Reflex.Multi

26

24

27 hs-source-dirs: src

25 hs-source-dirs: src

28 build-depends:

26 build-depends:

29 base >= 4.8 && < 5,

27 base >= 4.8 && < 5,

30 bytestring >= 0.10 && < 0.11,

28 bytestring >= 0.10 && < 0.11,

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

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

32− containers >= 0.5.6 && < 0.6,

30+ containers >= 0.5.6 && < 0.7,

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

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

34 exceptions >= 0.8 && < 0.11,

32 exceptions >= 0.8 && < 0.11,

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

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

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

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

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

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

38 jsaddle >= 0.8 && < 0.10,

36 jsaddle >= 0.8 && < 0.10,

39 mtl >= 2.2.1 && < 2.3,

37 mtl >= 2.2.1 && < 2.3,

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

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

41− reflex >= 0.5 && < 0.6,

39+ reflex >= 0.5 && < 0.9,

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

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

43 safe >= 0.3.9 && < 0.4,

41 safe >= 0.3.9 && < 0.4,

44− servant >= 0.8 && < 0.15,

42+ servant >= 0.16 && < 0.19,

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

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

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

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

47 text >= 1.2 && < 1.3,

45 text >= 1.2 && < 1.3,

48 transformers >= 0.4 && < 0.6

46 transformers >= 0.4 && < 0.6

49

47

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

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

51

49

52 default-language: Haskell2010

50 default-language: Haskell2010

53

51

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

56 buildable: True

54 buildable: True

57 else

55 else

58 buildable: False

56 buildable: False

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

57+ build-depends:

58+ aeson,

59+ reflex,

60+ servant-reflex,

61+ base,

62+ scientific,

63+ servant,

64+ reflex-dom,

65+ reflex-dom-core,

66+ text

60 default-language: Haskell2010

67 default-language: Haskell2010

61 main-is: Example.hs

68 main-is: Example.hs

62 other-modules: API

69 other-modules: API

shell.nixnew file+1

@@ -0,0 +1 @@

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

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

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

1{-# LANGUAGE ConstraintKinds #-}

2+{-# LANGUAGE CPP #-}

2{-# LANGUAGE DeriveDataTypeable #-}

3{-# LANGUAGE DeriveDataTypeable #-}

3{-# LANGUAGE DeriveGeneric #-}

4{-# LANGUAGE DeriveGeneric #-}

4{-# LANGUAGE FlexibleContexts #-}

5{-# LANGUAGE FlexibleContexts #-}

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

31import Reflex.Dom.Core

32import Reflex.Dom.Core

32import Text.Read

33import Text.Read

33

34

34−

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

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

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

37+#else

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

39+#endif

36

40

37-- | URI scheme to use

41-- | URI scheme to use

38data Scheme =

42data Scheme =

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

85 where pathWidget :: m (Dynamic t BaseUrl)

89 where pathWidget :: m (Dynamic t BaseUrl)

86 pathWidget = do

90 pathWidget = do

87 text "Url base path"

91 text "Url base path"

88− t <- textInput (def {_textInputConfig_attributes =

92+ t <- inputElement def

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

90 return $ BasePath <$> value t

93 return $ BasePath <$> value t

91 fullUrlWidget :: m (Dynamic t BaseUrl)

94 fullUrlWidget :: m (Dynamic t BaseUrl)

92 fullUrlWidget = do

95 fullUrlWidget = do

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

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

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

97+ srv <- inputElement def

95 text ":"

98 text ":"

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

99+ prt <- inputElement def

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

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

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

101+ path <- inputElement def

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

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

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

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

12

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

14import Control.Applicative (liftA2, liftA3)

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

15import Control.Concurrent

16import Control.Concurrent

16import Control.Monad (join)

17import Control.Monad (join)

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

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

18import Data.Bifunctor (first)

19import Data.Bifunctor (first)

19import qualified Data.ByteString.Builder as Builder

20import qualified Data.ByteString.Builder as Builder

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

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

22+import Data.ByteString (ByteString)

21import qualified Data.Map as Map

23import qualified Data.Map as Map

22import Data.Maybe (catMaybes, fromMaybe)

24import Data.Maybe (catMaybes, fromMaybe)

23import Data.Functor.Compose

25import Data.Functor.Compose

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

91reqFailure (RequestFailure _ s) = Just s

93reqFailure (RequestFailure _ s) = Just s

92reqFailure _ = Nothing

94reqFailure _ = Nothing

93

95

96+------------------------------------------------------------------------------

97+-- | Simple filter/accessor like 'reqFailure', but keeping the request tag

98+reqFailure' :: ReqResult tag a -> Maybe (tag,Text)

99+reqFailure' (ResponseFailure tag s _) = Just (tag,s)

100+reqFailure' (RequestFailure tag s) = Just (tag,s)

101+reqFailure' _ = Nothing

102+

94

103

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

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

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

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

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

236 , _xhrRequestConfig_user = Nothing

245 , _xhrRequestConfig_user = Nothing

237 , _xhrRequestConfig_password = Nothing

246 , _xhrRequestConfig_password = Nothing

238 , _xhrRequestConfig_responseType = Just XhrResponseType_ArrayBuffer

247 , _xhrRequestConfig_responseType = Just XhrResponseType_ArrayBuffer

239− , _xhrRequestConfig_sendData = ""

248+ , _xhrRequestConfig_sendData = mempty

240 , _xhrRequestConfig_withCredentials = False

249 , _xhrRequestConfig_withCredentials = False

241 }

250 }

242 Just rBody -> liftA2 mkConfigBody xhrHeaders rBody

251 Just rBody -> liftA2 mkConfigBody xhrHeaders rBody

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

289performSomeRequestsAsync

298performSomeRequestsAsync

290 :: (MonadIO (Performable m),

299 :: (MonadIO (Performable m),

291 MonadJSM (Performable m),

300 MonadJSM (Performable m),

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

292 HasWebView (Performable m),

302 HasWebView (Performable m),

303+#endif

293 PerformEvent t m,

304 PerformEvent t m,

294 TriggerEvent t m,

305 TriggerEvent t m,

295 Traversable f,

306 Traversable f,

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

327

338

328

339

329

340

330−type XhrPayload = T.Text

341+type XhrPayload = ByteString

331bytesToPayload :: BL.ByteString -> XhrPayload

342bytesToPayload :: BL.ByteString -> XhrPayload

332−bytesToPayload = TE.decodeUtf8 . BL.toStrict

343+bytesToPayload = BL.toStrict

333

344

334

345

335performRequestsCT

346performRequestsCT

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

394 else ResponseFailure tag errMsg xhr

405 else ResponseFailure tag errMsg xhr

395 in respPayld

406 in respPayld

396

407

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

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

410+-- response 'Event's,

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

412+fanReqResult = fmapMaybe reqFailure &&& fmapMaybe reqSuccess

413+

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

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

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

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

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

419+

397

420

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

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

399note e = maybe (Left e) Right

422note e = maybe (Left e) Right

src/Servant/Reflex.hs+45−27

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

39

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

41import Control.Applicative

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

43−import qualified Data.Set as Set

44−import qualified Data.Text.Encoding as E

45−import Data.CaseInsensitive (mk)

42+import qualified Data.CaseInsensitive as CI

46import Data.Functor.Identity

43import Data.Functor.Identity

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

48import qualified Data.Map as Map

44import qualified Data.Map as Map

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

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

47+import qualified Data.Set as Set

49import Data.Text (Text)

48import Data.Text (Text)

50import qualified Data.Text as T

49import qualified Data.Text as T

50+import qualified Data.Text.Encoding as E

51import GHC.Exts (Constraint)

52import GHC.TypeLits (KnownSymbol, symbolVal)

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

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

54− BasicAuthData, BuildHeadersTo(..),

54+ BasicAuthData, BuildHeadersTo (..),

55− Capture, contentType, Header,

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

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

56+ HttpVersion, IsSecure,

57− MimeRender(..), MimeUnrender,

57+ MimeRender (..), MimeUnrender,

58− NoContent, QueryFlag, QueryParam,

58+ NoContent, QueryFlag, QueryParam',

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

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

60 RemoteHost, ReqBody,

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

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

62+ contentType)

63+import Servant.API.Description (Summary)

62import qualified Servant.Auth as Auth

64import qualified Servant.Auth as Auth

63

65

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

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

65− XhrRequest(..),

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

66− XhrResponseHeaders(..),

68+ XhrResponseHeaders (..),

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

69+ attachPromptlyDynWith, constDyn, ffor,

70+ fmapMaybe, leftmost,

68− leftmost, performRequestsAsync,

71+ performRequestsAsync)

69− )

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

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

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

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

72 showBaseUrl,

74 showBaseUrl,

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

101-- >

103-- >

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

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

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

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

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

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

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

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

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

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

107client

109client

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

226

228

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

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

228toHeaders r =

230toHeaders r =

229− let toBS = E.encodeUtf8

230− hdrs = maybe []

231+ let hdrs = maybe []

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

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

232 (Map.toList $ _xhrResponse_headers xhr))

233 (Map.toList $ _xhrResponse_headers xhr))

233 (response r)

234 (response r)

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

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

235

236

237+

236class BuildHeaderKeysTo hs where

238class BuildHeaderKeysTo hs where

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

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

238

240

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

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

240 where buildHeaderKeysTo _ = []

242 where buildHeaderKeysTo _ = []

241

243

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

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

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

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

246+ buildHeaderKeysTo _ =

247+ let

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

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

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

250+

245

251

246-- HEADERS Verb (Content) --

252-- HEADERS Verb (Content) --

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

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

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

323 clientWithRouteAndResultHandler Proxy =

329 clientWithRouteAndResultHandler Proxy =

324 clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)

330 clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)

325

331

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

333+-- functions.

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

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

336+

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

338+ Client t m sublayout tag

339+

340+ clientWithRouteAndResultHandler Proxy =

341+ clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)

342+

343+

344+

326

345

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

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

328-- the corresponding querying function will automatically take

347-- the corresponding querying function will automatically take

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

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

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

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

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

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

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

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

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

355

374

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

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

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

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

358

377

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

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

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

603 HasCookieAuth '[] = CookieAuthNotEnabled

622 HasCookieAuth '[] = CookieAuthNotEnabled

604

623

605class CookieAuthNotEnabled

624class CookieAuthNotEnabled

606−

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

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

37 ) where

38

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

40−import Control.Applicative (liftA2)

40+import Control.Applicative (liftA2)

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

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

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

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

43−import qualified Data.Set as Set

43+import qualified Data.Set as Set

44−import Data.Text (Text)

44+import Data.Text (Text)

45−import qualified Data.Text as T

45+import qualified Data.Text as T

46−import qualified Data.Text.Encoding as E

46+import qualified Data.Text.Encoding as E

47−import GHC.TypeLits (KnownSymbol, symbolVal)

47+import GHC.TypeLits (KnownSymbol, symbolVal)

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

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

49− BasicAuthData, BuildHeadersTo (..),

49+ BasicAuthData, BuildHeadersTo (..),

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

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

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

51+ HttpVersion, IsSecure,

52+ MimeRender (..), MimeUnrender,

52− MimeUnrender, NoContent, QueryFlag,

53+ NoContent, QueryFlag, QueryParam,

53− QueryParam, QueryParams, Raw,

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

54− ReflectMethod (..), RemoteHost,

55+ RemoteHost, ReqBody,

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

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

56− Verb, contentType)

57+ contentType)

57−

58+import Servant.API.Description (Summary)

59+

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

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

59− XhrRequest (..),

61+ XhrRequest (..),

60− XhrResponseHeaders (..),

62+ XhrResponseHeaders (..),

61− attachPromptlyDynWith, constDyn)

63+ attachPromptlyDynWith, constDyn)

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

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

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

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

64 SupportsServantReflex)

66 SupportsServantReflex)

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

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

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

241

243

242

244

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

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

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

248+

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

250+ ClientMulti t m sublayout f tag

251+

252+ clientWithRouteMulti Proxy q f tag =

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

254+

255+

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

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

244instance (KnownSymbol sym,

257instance (KnownSymbol sym,

245 ToHttpApiData a,

258 ToHttpApiData a,

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

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

23− , base >=4.8 && <4.12

23+ , base >=4.8 && < 5

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

28+ , servant >= 0.16 && < 0.18

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

30 , text >= 1.0 && < 1.3

31 -- hs-source-dirs:

travis.nix+6−13

@@ -18,28 +18,20 @@ let

18

19 ghcjsPkgs = with lib; reflexPlatform.${jsCompiler}.override {

20 overrides = self: super: {

21− http-media = dontCheck super.http-media;

21+ http-media = dontCheck super.http-media;

22− servant = do [ dontCheck doJailbreak ] super.servant;

22+ servant = dontCheck super.servant;

23+ lens-aeson = dontCheck super.lens-aeson;

23 servant-reflex = lib.appendConfigureFlag

24 servant-reflex = lib.appendConfigureFlag

24 (self.callPackage ./default.nix {}) "-fExample";

25 (self.callPackage ./default.nix {}) "-fExample";

25− uri-bytestring = doJailbreak super.uri-bytestring;

26− http-api-data = dontHaddock super.http-api-data;

27 };

26 };

28 };

27 };

29

28

30 ghcPkgs = with lib; reflexPlatform.${nativeCompiler}.override {

29 ghcPkgs = with lib; reflexPlatform.${nativeCompiler}.override {

31 overrides = self: super: {

30 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" {});

31+ servant-snap = dontCheck ((import ./nix/servant-snap.nix {}) self super);

40− skylighting = dontCheck super.skylighting;

41 testdriver = self.callCabal2nix "testdriver" ./testdriver {};

32 testdriver = self.callCabal2nix "testdriver" ./testdriver {};

42 testserver = import nix/testserver.nix ghcjsPkgs.servant-reflex self super;

33 testserver = import nix/testserver.nix ghcjsPkgs.servant-reflex self super;

34+ servant-reflex = self.callPackage ./default.nix {};

43 };

35 };

44 };

36 };

45

37

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

56 inherit reflexPlatform ghcPkgs ghcjsPkgs;

48 inherit reflexPlatform ghcPkgs ghcjsPkgs;

57

49

58 build = ghcjsPkgs.servant-reflex;

50 build = ghcjsPkgs.servant-reflex;

51+ buildGhc = ghcPkgs.servant-reflex;

59 testserver = ghcPkgs.testserver;

52 testserver = ghcPkgs.testserver;

60 testdriver = ghcPkgs.testdriver;

53 testdriver = ghcPkgs.testdriver;

61 inherit testresults;

54 inherit testresults;