master..a13bdbe · typeable/servant-reflex

git.iko.soy/typeable/servant-reflex

42 files changed+805−2869

unifiedsplit

.gitignore−11 .gitmodules+9 .travis.yml−17 ChangeLog.md−60 LICENSE.md−30 README.md−224 build.sh+3 default.nix+14−15 deploy_key.enc deps/reflex-dom-contrib+1 deps/servant+1 deps/try-reflex+1 exec/API.hs−69 exec/Example.hs−219 exec/toSite.sh−3 include/overlapping-compat.h−8 nix/nix.conf−3 nix/reflex-platform.nix−7 nix/servant-snap.nix−7 nix/testresults.nix−17 nix/testserver.nix−9 overrides.nix+8 servant-reflex.cabal+31−55 shell.nix−1 shell.sh+3 src/Servant/Common/BaseUrl.hs+47−72 src/Servant/Common/Req.hs+156−417 src/Servant/Reflex.hs+531−579 src/Servant/Reflex/Multi.hs−401 stack.yaml−56 testdriver/LICENSE.md−30 testdriver/deploy-code-coverage.sh−65 testdriver/runTestsAndCoverage.sh−59 testdriver/test/Servant/ReflexSpec.hs−94 testdriver/test/Spec.hs−1 testdriver/testdriver.cabal−26 testserver/API.hs−69 testserver/LICENSE−30 testserver/Main.hs−102 testserver/static/index.html−11 testserver/testserver.cabal−32 travis.nix−70

.gitignoredeleted−11

@@ -1,11 +0,0 @@

1−.cabal-sandbox

2−cabal.sandbox.config

3−dist

4−*.js

5−log

6−*.webapp

7−*.stats

8−out

9−/.stack-work/

10−TAGS

11−dist-newstyle

.gitmodules+9

@@ -0,0 +1,9 @@

1+[submodule "deps/reflex-dom-contrib"]

2+ path = deps/reflex-dom-contrib

3+ url = git@github.com:reflex-frp/reflex-dom-contrib.git

4+[submodule "deps/try-reflex"]

5+ path = deps/try-reflex

6+ url = git@github.com:ryantrinkle/try-reflex.git

7+[submodule "deps/servant"]

8+ path = deps/servant

9+ url = https://github.com/haskell-servant/servant.git

.travis.ymldeleted−17

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

1−language: nix

2−nix: 2.3.6

3−sudo: require

4−

5−before_install:

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

7−

8−before_script:

9− - sudo systemctl restart nix-daemon.service

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

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

12−

13−script:

14− - 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.mddeleted−60

@@ -1,60 +0,0 @@

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−

14−0.3.3

15−-----

16−

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

18−

19−

20−0.3.2

21−-----

22−

23−- **Addition of 'Servant.Reflex.Common.Req.ClientOpts'** which

24−allows the users to apply a final adjustment to Requests before

25−thery are sent, such as setting the 'withCredentials' flag

26−or print the Request to the console for debugging

27−[PR #47](https://github.com/imalsogreg/servant-reflex/pull/47)

28−

29−0.3

30−---

31−

32−- **Addition of the 'Servant.Reflex.Multi' module** which allows the user

33−to choose some '(Applicative f, Traversable f) => f' for collecting

34−endpoint parameters. The traversable instance is used for passing

35−multiple 'XhrRequest's in response to a single event trigger. The

36−Applicative instance is used to combine parameters. For example,

37−'Capture "id" Name :> QueryParam "greeting" Text :> Get '[JSON] Text'

38−will generate a client function:

39−`Dynamic t (f Name) -> Dynamic t (f greeting) -> Event t tag ->

40− m (Event t (f (ReqResult tag Text)))`

41−Calling that function with 'f' chosen to be list ('[]'), this call

42−`clientFun

43−(constDyn ["Greg", "Bernie"])

44−(constDyn ["Greetings", "Hey"])

45−trigger`

46−would produce four XhrRequests per 'trigger' event, one for each

47−combination of possible parameters, and one response event

48−would carry a list of the four responses.

49−A 'zip-wise' combination of the parameters can be chosen with

50−a different applicative wrapper: 'ZipList'

51−

52−- **Event tags**. A new type parameter lets users choose a payload

53−value to attach to outgoing requests at the point of triggering,

54−and which is embedded in the response, allowing individual

55−request-response pairs to be followed. The response's tag has been

56−added to each constructor `ReqResult tag a` type.

57−

58−- **Improved Unicode support** Thanks to Schell Scivally

59−(https://github.com/schell) for identifying and fixing a UTF-8

60−encoding bug!

LICENSE.mddeleted−30

@@ -1,30 +0,0 @@

2−

4−

5−Redistribution and use in source and binary forms, with or without

6−modification, are permitted provided that the following conditions are met:

7−

8− * Redistributions of source code must retain the above copyright

9− notice, this list of conditions and the following disclaimer.

10−

11− * Redistributions in binary form must reproduce the above

12− copyright notice, this list of conditions and the following

13− disclaimer in the documentation and/or other materials provided

14− with the distribution.

15−

16− * Neither the name of Greg Hale nor the names of other

17− contributors may be used to endorse or promote products derived

18− from this software without specific prior written permission.

19−

20−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS

21−"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT

22−LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR

23−A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT

24−OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

25−SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT

26−LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,

27−DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY

28−THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT

29−(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE

30−OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.mddeleted−224

@@ -1,224 +0,0 @@

1−# servant-reflex

2−

3−[![Build Status](https://travis-ci.org/imalsogreg/servant-reflex.svg?branch=master)](https://travis-ci.org/imalsogreg/servant-reflex)

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

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](https://haskell-servant.readthedocs.io) combinators, you can use

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

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

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

14−

15−

16−## Example

17−

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:

20−

21−```haskell

22−type API = "getint" :> Get '[JSON] Int

23− :<|> "sayhi" :> QueryParam "username" Text

24− :> QueryParams "greetings" Text

25− :> QueryFlag "gusto"

26− :> Get '[JSON] Text

27− :<|> "double" :> ReqBody '[JSON] Double

28− :> Post '[JSON] Double

29− :<|> Raw

30−```

31−

32−`servant-reflex` then computes client functions that can query the API through

33−an `XhrRequest`.

34−

35−```haskell

36−

37− runGUI :: forall t m.MonadWidget t m => do

38−

39− -- servant-reflex computes FRP functions for each API endpoint

40− let (getint :<|> sayhi :<|> doubleit :<|> _) = client (Proxy :: Proxy API)

41− (Proxy :: Proxy m)

42− (Proxy :: Proxy ())

43− (constDyn (BasePath "/"))

44−```

45−

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.

56−

57−```haskell

58− -- No need to write these functions. servant-reflex creates them for you!

59− getint :: MonadWidget t m

60− => Event t () -- ^ Trigger the XHR Request

61− -> m (Event t (ReqResult () Int)) -- ^ Consume the answer

62−

63− sayhi :: MonadWidget t m

64− => Dynamic t (QParam Text)

65− -- ^ One input parameter - the 'name', wrapped in 'QParam'

66− -> Dynamic t [Text]

67− -- ^ Another input: list of preferred greetings

68− -> Dynamic t Bool

69− -- ^ Flag for capitalizing the response

70− -> Event t ()

71− -- ^ Trigger the XHR Request

72− -> m (Event t (ReqResult () Text))

73−

74− doubleit :: MonadWidget t m

75− => Dynamic t (Either Text Double)

76− -> Event t ()

77− -> m (Event t (ReqResult () Double))

78−```

79−

80−`ReqResult tag a` is defined in

81−[`Servant.Common.Req`](https://github.com/imalsogreg/servant-reflex/blob/6d866e338edb9bf6fd8f8d5083ff0187b4d8c0d2/src/Servant/Common/Req.hs#L40-L42)

82−and reports whether or not your request was sent (if validation fails, the

83−request won't be sent), and how decoding of the response went. You can pattern

84−match on these explicitly, but usually you'll want to use

85−`fmapMaybe :: (a -> Maybe b) -> Event t a -> Event t b` and one of the

86−elimination functions to filter the result type you care about, like this:

87−

88−```haskell

89− -- ... continued ...

90− res :: Event t (ReqResult Double) <- doubleIt xs triggers

91− let ys = fmapMaybe reqSuccess res

92− errs = fmapMaybe reqFailure res

93−

94− -- Green <p> tag showing the last good result

95− elAttr "p" ("style" =: "color:green") $ do

96− text "Last good result: "

97− dynText =<< holdDyn "" (fmap show ys)

98−

99− -- Red <p> tag showing the last error, cleared by a new good value

100− elAttr "p" ("style" =: "color:red") $

101− dynText =<< holdDyn "" (leftmost [errs, const "" <$> ys])

102−```

103−

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:

106−

107−```haskell

108− elClass "div" "int-demo" $ do

109− intButton <- button "Get Int"

110− serverInts <- fmapMaybe resSuccess <$> getint intButton

111− display =<< holdDyn (Just 0) serverInts

112−

113− elClass "div" "hello-demo" $ do

114− nameText <- QParamSome . value <$> textInput def

115− greetings <- (fmap words . value) <$> textInput def

116− withGusto <- checkbox def

117− helloButton <- button "Say hi"

118− hellos <- fmapMaybe resResult <$> sayhi nameText greetings withGusto helloButton

119− display =<< holdDyn Nothing hellos

120−

121− elClass "div" "demo-double" $ do

122− inputDouble <- (fmapMaybe readMaybe) <$> textInput def

123− doubleButton <- button "Double it"

124− outputDouble <- fmapMaybe resSuccess <$> doubleit inputDouble doubleButton

125− display =<< holdDyn Nothing outputDouble

126−```

127−

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.

133−

134−

135−## Building the library and test server

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

141−([testserver/](https://github.com/imalsogreg/servant-reflex/tree/master/testserver).

142−To build these components, we will use the nix packages for the testserver. It

143−manages the frontend build as a dependency.

144−

145−```

146−nix build -f travis.nix testserver -o server

147−```

148−

149−Point it at the static directory and run it:

150−

151−```

152−STATIC_DIR=server/static server/back -p 8000

153−```

154−

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.

158−

159−**For a larger example of a project that shares types between backend and

160−frontend, see [hsnippet](https://github.com/mightybyte/hsnippet).**

161−

162−

163−## Tagging requests

164−

165−The input and the return type of a client function like `getDouble` are both

166−event streams. The individual input events and responses occur at different

167−times and aren't automatically paired up, but you can recover the

168−relationship by tagging the requests.

169−

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:

175−

176−```haskell

177− ...

178− inp <- textInput def

179−

180− -- Convert the raw text into an `Either Text Double`

181− let inpNum = maybe (Left "No Parse") Right . readMaybe . T.unpack <$> value inp

182− go <- button "Double It"

183−

184− -- Call 'doubleIt' with triggers that coincide with good input parses

185− rs <- doubleIt inpNum (fforMaybe (tagPromptlyDyn inpNum go) $ \case

186− Left _ -> Nothing

187− Right a -> Just a

188− )

189−

190− -- Accumulate good responses in a map

191− doubleTable <- foldDyn (<>) mempty $ ffor rs $ \case

192− ResponseSuccess tag v _ -> tag =: v

193− _ -> mempty

194−

195− el "table" $ do

196− listWithKey doubleTable $ \k dv -> el "tr" $ do

197− el "td" $ text (T.pack $ show k)

198− el "td" $ dynText (T.pack . show <$> dv)

199− ...

200−```

201−

202−## Simultaneous requests

203−

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:

208−

209−```haskell

210−sayHi

211− :: Dynamic t (f (QParam Text))

212− -> Dynamic t (f [Text])

213− -> Dynamic t (f Bool)

214− -> Event t tag

215− -> m (Event t (f (ReqResult tag Text)))

216−```

217−

218−The dynamic params are each wrapped in `f`. For every firing of the trigger

219−event `tag`, all of these parameters will be combined according to `f`'s

220−`Applicative` instance (when `f` is `[]`, you will get all combinations of

221−all parameters taken together as a request; when `f` is `ZipList`, the Nth

222−elemens of each parameters list will be taken together as a request). Using

223−this interface, you can trigger many XHR's from a single event occurence, and

224−expect the responses to be structured the same way as the requests.

build.shnew file+3

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

1+#!/bin/sh

3+deps/try-reflex/work-on ./overrides.nix ./. --run "cabal configure --ghcjs ; cabal build"

default.nix+14−15

@@ -1,21 +1,20 @@

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

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

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

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

5−, transformers

1+{ mkDerivation, exceptions, http-types, reflex, reflex-dom,

2+ reflex-dom-contrib, servant

63}:

75mkDerivation {

86 pname = "servant-reflex";

9− version = "0.3.6";

10− src = ./.;

11− isLibrary = true;

7+ version = "0.1";

8+ src = builtins.filterSource (path: type: baseNameOf path != ".git") ./.;

129 isExecutable = true;

13− libraryHaskellDepends = [

14− base bytestring case-insensitive containers data-default exceptions

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

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

17− text transformers

10+ isLibrary = true;

11+ buildDepends = [

12+ exceptions

13+ http-types

14+ reflex

15+ reflex-dom

16+ reflex-dom-contrib

17+ servant

1818 ];

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

20− license = stdenv.lib.licenses.bsd3;

19+ license = null;

2120}

deploy_key.encdeleted

Binary file not shown.

deps/reflex-dom-contribnew file+1

Submodule changed.

deps/servantnew file+1

Submodule changed.

deps/try-reflexnew file+1

Submodule changed.

exec/API.hsdeleted−69

@@ -1,69 +0,0 @@

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

exec/Example.hsdeleted−219

@@ -1,219 +0,0 @@

1−{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE FlexibleContexts #-}

3−{-# LANGUAGE GADTs #-}

4−{-# LANGUAGE OverloadedStrings #-}

5−{-# LANGUAGE RankNTypes #-}

6−{-# LANGUAGE RecursiveDo #-}

7−{-# LANGUAGE ScopedTypeVariables #-}

8−

9−module Main where

10−

11−------------------------------------------------------------------------------

12−import Data.Bool

13−import Data.Maybe

14−import Control.Monad.Fix (MonadFix)

15−import Data.Monoid (First(..), (<>))

16−import Data.Text (Text)

17−import qualified Data.Text as T

18−import qualified Data.Text.Encoding as T

19−import GHC.TypeLits

20−import Servant.API

21−import API

22−import Data.Proxy

23−import Text.Read (readMaybe)

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

25−import Reflex.Dom (mainWidget)

26−------------------------------------------------------------------------------

27−import Servant.Reflex

28−import Servant.Reflex.Multi

29−

30−

31−api :: Proxy API

32−api = Proxy

33−

34−main :: IO ()

35−main = mainWidget $ do

36− divClass "example-base" run

37− divClass "example-multi" runMulti

38−

39−

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

41− DomBuilder t m,

42− DomBuilderSpace m ~ GhcjsDomSpace,

43− MonadFix m,

44− PostBuild t m,

45− MonadHold t m) => m ()

46−runMulti = do

47− url <- baseUrlWidget

48− el "br" blank

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

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

51−

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

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

54−

55− b <- button "Run dbl multi"

56− reqCount :: Dynamic t Int <- count b

57− r <- dbl ((\x y -> [x,y]) <$> num <*> num2) (tag (current reqCount) b)

58− dynText =<< holdDyn "Waiting" (T.pack . show . fmap reqSuccess <$> r)

59−

60− lastInd <- holdDyn [] $ fmap reqTag <$> r

61− display lastInd

62−

63− divClass "demo-group" $ do

64− nms <- fmap (fmap T.words . value) $ divClass "" $ do

65− text "Names"

66− textInput def

67− grts <- fmap (fmap T.words . value) $ divClass "" $ do

68− text "Greetings"

69− textInput def

70− gust <- fmap (value) $ divClass "gusto-input" $ checkbox False def

71− b <- button "Go"

72− r' <- sayHi (fmap QParamSome <$> nms) (fmap (:[]) $ grts)

73− (constDyn [True, False]) (1 <$ b)

74−

75− dynText =<< holdDyn "Waiting" (T.pack . show . catMaybes .

76− fmap reqSuccess <$> r')

77−

78−

79− return ()

80−

81−run :: forall t m. (SupportsServantReflex t m,

82− DomBuilder t m,

83− DomBuilderSpace m ~ GhcjsDomSpace,

84− MonadFix m,

85− PostBuild t m,

86− MonadHold t m) => m ()

87−run = mdo

88−

89− reqCount <- count $ leftmost

90− [() <$ unitBtn, () <$ intBtn, () <$ sayHiClicks, () <$ dblBtn, () <$ mpGo]

91− -- Allow user to choose the url target for the request

92− -- (alternatively we could just `let url = constDyn (BasePath "/")`)

93− url <- baseUrlWidget

94− el "br" (return ())

95− dynText $ showBaseUrl <$> url

96−

97− el "br" (return ())

98−

99− -- Name the computed API client functions

100− let tweakRequest = ClientOptions $ \r -> do

101− return $ r & withCredentials .~ True

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

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

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

105−

106− c2 = client (Proxy :: Proxy ComprehensiveAPI) (Proxy :: Proxy m) (Proxy :: Proxy ()) url -- Just make sure this compiles for now

107−

108− (unitBtn, intBtn) <- elClass "div" "demo-group" $ do

109− unitBtn <- divClass "unit-button" $ button "Get unit"

110− intBtn <- divClass "int-button" $ button "Get int"

111−

112− unitResponse <- getUnit $ tag (current reqCount) unitBtn

113− intResponse :: Event t (ReqResult Int Int) <- getInt $ tag (current reqCount) intBtn

114−

115− score <- foldDyn (+) 0 (fmapMaybe reqSuccess (intResponse))

116−

117− r <- holdDyn "Waiting" $ fmap showXhrResponse $

118− leftmost [fmapMaybe response (unitResponse)

119− ,fmapMaybe response (intResponse)

120− ]

121− divClass "unit-int-response" $ el "p" $ dynText r >> el "br" (return ()) >> text "Total: " >> display score

122− return (unitBtn, intBtn)

123−

124− sayHiClicks <- elClass "div" "demo-group" $ do

125−

126− text "Name"

127− el "br" $ return ()

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

129− let checkedName = fmap (\i -> bool (QParamSome i) (QParamInvalid "Need a name") (T.null i)) inp

130− el "br" $ return ()

131−

132− text "Greetings (space-separated)"

133− el "br" $ return ()

134− greetings <- fmap (fmap T.words . value) $

135− divClass "greetings-input" $ (textInput def)

136−

137− el "br" $ return ()

138−

139− gusto <- fmap value $ divClass "gusto-input" $ checkbox False def

140−

141− el "br" $ return ()

142− sayHiClicks :: Event t () <- divClass "hi-button" $ button "Say hi"

143− let triggers = leftmost [sayHiClicks, () <$ updated inp]

144−

145− resp <- sayhi checkedName greetings gusto (tag (current reqCount) triggers)

146− divClass "greeting-response" $ dynText =<<

147− holdDyn "No hi yet" (leftmost [ fmapMaybe reqSuccess (resp)

148− , fmapMaybe reqFailure (resp)])

149− return sayHiClicks

150−

151− dblBtn <- elClass "div" "demo-group" $ do

152− text "A Double to double"

153− el "br" $ return ()

154− dblinp <- fmap value $ divClass "double-input" $ textInput def

155− (dblBtn) <- divClass "double-button" $ button "Double it"

156− dblResp <- dbl (fmap (note "read failure" . readMaybe . T.unpack) $

157− dblinp) (tag (current reqCount) dblBtn)

158− divClass "double-errors" $ dynText =<<

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

160− el "br" (return ())

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

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

163− fmapMaybe reqSuccess (dblResp))

164− return dblBtn

165−

166− mpGo <- elClass "div" "demo-group" $ do

167− text "Multi-part path"

168− b <- value <$> checkbox False def

169− mpGo <- button "Test"

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

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

172− fmapMaybe reqSuccess $

173− (multiResp))

174− return mpGo

175−

176− return ()

177−

178− el "br" $ return ()

179−

180− elClass "div" "demo-group" $ do

181− text "JSON Unicode encoding test"

182− txt <- value <$> textInput def

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

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

185− rr <- qna dQ ev

186− el "p" $

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

188−

189− divClass "demo-group" $ do

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

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

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

193− <$> fmap T.encodeUtf8 un

194− <*> fmap T.encodeUtf8 pw

195− b <- button "Get secret"

196− r <- secret (Just <$> ba) (0 <$ b)

197− res <- holdDyn Nothing (reqSuccess <$> r)

198− display res

199−

200−

201−showXhrResponse :: XhrResponse -> Text

202−showXhrResponse (XhrResponse stat stattxt rbmay rtmay respHeaders) =

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

204− ,"stattxt: " <> tShow stattxt

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

206− ,"rtext: " <> tShow rtmay

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

208−

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

210−tShow = T.pack . show

211−

212−showRB :: XhrResponseBody -> Text

213−showRB (XhrResponseBody_Default t) = tShow t

214−showRB (XhrResponseBody_Text t) = tShow t

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

216−showRB (XhrResponseBody_ArrayBuffer t) = tShow t

217−

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

219−note e = maybe (Left e) Right

exec/toSite.shdeleted−3

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

1−#!/usr/bin/env bash

2−

3−cp dist/build/example/example.jsexe/* testserver/static

include/overlapping-compat.hdeleted−8

@@ -1,8 +0,0 @@

1−#if __GLASGOW_HASKELL__ >= 710

2−#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}

3−#define OVERLAPPING_ {-# OVERLAPPING #-}

4−#else

5−{-# LANGUAGE OverlappingInstances #-}

6−#define OVERLAPPABLE_

7−#define OVERLAPPING_

8−#endif

nix/nix.confdeleted−3

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

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

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

3−trusted-users = travis

nix/reflex-platform.nixdeleted−7

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

1−let

2− rev = "1aba6f367982bd6dd78ec2fda75ab246a62d32c5" ;

3−in import (builtins.fetchTarball

4− {

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

6− sha256 = "137vg6i8yy4lp6rz4wbvvhfcc9d9qf7j1b3fnng3r7sj63k7j664" ;

7− }) {}

nix/servant-snap.nixdeleted−7

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

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−}) {}

nix/testresults.nixdeleted−17

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

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.nixdeleted−9

@@ -1,9 +0,0 @@

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.nixnew file+8

@@ -0,0 +1,8 @@

1+{}:

2+let try-reflex = import deps/try-reflex {};

3+in try-reflex.ghcjs.override {

4+ overrides = self: super: {

5+ reflex-dom-contrib = self.callPackage deps/reflex-dom-contrib {};

6+ servant = self.callPackage (try-reflex.cabal2nixResult deps/servant/servant) {};

7+ };

8+}

servant-reflex.cabal+31−55

@@ -1,70 +1,46 @@

11Name: servant-reflex

2−Version: 0.3.6

3−Synopsis: servant API generator for reflex apps

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

5−License: BSD3

6−License-file: LICENSE.md

7−Author: Greg Hale, Doug Beardsley

8−Maintainer: imalsogreg@gmail.com

2+Version: 0.1

3+Synopsis: Servant reflex API generator

4+Description: Servant reflex API generator

5+License: AllRightsReserved

6+License-file: LICENSE

7+Author: Doug Beardsley

8+Maintainer: mightybyte@gmail.com

99Stability: Experimental

1010Category: Web

1111Build-type: Simple

12−Cabal-version: >=1.10

13−

14−Flag Example

15− description: Enable example

16− default: False

12+Cabal-version: >=1.8

1713

1814library

19− exposed-modules:

15+ exposed-modules:

16+ Servant.Reflex

17+

18+ other-modules:

2019 Servant.Common.BaseUrl

2120 Servant.Common.Req

22− Servant.Reflex

23− Servant.Reflex.Multi

2421

2522 hs-source-dirs: src

2623 build-depends:

27− base >= 4.8 && < 5,

24+ base,

2825 bytestring >= 0.10 && < 0.11,

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

30− containers >= 0.5.6 && < 0.7,

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

32− exceptions >= 0.8 && < 0.11,

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

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

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

36− jsaddle >= 0.8 && < 0.10,

37− mtl >= 2.2.1 && < 2.3,

26+ containers,

27+ exceptions >= 0.8 && < 0.9,

28+ ghcjs-base,

29+ ghcjs-dom == 0.1.*,

30+ http-media >= 0.6 && < 0.7,

31+ http-types >= 0.8 && < 0.9,

32+ mtl,

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

39− reflex >= 0.5 && < 0.9,

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

41− safe >= 0.3.9 && < 0.4,

42− servant >= 0.16 && < 0.19,

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

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

45− text >= 1.2 && < 1.3,

46− transformers >= 0.4 && < 0.6

47−

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

49−

50− default-language: Haskell2010

51−

52−executable example

53− if flag(Example)

54− buildable: True

55− else

56− buildable: False

57− build-depends:

58− aeson,

5934 reflex,

60− servant-reflex,

61− base,

62− scientific,

63− servant,

6435 reflex-dom,

65− reflex-dom-core,

66− text

67− default-language: Haskell2010

68− main-is: Example.hs

69− other-modules: API

70− hs-source-dirs: exec

36+ reflex-dom-contrib,

37+ safe,

38+ servant >= 0.5 && < 0.6,

39+ string-conversions,

40+ text,

41+ transformers >= 0.4 && < 0.5

42+

43+ if impl(ghcjs)

44+ build-depends: ghcjs-base

45+

46+ ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2

shell.nixdeleted−1

@@ -1 +0,0 @@

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

shell.shnew file+3

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

1+#!/bin/sh

3+deps/try-reflex/work-on ./overrides.nix ./.

src/Servant/Common/BaseUrl.hs+47−72

@@ -1,102 +1,77 @@

1−{-# LANGUAGE ConstraintKinds #-}

2−{-# LANGUAGE CPP #-}

3−{-# LANGUAGE DeriveDataTypeable #-}

4−{-# LANGUAGE DeriveGeneric #-}

5−{-# LANGUAGE FlexibleContexts #-}

6−{-# LANGUAGE GADTs #-}

7−{-# LANGUAGE OverloadedStrings #-}

8−{-# LANGUAGE ViewPatterns #-}

9−{-# LANGUAGE RankNTypes #-}

10−{-# LANGUAGE ScopedTypeVariables #-}

1+{-# LANGUAGE DeriveDataTypeable #-}

2+{-# LANGUAGE DeriveGeneric #-}

3+{-# LANGUAGE ViewPatterns #-}

114module Servant.Common.BaseUrl (

125 -- * types

136 BaseUrl (..)

7+ , InvalidBaseUrlException

148 , Scheme (..)

159 -- * functions

16− , baseUrlWidget

10+ , parseBaseUrl

1711 , showBaseUrl

18−

19− -- * constraints

20− , SupportsServantReflex

2112) where

2213

23−import Control.Monad (join)

24−-- import Control.Monad.IO.Class (MonadIO)

25−import Control.Monad.Fix (MonadFix)

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

27−import Data.Text (Text)

28−import qualified Data.Text as T

14+import Control.Monad.Catch (Exception, MonadThrow, throwM)

15+import Data.List

16+import Data.Typeable

2917import GHC.Generics

30−import Language.Javascript.JSaddle.Monad (MonadJSM)

31−import Reflex

32−import Reflex.Dom.Core

18+import Network.URI hiding (path)

19+import Safe

3320import Text.Read

3421

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

36−type 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

40−

4122-- | URI scheme to use

4223data Scheme =

4324 Http -- ^ http://

4425 | Https -- ^ https://

45− deriving (Show, Read, Eq, Ord, Generic)

26+ deriving (Show, Eq, Ord, Generic)

4627

4728-- | Simple data type to represent the target of HTTP requests

4829-- for servant's automatically-generated clients.

49−data BaseUrl = BaseFullUrl Scheme Text Int Text

50− | BasePath Text

51− deriving (Ord, Read, Show, Generic)

52−

30+data BaseUrl = BaseUrl

31+ { baseUrlScheme :: Scheme -- ^ URI scheme to use

32+ , baseUrlHost :: String -- ^ host (eg "haskell.org")

33+ , baseUrlPort :: Int -- ^ port (eg 80)

34+ , baseUrlPath :: String -- ^ path (eg "/a/b/c")

35+ } deriving (Show, Ord, Generic)

5336

5437instance Eq BaseUrl where

55− BasePath s == BasePath s' = s == s'

56− BaseFullUrl a b c path == BaseFullUrl a' b' c' path'

38+ BaseUrl a b c path == BaseUrl a' b' c' path'

5739 = a == a' && b == b' && c == c' && s path == s path'

58− where s x = if T.isPrefixOf "/" x then T.tail x else x

59− _ == _ = False

40+ where s ('/':x) = x

41+ s x = x

6042

61−showBaseUrl :: BaseUrl -> Text

62−showBaseUrl (BasePath s) = s

63−showBaseUrl (BaseFullUrl urlscheme host port path) =

64− schemeString <> "//" <> host <> (portString </> path)

43+showBaseUrl :: BaseUrl -> String

44+showBaseUrl (BaseUrl urlscheme host port path) =

45+ schemeString ++ "//" ++ host ++ (portString </> path)

6546 where

66− a </> b = if "/" `T.isPrefixOf` b || T.null b then a <> b else a <> "/" <> b

47+ a </> b = if "/" `isPrefixOf` b || null b then a ++ b else a ++ '/':b

6748 schemeString = case urlscheme of

6849 Http -> "http:"

6950 Https -> "https:"

7051 portString = case (urlscheme, port) of

7152 (Http, 80) -> ""

7253 (Https, 443) -> ""

73− _ -> ":" <> T.pack (show port)

54+ _ -> ":" ++ show port

55+

56+data InvalidBaseUrlException = InvalidBaseUrlException String deriving (Show, Typeable)

57+instance Exception InvalidBaseUrlException

7458

75−baseUrlWidget :: forall t m .(SupportsServantReflex t m,

76− DomBuilderSpace m ~ GhcjsDomSpace,

77− MonadFix m,

78− PostBuild t m,

79− MonadHold t m,

80− DomBuilder t m)

81− => m (Dynamic t BaseUrl)

82−baseUrlWidget = elClass "div" "base-url" $ do

83− urlWidget <- dropdown (0 :: Int) (constDyn $ 0 =: "BasePath" <> 1 =: "BaseUrlFull") def

84− let bUrlWidget = ffor (value urlWidget) $ \i -> case i of

85− 0 -> pathWidget

86− 1 -> fullUrlWidget

87− _ -> error "Surprising value"

88− join <$> widgetHold pathWidget (updated bUrlWidget)

89− where pathWidget :: m (Dynamic t BaseUrl)

90− pathWidget = do

91− text "Url base path"

92− t <- inputElement def

93− return $ BasePath <$> value t

94− fullUrlWidget :: m (Dynamic t BaseUrl)

95− fullUrlWidget = do

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

97− srv <- inputElement def

98− text ":"

99− prt <- inputElement def

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

101− path <- inputElement def

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

59+parseBaseUrl :: MonadThrow m => String -> m BaseUrl

60+parseBaseUrl s = case parseURI (removeTrailingSlash s) of

61+ -- This is a rather hacky implementation and should be replaced with something

62+ -- implemented in attoparsec (which is already a dependency anyhow (via aeson)).

63+ Just (URI "http:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) path "" "") ->

64+ return (BaseUrl Http host port path)

65+ Just (URI "http:" (Just (URIAuth "" host "")) path "" "") ->

66+ return (BaseUrl Http host 80 path)

67+ Just (URI "https:" (Just (URIAuth "" host (':' : (readMaybe -> Just port)))) path "" "") ->

68+ return (BaseUrl Https host port path)

69+ Just (URI "https:" (Just (URIAuth "" host "")) path "" "") ->

70+ return (BaseUrl Https host 443 path)

71+ _ -> if "://" `isInfixOf` s

72+ then throwM (InvalidBaseUrlException $ "Invalid base URL: " ++ s)

73+ else parseBaseUrl ("http://" ++ s)

74+ where

75+ removeTrailingSlash str = case lastMay str of

76+ Just '/' -> init str

77+ _ -> str

src/Servant/Common/Req.hs+156−417

@@ -1,432 +1,171 @@

1+{-# LANGUAGE DeriveDataTypeable #-}

12{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DeriveFunctor #-}

3−{-# LANGUAGE FlexibleContexts #-}

4−{-# LANGUAGE GADTs #-}

53{-# LANGUAGE OverloadedStrings #-}

6−{-# LANGUAGE LambdaCase #-}

7−{-# LANGUAGE RankNTypes #-}

84{-# LANGUAGE ScopedTypeVariables #-}

9−{-# LANGUAGE TupleSections #-}

10−

115module Servant.Common.Req where

126

13−-------------------------------------------------------------------------------

14−import Control.Applicative (liftA2, liftA3)

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

16−import Control.Concurrent

17−import Control.Monad (join)

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

19−import Data.Bifunctor (first)

20−import qualified Data.ByteString.Builder as Builder

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

22−import Data.ByteString (ByteString)

23−import qualified Data.Map as Map

24−import Data.Maybe (catMaybes, fromMaybe)

25−import Data.Functor.Compose

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

27−import Data.Proxy (Proxy(..))

28−import Data.Text (Text)

29−import qualified Data.Text as T

30−import qualified Data.Text.Encoding as TE

31−import Data.Traversable (forM)

32−import Language.Javascript.JSaddle.Monad (JSM, MonadJSM, liftJSM)

33−import qualified Network.URI as N

34−import Reflex.Dom.Core hiding (tag)

35−import Servant.Common.BaseUrl (BaseUrl, showBaseUrl,

36− SupportsServantReflex)

37−import Servant.API.ContentTypes (MimeUnrender(..), NoContent(..))

38−import Web.HttpApiData (ToHttpApiData(..))

39−-------------------------------------------------------------------------------

40−import Servant.API.BasicAuth

41−

42−

43−------------------------------------------------------------------------------

44−-- | The result of a request event

45−data ReqResult tag a

46− = ResponseSuccess tag a XhrResponse

47− -- ^ The succesfully decoded response from a request tagged with 'tag'

48− | ResponseFailure tag Text XhrResponse

49− -- ^ The failure response, which may have failed decoding or had

50− -- a non-successful response code

51− | RequestFailure tag Text

52− -- ^ A failure to construct the request tagged with 'tag' at trigger time

53− deriving (Functor)

54−

55−data ClientOptions = ClientOptions

56− { optsRequestFixup :: forall a. Show a => XhrRequest a -> JSM (XhrRequest a)

57− -- ^ Aribtrarily modify requests just before they are sent.

58− -- Warning: This escape hatch opens the possibility for your

59− -- requests to diverge from what the server expects, when the

60− -- server is also derived from a servant API

7+#if !MIN_VERSION_base(4,8,0)

8+import Control.Applicative

9+#endif

10+import Control.Exception

11+import Control.Monad

12+import Control.Monad.Catch (MonadThrow)

13+import Control.Monad.IO.Class

14+import Control.Monad.Trans.Except

15+import Data.ByteString.Lazy hiding (pack, filter, map, null, elem)

16+import Data.String

17+import Data.String.Conversions

18+import Data.Proxy

19+import Data.Text (Text)

20+import Data.Text.Encoding

21+import Data.Typeable

22+import Network.HTTP.Media

23+import Network.HTTP.Types

24+import qualified Network.HTTP.Types.Header as HTTP

25+import Network.URI hiding (path)

26+import Servant.API.ContentTypes

27+import Servant.Common.BaseUrl

28+

29+import Web.HttpApiData

30+

31+data ServantError

32+ = FailureResponse

33+ { responseStatus :: Status

34+ , responseContentType :: MediaType

35+ , responseBody :: ByteString

6136 }

37+ | DecodeFailure

38+ { decodeError :: String

39+ , responseContentType :: MediaType

40+ , responseBody :: ByteString

41+ }

42+ | UnsupportedContentType

43+ { responseContentType :: MediaType

44+ , responseBody :: ByteString

45+ }

46+ | InvalidContentTypeHeader

47+ { responseContentTypeHeader :: ByteString

48+ , responseBody :: ByteString

49+ }

50+ | ConnectionError

51+ { connectionError :: SomeException

52+ }

53+ deriving (Show, Typeable)

6254

63−defaultClientOptions :: ClientOptions

64−defaultClientOptions = ClientOptions { optsRequestFixup = return }

65−

66−-- withCredentials :: Lens' (XhrRequest a) Bool

67−withCredentials :: (Show a, Functor f) => (Bool -> f Bool) -> XhrRequest a -> f (XhrRequest a)

68−withCredentials inj r@(XhrRequest _ _ cfg) =

69− let cfg' = (\b -> cfg { _xhrRequestConfig_withCredentials = b}) <$>

70− inj (_xhrRequestConfig_withCredentials cfg)

71− in (\c' -> r {_xhrRequest_config = c' }) <$> cfg'

72−

73−------------------------------------------------------------------------------

74−-- | Simple filter/accessor for successful responses, when you want to

75−-- ignore the error case. For example:

76−-- >> goodResponses <- fmapMaybe reqSuccess <$> clientFun triggers

77−reqSuccess :: ReqResult tag a -> Maybe a

78−reqSuccess (ResponseSuccess _ x _) = Just x

79−reqSuccess _ = Nothing

80−

81−

82−------------------------------------------------------------------------------

83−-- | Simple filter/accessor like 'reqSuccess', but keeping the request tag

84−reqSuccess' :: ReqResult tag a -> Maybe (tag,a)

85−reqSuccess' (ResponseSuccess tag x _) = Just (tag,x)

86−reqSuccess' _ = Nothing

87−

88−

89−------------------------------------------------------------------------------

90−-- | Simple filter/accessor for any failure case

91−reqFailure :: ReqResult tag a -> Maybe Text

92−reqFailure (ResponseFailure _ s _) = Just s

93−reqFailure (RequestFailure _ s) = Just s

94−reqFailure _ = Nothing

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−

103−

104−------------------------------------------------------------------------------

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

106−response :: ReqResult tag a -> Maybe XhrResponse

107−response (ResponseSuccess _ _ x) = Just x

108−response (ResponseFailure _ _ x) = Just x

109−response _ = Nothing

110−

111−------------------------------------------------------------------------------

112−-- | Retrieve response tag

113−reqTag :: ReqResult tag a -> tag

114−reqTag (ResponseSuccess tag _ _) = tag

115−reqTag (ResponseFailure tag _ _) = tag

116−reqTag (RequestFailure tag _ ) = tag

117−

118−-------------------------------------------------------------------------------

119−-- | You must wrap the parameter of a QueryParam endpoint with 'QParam' to

120−-- indicate whether the parameter is valid and present, validly absent, or

121−-- invalid

122−data QParam a = QParamSome a

123− -- ^ A valid query parameter

124− | QNone

125− -- ^ Indication that the parameter is intentionally absent (the request is valid)

126− | QParamInvalid Text

127− -- ^ Indication that your validation failed (the request isn't valid)

128−

129−

130−qParamToQueryPart :: ToHttpApiData a => QParam a -> Either Text (Maybe Text)

131−qParamToQueryPart (QParamSome a) = Right (Just $ toQueryParam a)

132−qParamToQueryPart QNone = Right Nothing

133−qParamToQueryPart (QParamInvalid e) = Left e

134−

135−

136−data QueryPart t = QueryPartParam (Dynamic t (Either Text (Maybe Text)))

137− | QueryPartParams (Dynamic t [Text])

138− | QueryPartFlag (Dynamic t Bool)

139−

55+instance Exception ServantError

14056

141−-------------------------------------------------------------------------------

142−-- The data structure used to build up request information while traversing

143−-- the shape of a servant API

144−data Req t = Req

145− { reqMethod :: Text

146− , reqPathParts :: [Dynamic t (Either Text Text)]

147− , qParams :: [(Text, QueryPart t)]

148− , reqBody :: Maybe (Dynamic t (Either Text (BL.ByteString, Text)))

149− , headers :: [(Text, Dynamic t (Either Text Text))]

150− , respHeaders :: XhrResponseHeaders

151− , authData :: Maybe (Dynamic t (Maybe BasicAuthData))

57+data Req = Req

58+ { reqPath :: String

59+ , qs :: QueryText

60+ , reqBody :: Maybe (ByteString, MediaType)

61+ , reqAccept :: [MediaType]

62+ , headers :: [(String, Text)]

15263 }

15364

154−defReq :: Req t

155−defReq = Req "GET" [] [] Nothing [] def Nothing

156−

157−prependToPathParts :: Dynamic t (Either Text Text) -> Req t -> Req t

158−prependToPathParts p req =

159− req { reqPathParts = p : reqPathParts req }

160−

161−addHeader :: (ToHttpApiData a, Reflex t) => Text -> Dynamic t (Either Text a) -> Req t -> Req t

162−addHeader name val req = req { headers = (name, (fmap . fmap) (TE.decodeUtf8 . toHeader) val) : headers req }

163−

164−

165−reqToReflexRequest

166− :: forall t. Reflex t

167− => Text

168− -> Dynamic t BaseUrl

169− -> Req t

170− -> Dynamic t (Either Text (XhrRequest XhrPayload))

171−reqToReflexRequest reqMeth reqHost req =

172− let t :: Dynamic t [Either Text Text]

173− t = sequence $ reverse $ reqPathParts req

174−

175− baseUrl :: Dynamic t (Either Text Text)

176− baseUrl = Right . showBaseUrl <$> reqHost

177−

178− urlParts :: Dynamic t (Either Text [Text])

179− urlParts = fmap sequence t

180−

181− urlPath :: Dynamic t (Either Text Text)

182− urlPath = (fmap.fmap)

183− (T.intercalate "/" . fmap escape)

184− urlParts

65+defReq :: Req

66+defReq = Req "" [] Nothing [] []

67+

68+appendToPath :: String -> Req -> Req

69+appendToPath p req =

70+ req { reqPath = reqPath req ++ "/" ++ p }

71+

72+appendToQueryString :: Text -- ^ param name

73+ -> Maybe Text -- ^ param value

74+ -> Req

75+ -> Req

76+appendToQueryString pname pvalue req =

77+ req { qs = qs req ++ [(pname, pvalue)]

78+ }

79+

80+addHeader :: ToHttpApiData a => String -> a -> Req -> Req

81+addHeader name val req = req { headers = headers req

82+ ++ [(name, decodeUtf8 (toHeader val))]

83+ }

84+

85+setRQBody :: ByteString -> MediaType -> Req -> Req

86+setRQBody b t req = req { reqBody = Just (b, t) }

87+

88+reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request

89+reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =

90+ setheaders . setAccept . setrqb . setQS <$> parseUrl url

91+

92+ where url = show $ nullURI { uriScheme = case reqScheme of

93+ Http -> "http:"

94+ Https -> "https:"

95+ , uriAuthority = Just $

96+ URIAuth { uriUserInfo = ""

97+ , uriRegName = reqHost

98+ , uriPort = ":" ++ show reqPort

99+ }

100+ , uriPath = path ++ reqPath req

101+ }

102+

103+ setrqb r = case reqBody req of

104+ Nothing -> r

105+ Just (b,t) -> r { requestBody = RequestBodyLBS b

106+ , requestHeaders = requestHeaders r

107+ ++ [(hContentType, cs . show $ t)] }

108+ setQS = setQueryString $ queryTextToQuery (qs req)

109+ setheaders r = r { requestHeaders = requestHeaders r

110+ <> fmap toProperHeader (headers req) }

111+ setAccept r = r { requestHeaders = filter ((/= "Accept") . fst) (requestHeaders r)

112+ <> [("Accept", renderHeader $ reqAccept req)

113+ | not . null . reqAccept $ req] }

114+ toProperHeader (name, val) =

115+ (fromString name, encodeUtf8 val)

185116

186− queryPartString :: (Text, QueryPart t) -> Dynamic t (Maybe (Either Text Text))

187− queryPartString (pName, qp) = case qp of

188− QueryPartParam p -> ffor p $ \case

189− Left e -> Just (Left e)

190− Right (Just a) -> Just (Right $ pName <> "=" <> escape a)

191− Right Nothing -> Nothing

192− QueryPartParams ps -> ffor ps $ \pStrings ->

193− if null pStrings

194− then Nothing

195− else Just . Right

196− . T.intercalate "&"

197− $ fmap (\p -> pName <> "=" <> escape p) pStrings

198− QueryPartFlag fl -> ffor fl $ \case

199− True -> Just $ Right pName

200− False -> Nothing

201−

202−

203− queryPartStrings :: [Dynamic t (Maybe (Either Text Text))]

204− queryPartStrings = map queryPartString (qParams req)

205− queryPartStrings' = fmap (sequence . catMaybes) $ sequence queryPartStrings :: Dynamic t (Either Text [Text])

206− queryString :: Dynamic t (Either Text Text) =

207− ffor queryPartStrings' $ \qs -> fmap (T.intercalate "&") qs

208− xhrUrl = (liftA3 . liftA3) (\a p q -> a </> if T.null q then p else p <> "?" <> q)

209− baseUrl urlPath queryString

210− where

211− (</>) :: Text -> Text -> Text

212− x </> y | ("/" `T.isSuffixOf` x) || ("/" `T.isPrefixOf` y) = x <> y

213− | otherwise = x <> "/" <> y

214−

215−

216− xhrHeaders :: Dynamic t (Either Text [(Text, Text)])

217− xhrHeaders = (fmap sequence . sequence . fmap f . headers) req

218− where

219− f = \(headerName, dynam) ->

220− fmap (fmap (\rightVal -> (headerName, rightVal))) dynam

221−

222− mkConfigBody :: Either Text [(Text,Text)]

223− -> (Either Text (BL.ByteString, Text))

224− -> Either Text (XhrRequestConfig XhrPayload)

225− mkConfigBody ehs rb = case (ehs, rb) of

226− (_, Left e) -> Left e

227− (Left e, _) -> Left e

228− (Right hs, Right (bBytes, bCT)) ->

229− Right $ XhrRequestConfig

230− { _xhrRequestConfig_sendData = bytesToPayload bBytes

231− , _xhrRequestConfig_headers =

232− Map.insert "Content-Type" bCT (Map.fromList hs)

233− , _xhrRequestConfig_user = Nothing

234− , _xhrRequestConfig_password = Nothing

235− , _xhrRequestConfig_responseType = Just XhrResponseType_ArrayBuffer

236− , _xhrRequestConfig_withCredentials = False

237− , _xhrRequestConfig_responseHeaders = def

238− }

239−

240− xhrOpts :: Dynamic t (Either Text (XhrRequestConfig XhrPayload))

241− xhrOpts = case reqBody req of

242− Nothing -> ffor xhrHeaders $ \case

243− Left e -> Left e

244− Right hs -> Right $ def { _xhrRequestConfig_headers = Map.fromList hs

245− , _xhrRequestConfig_user = Nothing

246− , _xhrRequestConfig_password = Nothing

247− , _xhrRequestConfig_responseType = Just XhrResponseType_ArrayBuffer

248− , _xhrRequestConfig_sendData = mempty

249− , _xhrRequestConfig_withCredentials = False

250− }

251− Just rBody -> liftA2 mkConfigBody xhrHeaders rBody

252−

253− mkAuth :: Maybe BasicAuthData -> Either Text (XhrRequestConfig x) -> Either Text (XhrRequestConfig x)

254− mkAuth _ (Left e) = Left e

255− mkAuth Nothing r = r

256− mkAuth (Just (BasicAuthData u p)) (Right config) = Right $ config

257− { _xhrRequestConfig_user = Just $ TE.decodeUtf8 u

258− , _xhrRequestConfig_password = Just $ TE.decodeUtf8 p}

259−

260− addAuth :: Dynamic t (Either Text (XhrRequestConfig x))

261− -> Dynamic t (Either Text (XhrRequestConfig x))

262− addAuth xhr = case authData req of

263− Nothing -> xhr

264− Just auth -> liftA2 mkAuth auth xhr

265−

266− xhrReq = (liftA2 . liftA2) (\p opt -> XhrRequest reqMeth p opt) xhrUrl (addAuth xhrOpts)

267−

268− in xhrReq

269117

270118-- * performing requests

271119

272−displayHttpRequest :: Text -> Text

273−displayHttpRequest httpmethod = "HTTP " <> httpmethod <> " request"

274−

275−-- | This function performs the request

276−performRequests :: forall t m f tag.(SupportsServantReflex t m, Traversable f)

277− => Text

278− -> Dynamic t (f (Req t))

279− -> Dynamic t BaseUrl

280− -> ClientOptions

281− -> Event t tag

282− -> m (Event t (tag, f (Either Text XhrResponse)))

283−performRequests reqMeth rs reqHost opts trigger = do

284− let xhrReqs =

285− join $ (\(fxhr :: f (Req t)) -> sequence $

286− reqToReflexRequest reqMeth reqHost <$> fxhr) <$> rs

287−

288− -- xhrReqs = fmap snd <$> xhrReqsAndDebugs

289− reqs = attachPromptlyDynWith

290− (\fxhr t -> Compose (t, fxhr)) xhrReqs trigger

291−

292− resps <- performSomeRequestsAsync opts reqs

293− return $ getCompose <$> resps

294−

295−-- | Issues a collection of requests when the supplied Event fires.

296−-- When ALL requests from a given firing complete, the results are

297−-- collected and returned via the return Event.

298−performSomeRequestsAsync

299− :: (MonadIO (Performable m),

300− MonadJSM (Performable m),

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

302− HasWebView (Performable m),

303−#endif

304− PerformEvent t m,

305− TriggerEvent t m,

306− Traversable f,

307− IsXhrPayload a,

308− Show a

309− )

310− => ClientOptions

311− -> Event t (f (Either Text (XhrRequest a)))

312− -> m (Event t (f (Either Text XhrResponse)))

313−performSomeRequestsAsync opts =

314− performSomeRequestsAsync' opts newXMLHttpRequest . fmap return

315−

316−

317−------------------------------------------------------------------------------

318−-- | A modified version or Reflex.Dom.Xhr.performRequestsAsync

319−-- that accepts 'f (Either e (XhrRequestb))' events

320−performSomeRequestsAsync'

321− :: (MonadJSM (Performable m), PerformEvent t m, TriggerEvent t m, Traversable f, Show b)

322− => ClientOptions

323− -> (XhrRequest b -> (a -> JSM ()) -> Performable m XMLHttpRequest)

324− -> Event t (Performable m (f (Either Text (XhrRequest b)))) -> m (Event t (f (Either Text a)))

325−performSomeRequestsAsync' opts newXhr req = performEventAsync $ ffor req $ \hrs cb -> do

326− rs <- hrs

327− resps <- forM rs $ \r -> case r of

328− Left e -> do

329− resp <- liftIO $ newMVar (Left e)

330− return resp

331− Right r' -> do

332− resp <- liftIO newEmptyMVar

333− r'' <- liftJSM $ (optsRequestFixup opts) r'

334− _ <- newXhr r'' $ liftIO . putMVar resp . Right

335− return resp

336− _ <- liftIO $ forkIO $ cb =<< forM resps takeMVar

337− return ()

338−

339−

340−

341−type XhrPayload = ByteString

342−bytesToPayload :: BL.ByteString -> XhrPayload

343−bytesToPayload = BL.toStrict

344−

345−

346−performRequestsCT

347− :: (SupportsServantReflex t m,

348− MimeUnrender ct a, Traversable f)

349− => Proxy ct

350− -> Text

351− -> Dynamic t (f (Req t))

352− -> Dynamic t BaseUrl

353− -> ClientOptions

354− -> Event t tag

355− -> m (Event t (f (ReqResult tag a)))

356−performRequestsCT ct reqMeth reqs reqHost opts trigger = do

357− resps <- performRequests reqMeth reqs reqHost opts trigger

358− let decodeResp (Just (XhrResponseBody_ArrayBuffer x)) =

359− first T.pack .

360− mimeUnrender ct $

361− BL.fromStrict x

362− decodeResp _ = Left "No body"

363− return $ fmap

364− (\(t,rs) -> ffor rs $ \r -> case r of

365− Left e -> RequestFailure t e

366− Right g -> evalResponse (decodeResp . _xhrResponse_response) (t,g)

367− )

368− resps

369−

370−

371−performRequestsNoBody

372− :: (SupportsServantReflex t m,

373− Traversable f)

374− => Text

375− -> Dynamic t (f (Req t))

376− -> Dynamic t BaseUrl

377− -> ClientOptions

378− -> Event t tag

379− -> m (Event t (f (ReqResult tag NoContent)))

380−performRequestsNoBody reqMeth reqs reqHost opts trigger = do

381− resps <- performRequests reqMeth reqs reqHost opts trigger

382− let decodeResp = const $ Right NoContent

383− return $ ffor resps $ \(tag,rs) -> ffor rs $ \r -> case r of

384− Left e -> RequestFailure tag e

385− Right g -> evalResponse decodeResp (tag,g)

386−

387−

388−------------------------------------------------------------------------------

389−evalResponse

390− :: (XhrResponse -> Either Text a)

391− -> (tag, XhrResponse)

392− -> ReqResult tag a

393−evalResponse decode (tag, xhr) =

394− let status = _xhrResponse_status xhr

395− okStatus = status >= 200 && status < 400

396− errMsg = fromMaybe

397− ("Empty response with error code " <>

398− T.pack (show $ _xhrResponse_status xhr))

399− (_xhrResponse_responseText xhr)

400− respPayld = if okStatus

401− then either

402− (\e -> ResponseFailure tag e xhr)

403− (\v -> ResponseSuccess tag v xhr)

404− (decode xhr)

405− else ResponseFailure tag errMsg xhr

406− in respPayld

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−

420−

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

422−note e = maybe (Left e) Right

423−

424−fmapL :: (e -> e') -> Either e a -> Either e' a

425−fmapL _ (Right a) = Right a

426−fmapL f (Left e) = Left (f e)

427−

428−builderToText :: Builder.Builder -> T.Text

429−builderToText = TE.decodeUtf8 . BL.toStrict . Builder.toLazyByteString

120+displayHttpRequest :: Method -> String

121+displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"

122+

123+performRequest = undefined

124+performRequestCT = undefined

125+performRequestNoBody = undefined

126+

127+-- performRequest :: Method -> Req -> BaseUrl -> Manager

128+-- -> ExceptT ServantError IO ( Int, ByteString, MediaType

129+-- , [HTTP.Header], Response ByteString)

130+-- performRequest reqMethod req reqHost manager = do

131+-- partialRequest <- liftIO $ reqToRequest req reqHost

132+--

133+-- let request = partialRequest { Client.method = reqMethod

134+-- , checkStatus = \ _status _headers _cookies -> Nothing

135+-- }

136+--

137+-- eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager

138+-- case eResponse of

139+-- Left err ->

140+-- throwE . ConnectionError $ SomeException err

141+--

142+-- Right response -> do

143+-- let status = Client.responseStatus response

144+-- body = Client.responseBody response

145+-- hrds = Client.responseHeaders response

146+-- status_code = statusCode status

147+-- ct <- case lookup "Content-Type" $ Client.responseHeaders response of

148+-- Nothing -> pure $ "application"//"octet-stream"

149+-- Just t -> case parseAccept t of

150+-- Nothing -> throwE $ InvalidContentTypeHeader (cs t) body

151+-- Just t' -> pure t'

152+-- unless (status_code >= 200 && status_code < 300) $

153+-- throwE $ FailureResponse status ct body

154+-- return (status_code, body, ct, hrds, response)

155+--

156+--

157+-- performRequestCT :: MimeUnrender ct result =>

158+-- Proxy ct -> Method -> Req -> BaseUrl -> Manager -> ExceptT ServantError IO ([HTTP.Header], result)

159+-- performRequestCT ct reqMethod req reqHost manager = do

160+-- let acceptCT = contentType ct

161+-- (_status, respBody, respCT, hrds, _response) <-

162+-- performRequest reqMethod (req { reqAccept = [acceptCT] }) reqHost manager

163+-- unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody

164+-- case mimeUnrender ct respBody of

165+-- Left err -> throwE $ DecodeFailure err respCT respBody

166+-- Right val -> return (hrds, val)

167+--

168+-- performRequestNoBody :: Method -> Req -> BaseUrl -> Manager -> ExceptT ServantError IO ()

169+-- performRequestNoBody reqMethod req reqHost manager =

170+-- void $ performRequest reqMethod req reqHost manager

430171

431−escape :: T.Text -> T.Text

432−escape = T.pack . N.escapeURIString (not . N.isReserved) . T.unpack . TE.decodeUtf8 . BL.toStrict . Builder.toLazyByteString . toEncodedUrlPiece

src/Servant/Reflex.hs+531−579

@@ -1,624 +1,576 @@

1−{-# LANGUAGE AllowAmbiguousTypes #-}

2−{-# LANGUAGE CPP #-}

3−{-# LANGUAGE DataKinds #-}

4−{-# LANGUAGE FlexibleContexts #-}

5−{-# LANGUAGE FlexibleInstances #-}

6−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

7−{-# LANGUAGE InstanceSigs #-}

8−{-# LANGUAGE MultiParamTypeClasses #-}

9−{-# LANGUAGE OverloadedStrings #-}

10−{-# LANGUAGE PolyKinds #-}

11−{-# LANGUAGE Rank2Types #-}

12−{-# LANGUAGE ScopedTypeVariables #-}

13−{-# LANGUAGE TupleSections #-}

14−{-# LANGUAGE TypeFamilies #-}

15−{-# LANGUAGE TypeOperators #-}

16−{-# LANGUAGE UndecidableInstances #-}

17−

18−#if MIN_VERSION_base(4,9,0)

19−{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE DataKinds #-}

3+{-# LANGUAGE FlexibleContexts #-}

4+{-# LANGUAGE FlexibleInstances #-}

5+{-# LANGUAGE InstanceSigs #-}

6+{-# LANGUAGE OverloadedStrings #-}

7+{-# LANGUAGE ScopedTypeVariables #-}

8+{-# LANGUAGE TypeFamilies #-}

9+{-# LANGUAGE TypeOperators #-}

10+{-# LANGUAGE UndecidableInstances #-}

11+#if !MIN_VERSION_base(4,8,0)

12+{-# LANGUAGE OverlappingInstances #-}

2013#endif

21−

22−-- #include "overlapping-compat.h"

2314-- | This module provides 'client' which can automatically generate

2415-- querying functions for each endpoint just from the type representing your

2516-- API.

2617module Servant.Reflex

2718 ( client

28− , clientWithOpts

29− , clientWithOptsAndResultHandler

30− , clientWithRoute

31− , clientWithRouteAndResultHandler

32− , BuildHeaderKeysTo(..)

33− , toHeaders

34− , HasClient

35− , Client

36− , module Servant.Common.Req

19+ , HasReflexClient(..)

20+ , ServantError(..)

3721 , module Servant.Common.BaseUrl

3822 ) where

3923

40−------------------------------------------------------------------------------

41−import Control.Applicative

42−import qualified Data.CaseInsensitive as CI

43−import Data.Functor.Identity

44−import qualified Data.Map as Map

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

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

47−import qualified Data.Set as Set

48−import Data.Text (Text)

49−import qualified Data.Text as T

50−import qualified Data.Text.Encoding as E

51−import GHC.Exts (Constraint)

52−import GHC.TypeLits (KnownSymbol, symbolVal)

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

54− BasicAuthData, BuildHeadersTo (..),

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

56− HttpVersion, IsSecure,

57− MimeRender (..), MimeUnrender,

58− NoContent, QueryFlag, QueryParam',

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

60− RemoteHost, ReqBody,

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

62− contentType)

63−import Servant.API.Description (Summary)

64−import qualified Servant.Auth as Auth

65−

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

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

68− XhrResponseHeaders (..),

69− attachPromptlyDynWith, constDyn, ffor,

70− fmapMaybe, leftmost,

71− performRequestsAsync)

72−------------------------------------------------------------------------------

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

74− showBaseUrl,

75− SupportsServantReflex)

76−import Servant.Common.Req (ClientOptions(..),

77− defaultClientOptions,

78− Req, ReqResult(..), QParam(..),

79− QueryPart(..), addHeader, authData,

80− defReq, evalResponse, prependToPathParts,

81− -- performRequestCT,

82− performRequestsCT,

83− -- performRequestNoBody,

84− performRequestsNoBody,

85− performSomeRequestsAsync,

86− qParamToQueryPart, reqBody,

87− reqSuccess, reqFailure,

88− reqMethod, respHeaders,

89− response,

90− reqTag,

91− qParams, withCredentials)

92−

24+#if !MIN_VERSION_base(4,8,0)

25+import Control.Applicative ((<$>))

26+#endif

27+import Control.Monad

28+import Control.Monad.Trans.Except

29+import Data.ByteString.Lazy (ByteString)

30+import Data.List

31+import Data.Proxy

32+import Data.String.Conversions

33+import Data.Text (unpack)

34+import GHC.TypeLits

35+import Network.HTTP.Media

36+import qualified Network.HTTP.Types as H

37+import qualified Network.HTTP.Types.Header as HTTP

38+import Servant.API

39+import Servant.Common.BaseUrl

40+import Servant.Common.Req

41+import Web.HttpApiData

9342

9443-- * Accessing APIs as a Client

9544

9645-- | 'client' allows you to produce operations to query an API from a client.

9746--

9847-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books

99−-- > :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- POST /books

48+-- > :<|> "books" :> ReqBody '[JSON] Book :> Post Book -- POST /books

10049-- >

10150-- > myApi :: Proxy MyApi

10251-- > myApi = Proxy

10352-- >

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

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

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

53+-- > getAllBooks :: ExceptT String IO [Book]

54+-- > postNewBook :: Book -> ExceptT String IO Book

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

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

109−client

110− :: (HasClient t m layout tag)

111− => Proxy layout

112− -> Proxy m

113− -> Proxy tag

114− -> Dynamic t BaseUrl

115− -> Client t m layout tag

116−client p q t baseurl = clientWithRoute p q t defReq baseurl defaultClientOptions

56+-- > where host = BaseUrl Http "localhost" 8080

57+client :: HasReflexClient layout => Proxy layout -> BaseUrl -> Input layout -> Client layout

58+client p baseurl = clientWithRoute p defReq baseurl

11759

118−clientWithOpts

119− :: (HasClient t m layout tag)

120− => Proxy layout

121− -> Proxy m

122− -> Proxy tag

123− -> Dynamic t BaseUrl

124− -> ClientOptions

125− -> Client t m layout tag

126−clientWithOpts p q t baseurl = clientWithRoute p q t defReq baseurl

60+type Final a = forall m. m a

12761

128−-- | Like 'clientWithOpts' but allows passing a function which will process the

129−-- result event in some way. This can be used to handle errors in a uniform way

130−-- across call sites.

131−clientWithOptsAndResultHandler

132− :: (HasClient t m layout tag)

133− => Proxy layout

134− -> Proxy m

135− -> Proxy tag

136− -> Dynamic t BaseUrl

137− -> ClientOptions

138− -> (forall a. Event t (ReqResult tag a) -> m (Event t (ReqResult tag a)))

139− -> Client t m layout tag

140−clientWithOptsAndResultHandler p q t = clientWithRouteAndResultHandler p q t defReq

62+data a ::> b = a ::> b deriving (Eq,Ord,Show,Read)

14163

64+infixr 3 ::>

14265

14366-- | This class lets us define how each API combinator

14467-- influences the creation of an HTTP request. It's mostly

14568-- an internal class, you can just use 'client'.

146−class Monad m => HasClient t m layout (tag :: *) where

147− type Client t m layout tag :: *

148− clientWithRoute

149− :: Proxy layout

150− -> Proxy m

151− -> Proxy tag

152− -> Req t

153− -> Dynamic t BaseUrl

154− -> ClientOptions

155− -> Client t m layout tag

156− clientWithRoute l m t r b o = clientWithRouteAndResultHandler l m t r b o return

157−

158− clientWithRouteAndResultHandler

159− :: Proxy layout

160− -> Proxy m

161− -> Proxy tag

162− -> Req t

163− -> Dynamic t BaseUrl

164− -> ClientOptions

165− -> (forall a. Event t (ReqResult tag a) -> m (Event t (ReqResult tag a)))

166− -> Client t m layout tag

167−

168−

169−instance (HasClient t m a tag, HasClient t m b tag) => HasClient t m (a :<|> b) tag where

170− type Client t m (a :<|> b) tag = Client t m a tag :<|> Client t m b tag

171−

172− clientWithRouteAndResultHandler Proxy q pTag req baseurl opts wrap =

173− clientWithRouteAndResultHandler (Proxy :: Proxy a) q pTag req baseurl opts wrap :<|>

174− clientWithRouteAndResultHandler (Proxy :: Proxy b) q pTag req baseurl opts wrap

175−

176−

177−-- Capture. Example:

178−-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book

179−-- >

180−-- > myApi :: Proxy MyApi = Proxy

181−-- >

182−-- > getBook :: SupportsServantReflex t m

183−-- => Dynamic t BaseUrl

184−-- -> Dynamic t (Maybe Text)

185−-- -> Event t l

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

187−-- > getBook = client myApi (constDyn host)

188−

189−instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout tag)

190− => HasClient t m (Capture capture a :> sublayout) tag where

191−

192− type Client t m (Capture capture a :> sublayout) tag =

193− Dynamic t (Either Text a) -> Client t m sublayout tag

194−

195− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap val =

196− clientWithRouteAndResultHandler

197− (Proxy :: Proxy sublayout) q t (prependToPathParts p req) baseurl opts wrap

198− where p = (fmap . fmap) (toUrlPiece) val

199−

200−

201−-- VERB (Returning content) --

202−instance {-# OVERLAPPABLE #-}

203− -- Note [Non-Empty Content Types]

204− (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts), SupportsServantReflex t m

205− ) => HasClient t m (Verb method status cts' a) tag where

206− type Client t m (Verb method status cts' a) tag =

207− Event t tag -> m (Event t (ReqResult tag a))

208− -- TODO how to access input types here?

209− -- ExceptT ServantError IO a

210− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs =

211− wrap =<< fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity $ req') baseurl opts trigs

212− where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

213− req' = req { reqMethod = method }

214−

215−

216−-- -- VERB (No content) --

217−instance {-# OVERLAPPING #-}

218− (ReflectMethod method, SupportsServantReflex t m) =>

219− HasClient t m (Verb method status cts NoContent) tag where

220− type Client t m (Verb method status cts NoContent) tag =

221− Event t tag -> m (Event t (ReqResult tag NoContent))

222− -- TODO: how to access input types here?

223− -- ExceptT ServantError IO NoContent

224− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs =

225− wrap =<< fmap runIdentity <$> performRequestsNoBody method (constDyn $ Identity req) baseurl opts trigs

226− where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

227−

228−

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

230−toHeaders r =

231− let hdrs = maybe []

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

233− (Map.toList $ _xhrResponse_headers xhr))

234− (response r)

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

236−

237−

238−class BuildHeaderKeysTo hs where

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

240−

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

242− where buildHeaderKeysTo _ = []

243−

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

245− => 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)

250−

251−

252−-- HEADERS Verb (Content) --

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

254−-- in order to deny instances for (Headers ls (Capture "id" Int)),

255−-- a combinator that wouldn't make sense

256−-- TODO Overlapping??

257−instance {-# OVERLAPPABLE #-}

258− -- Note [Non-Empty Content Types]

259− ( MimeUnrender ct a, BuildHeadersTo ls, BuildHeaderKeysTo ls,

260− ReflectMethod method, cts' ~ (ct ': cts),

261− SupportsServantReflex t m

262− ) => HasClient t m (Verb method status cts' (Headers ls a)) tag where

263− type Client t m (Verb method status cts' (Headers ls a)) tag =

264− Event t tag -> m (Event t (ReqResult tag (Headers ls a)))

265− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs = do

266− let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

267− resp <- fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity req') baseurl opts trigs

268− wrap $ toHeaders <$> resp

269− where req' = req { respHeaders =

270− OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))

271− }

272−

273−

274−-- HEADERS Verb (No content) --

275−instance {-# OVERLAPPABLE #-}

276− ( BuildHeadersTo ls, BuildHeaderKeysTo ls, ReflectMethod method,

277− SupportsServantReflex t m

278− ) => HasClient t m (Verb method status cts (Headers ls NoContent)) tag where

279− type Client t m (Verb method status cts (Headers ls NoContent)) tag

280− = Event t tag -> m (Event t (ReqResult tag (Headers ls NoContent)))

281− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs = do

282− let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

283− resp <- fmap runIdentity <$> performRequestsNoBody method (constDyn $ Identity req') baseurl opts trigs

284− wrap $ toHeaders <$> resp

285− where req' = req {respHeaders =

286− OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))

287− }

288−

289−

290−

291−-- HEADER

292−-- > newtype Referer = Referer { referrer :: Text }

293−-- > deriving (Eq, Show, Generic, FromText, ToHttpApiData)

294−-- >

295−-- > -- GET /view-my-referer

296−-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer

297−-- >

298−-- >

299−-- > viewReferer :: Maybe Referer -> ExceptT String IO Book

300−-- > viewReferer = client myApi host

301−-- > where host = BaseUrl Http "localhost" 8080

302−-- > -- then you can just use "viewRefer" to query that endpoint

303−-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments

304−instance (KnownSymbol sym, ToHttpApiData a,

305− HasClient t m sublayout tag, SupportsServantReflex t m)

306− => HasClient t m (Header sym a :> sublayout) tag where

307−

308− type Client t m (Header sym a :> sublayout) tag =

309− Dynamic t (Either Text a) -> Client t m sublayout tag

310−

311− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap eVal =

312− clientWithRouteAndResultHandler

313− (Proxy :: Proxy sublayout) q t

314− (Servant.Common.Req.addHeader hname eVal req)

315− baseurl opts wrap

316− where hname = T.pack $ symbolVal (Proxy :: Proxy sym)

317−

318−

319−

320−

321−-- | Using a 'HttpVersion' combinator in your API doesn't affect the client

322−-- functions.

323−instance HasClient t m sublayout tag

324− => HasClient t m (HttpVersion :> sublayout) tag where

325−

326− type Client t m (HttpVersion :> sublayout) tag =

327− Client t m sublayout tag

328−

329− clientWithRouteAndResultHandler Proxy =

330− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)

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−

345−

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

347−-- the corresponding querying function will automatically take

348−-- an additional argument of the type specified by your 'QueryParam',

349−-- enclosed in Maybe.

69+class HasReflexClient layout where

70+ type Input layout :: *

71+ type Client layout :: *

72+ clientWithRoute :: Proxy layout -> Req -> BaseUrl -> Input layout -> Client layout

73+

74+

75+-- | If you have a 'Get' endpoint in your API, the client

76+-- side querying function that is created when calling 'client'

77+-- will just require an argument that specifies the scheme, host

78+-- and port to send the request to.

79+instance

80+#if MIN_VERSION_base(4,8,0)

81+ {-# OVERLAPPABLE #-}

82+#endif

83+ (MimeUnrender ct result) => HasReflexClient (Get (ct ': cts) result) where

84+ type Input (Get (ct ': cts) result) = ()

85+ type Client (Get (ct ': cts) result) = Final result

86+ clientWithRoute Proxy req baseurl _ =

87+ snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req baseurl

88+

89+instance

90+#if MIN_VERSION_base(4,8,0)

91+ {-# OVERLAPPING #-}

92+#endif

93+ HasReflexClient (Get (ct ': cts) ()) where

94+ type Input (Get (ct ': cts) ()) = ()

95+ type Client (Get (ct ': cts) ()) = Final ()

96+ clientWithRoute Proxy req baseurl _ =

97+ performRequestNoBody H.methodGet req baseurl

98+

99+-- | Pick a 'Method' and specify where the server you want to query is. You get

100+-- back the full `Response`.

101+instance HasReflexClient Raw where

102+ type Input Raw = H.Method ::> ()

103+ type Client Raw = Final (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)

104+

105+ clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Input Raw -> Client Raw

106+ clientWithRoute Proxy req baseurl (httpMethod ::> ()) = do

107+ performRequest httpMethod req baseurl

108+

109+-- -- | If you have a 'Get xs (Headers ls x)' endpoint, the client expects the

110+-- -- corresponding headers.

111+-- instance

112+-- #if MIN_VERSION_base(4,8,0)

113+-- {-# OVERLAPPING #-}

114+-- #endif

115+-- ( MimeUnrender ct a, BuildHeadersTo ls

116+-- ) => HasReflexClient (Get (ct ': cts) (Headers ls a)) where

117+-- type Input (Get (ct ': cts) (Headers ls a)) = ()

118+-- type Client (Get (ct ': cts) (Headers ls a)) = Final (Headers ls a)

119+-- clientWithRoute Proxy req baseurl _ = do

120+-- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodGet req baseurl

121+-- return $ Headers { getResponse = resp

122+-- , getHeadersHList = buildHeadersTo hdrs

123+-- }

350124--

351−-- If you give Nothing, nothing will be added to the query string.

125+-- -- | A client querying function for @a ':<|>' b@ will actually hand you

126+-- -- one function for querying @a@ and another one for querying @b@,

127+-- -- stitching them together with ':<|>', which really is just like a pair.

128+-- --

129+-- -- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books

130+-- -- > :<|> "books" :> ReqBody '[JSON] Book :> Post Book -- POST /books

131+-- -- >

132+-- -- > myApi :: Proxy MyApi

133+-- -- > myApi = Proxy

134+-- -- >

135+-- -- > getAllBooks :: ExceptT String IO [Book]

136+-- -- > postNewBook :: Book -> ExceptT String IO Book

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

138+-- -- > where host = BaseUrl Http "localhost" 8080

139+-- instance (HasReflexClient a, HasReflexClient b) => HasReflexClient (a :<|> b) where

140+-- type Input (a :<|> b) = Input a :<|> Input b

141+-- type Client (a :<|> b) = Client a :<|> Client b

142+-- clientWithRoute Proxy req baseurl (a :<|> b) =

143+-- clientWithRoute (Proxy :: Proxy a) req baseurl a :<|>

144+-- clientWithRoute (Proxy :: Proxy b) req baseurl b

352145--

353−-- If you give a non-'Nothing' value, this function will take care

354−-- of inserting a textual representation of this value in the query string.

146+-- ------------------------------------------------------------------------------

147+-- -- | If you use a 'Capture' in one of your endpoints in your API,

148+-- -- the corresponding querying function will automatically take

149+-- -- an additional argument of the type specified by your 'Capture'.

150+-- -- That function will take care of inserting a textual representation

151+-- -- of this value at the right place in the request path.

152+-- --

153+-- -- You can control how values for this type are turned into

154+-- -- text by specifying a 'ToHttpApiData' instance for your type.

155+-- --

156+-- -- Example:

157+-- --

158+-- -- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book

159+-- -- >

160+-- -- > myApi :: Proxy MyApi

161+-- -- > myApi = Proxy

162+-- -- >

163+-- -- > getBook :: Text -> ExceptT String IO Book

164+-- -- > getBook = client myApi host

165+-- -- > where host = BaseUrl Http "localhost" 8080

166+-- -- > -- then you can just use "getBook" to query that endpoint

167+-- instance (KnownSymbol capture, ToHttpApiData a, HasReflexClient sublayout)

168+-- => HasReflexClient (Capture capture a :> sublayout) where

355169--

356−-- You can control how values for your type are turned into

357−-- text by specifying a 'ToHttpApiData' instance for your type.

170+-- type Input (Capture cap a :> sublayout) = a ::> Input sublayout

171+-- type Client (Capture capture a :> sublayout) = Client sublayout

358172--

359−-- Example:

173+-- clientWithRoute Proxy req baseurl (val ::> rest) =

174+-- clientWithRoute (Proxy :: Proxy sublayout)

175+-- (appendToPath p req) baseurl rest

360176--

361−-- > type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]

362−-- >

363−-- > myApi :: Proxy MyApi

364−-- > myApi = Proxy

365−-- >

366−-- > getBooksBy :: Maybe Text -> ExceptT String IO [Book]

367−-- > getBooksBy = client myApi host

368−-- > where host = BaseUrl Http "localhost" 8080

369−-- > -- then you can just use "getBooksBy" to query that endpoint.

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

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

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

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

374−

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

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

377−

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

379− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap mparam =

380− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t

381− (req {qParams = paramPair : qParams req}) baseurl opts wrap

382−

383− where pname = symbolVal (Proxy :: Proxy sym)

384− --p prm = QueryPartParam $ (fmap . fmap) (toQueryParam) prm

385− --paramPair = (T.pack pname, p mparam)

386− p prm = QueryPartParam $ fmap qParamToQueryPart prm -- (fmap . fmap) (unpack . toQueryParam) prm

387− paramPair = (T.pack pname, p mparam)

388−

389−

390−

391−-- | If you use a 'QueryParams' in one of your endpoints in your API,

392−-- the corresponding querying function will automatically take

393−-- an additional argument, a list of values of the type specified

394−-- by your 'QueryParams'.

177+-- where p = unpack (toUrlPiece val)

395178--

396−-- If you give an empty list, nothing will be added to the query string.

179+-- -- | If you have a 'Delete' endpoint in your API, the client

180+-- -- side querying function that is created when calling 'client'

181+-- -- will just require an argument that specifies the scheme, host

182+-- -- and port to send the request to.

183+-- instance

184+-- #if MIN_VERSION_base(4,8,0)

185+-- {-# OVERLAPPABLE #-}

186+-- #endif

187+-- (MimeUnrender ct a, cts' ~ (ct ': cts)) => HasReflexClient (Delete cts' a) where

188+-- type Input (Delete cts' a) = ()

189+-- type Client (Delete cts' a) = Final a

190+-- clientWithRoute Proxy req baseurl val =

191+-- snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req baseurl val

397192--

398−-- Otherwise, this function will take care

399−-- of inserting a textual representation of your values in the query string,

400−-- under the same query string parameter name.

193+-- instance

194+-- #if MIN_VERSION_base(4,8,0)

195+-- {-# OVERLAPPING #-}

196+-- #endif

197+-- HasReflexClient (Delete cts ()) where

198+-- type Input (Delete cts ()) = ()

199+-- type Client (Delete cts ()) = Final ()

200+-- clientWithRoute Proxy req baseurl val =

201+-- void $ performRequestNoBody H.methodDelete req baseurl val

401202--

402−-- You can control how values for your type are turned into

403−-- text by specifying a 'ToHttpApiData' instance for your type.

203+-- -- | If you have a 'Delete xs (Headers ls x)' endpoint, the client expects the

204+-- -- corresponding headers.

205+-- instance

206+-- #if MIN_VERSION_base(4,8,0)

207+-- {-# OVERLAPPING #-}

208+-- #endif

209+-- ( MimeUnrender ct a, BuildHeadersTo ls, cts' ~ (ct ': cts)

210+-- ) => HasReflexClient (Delete cts' (Headers ls a)) where

211+-- type Input (Delete cts' (Headers ls a)) = ()

212+-- type Client (Delete cts' (Headers ls a)) = Final (Headers ls a)

213+-- clientWithRoute Proxy req baseurl _ = do

214+-- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req baseurl

215+-- return $ Headers { getResponse = resp

216+-- , getHeadersHList = buildHeadersTo hdrs

217+-- }

404218--

405−-- Example:

219+-- -- | If you use a 'Header' in one of your endpoints in your API,

220+-- -- the corresponding querying function will automatically take

221+-- -- an additional argument of the type specified by your 'Header',

222+-- -- wrapped in Maybe.

223+-- --

224+-- -- That function will take care of encoding this argument as Text

225+-- -- in the request headers.

226+-- --

227+-- -- All you need is for your type to have a 'ToHttpApiData' instance.

228+-- --

229+-- -- Example:

230+-- --

231+-- -- > newtype Referer = Referer { referrer :: Text }

232+-- -- > deriving (Eq, Show, Generic, FromText, ToHttpApiData)

233+-- -- >

234+-- -- > -- GET /view-my-referer

235+-- -- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer

236+-- -- >

237+-- -- > myApi :: Proxy MyApi

238+-- -- > myApi = Proxy

239+-- -- >

240+-- -- > viewReferer :: Maybe Referer -> ExceptT String IO Book

241+-- -- > viewReferer = client myApi host

242+-- -- > where host = BaseUrl Http "localhost" 8080

243+-- -- > -- then you can just use "viewRefer" to query that endpoint

244+-- -- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments

245+-- instance (KnownSymbol sym, ToHttpApiData a, HasReflexClient sublayout)

246+-- => HasReflexClient (Header sym a :> sublayout) where

406247--

407−-- > type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]

408−-- >

409−-- > myApi :: Proxy MyApi

410−-- > myApi = Proxy

411−-- >

412−-- > getBooksBy :: [Text] -> ExceptT String IO [Book]

413−-- > getBooksBy = client myApi host

414−-- > where host = BaseUrl Http "localhost" 8080

415−-- > -- then you can just use "getBooksBy" to query that endpoint.

416−-- > -- 'getBooksBy []' for all books

417−-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'

418−-- > -- to get all books by Asimov and Heinlein

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

420− => HasClient t m (QueryParams sym a :> sublayout) tag where

421−

422− type Client t m (QueryParams sym a :> sublayout) tag =

423− Dynamic t [a] -> Client t m sublayout tag

424−

425− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap paramlist =

426− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap

427−

428− where req' = req { qParams = (T.pack pname, params') : qParams req }

429− pname = symbolVal (Proxy :: Proxy sym)

430− params' = QueryPartParams $ (fmap . fmap) toQueryParam

431− paramlist

432−

433−

434−

435−-- | If you use a 'QueryFlag' in one of your endpoints in your API,

436−-- the corresponding querying function will automatically take

437−-- an additional 'Bool' argument.

248+-- type Input (Header sym a :> sublayout) = Maybe a ::> Input sublayout

249+-- type Client (Header sym a :> sublayout) = Client sublayout

438250--

439−-- If you give 'False', nothing will be added to the query string.

251+-- clientWithRoute Proxy req baseurl (mval ::> rest) =

252+-- clientWithRoute (Proxy :: Proxy sublayout)

253+-- (maybe req

254+-- (\value -> Servant.Common.Req.addHeader hname value req)

255+-- mval

256+-- )

257+-- baseurl rest

440258--

441−-- Otherwise, this function will insert a value-less query string

442−-- parameter under the name associated to your 'QueryFlag'.

259+-- where hname = symbolVal (Proxy :: Proxy sym)

443260--

444−-- Example:

261+-- -- | If you have a 'Post' endpoint in your API, the client

262+-- -- side querying function that is created when calling 'client'

263+-- -- will just require an argument that specifies the scheme, host

264+-- -- and port to send the request to.

265+-- instance

266+-- #if MIN_VERSION_base(4,8,0)

267+-- {-# OVERLAPPABLE #-}

268+-- #endif

269+-- (MimeUnrender ct a) => HasReflexClient (Post (ct ': cts) a) where

270+-- type Input (Post (ct ': cts) a) = ()

271+-- type Client (Post (ct ': cts) a) = Final a

272+-- clientWithRoute Proxy req baseurl _ =

273+-- snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req baseurl

445274--

446−-- > type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book]

447−-- >

448−-- > myApi :: Proxy MyApi

449−-- > myApi = Proxy

450−-- >

451−-- > getBooks :: Bool -> ExceptT String IO [Book]

452−-- > getBooks = client myApi host

453−-- > where host = BaseUrl Http "localhost" 8080

454−-- > -- then you can just use "getBooks" to query that endpoint.

455−-- > -- 'getBooksBy False' for all books

456−-- > -- 'getBooksBy True' to only get _already published_ books

457−

458−-- TODO Bring back

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

460− => HasClient t m (QueryFlag sym :> sublayout) tag where

461−

462− type Client t m (QueryFlag sym :> sublayout) tag =

463− Dynamic t Bool -> Client t m sublayout tag

464−

465− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap flag =

466− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap

467−

468− where req' = req { qParams = thisPair : qParams req }

469− thisPair = (T.pack pName, QueryPartFlag flag) :: (Text, QueryPart t)

470− pName = symbolVal (Proxy :: Proxy sym)

471−

472−

473−

474−-- | Send a raw 'XhrRequest ()' directly to 'baseurl'

475−instance SupportsServantReflex t m => HasClient t m Raw tag where

476− type Client t m Raw tag = Dynamic t (Either Text (XhrRequest ()))

477− -> Event t tag

478− -> m (Event t (ReqResult tag ()))

479−

480− clientWithRouteAndResultHandler _ _ _ _ baseurl _ wrap xhrs triggers = do

481−

482− let xhrs' = liftA2 (\x path -> case x of

483− Left e -> Left e

484− Right jx -> Right $ jx { _xhrRequest_url = path <> _xhrRequest_url jx }

485− ) xhrs (showBaseUrl <$> baseurl)

486− xhrs'' = attachPromptlyDynWith (flip (,)) xhrs' triggers :: Event t (tag, Either Text (XhrRequest ()))

487− badReq = fmapMaybe (\(t,x) -> either (Just . (t,)) (const Nothing) x) xhrs'' :: Event t (tag, Text)

488− okReq = fmapMaybe (\(t,x) -> either (const Nothing) (Just . (t,)) x) xhrs'' :: Event t (tag, XhrRequest ())

489−

490− resps <- performRequestsAsync okReq

491− wrap $ leftmost [ uncurry RequestFailure <$> badReq

492− , evalResponse (const $ Right ()) <$> resps

493− ]

494−

495−

496−-- | If you use a 'ReqBody' in one of your endpoints in your API,

497−-- the corresponding querying function will automatically take

498−-- an additional argument of the type specified by your 'ReqBody'.

499−-- That function will take care of encoding this argument as JSON and

500−-- of using it as the request body.

275+-- instance

276+-- #if MIN_VERSION_base(4,8,0)

277+-- {-# OVERLAPPING #-}

278+-- #endif

279+-- HasReflexClient (Post (ct ': cts) ()) where

280+-- type Input (Post (ct ': cts) ()) = ()

281+-- type Client (Post (ct ': cts) ()) = Final ()

282+-- clientWithRoute Proxy req baseurl _ =

283+-- void $ performRequestNoBody H.methodPost req baseurl

501284--

502−-- All you need is for your type to have a 'ToJSON' instance.

285+-- -- | If you have a 'Post xs (Headers ls x)' endpoint, the client expects the

286+-- -- corresponding headers.

287+-- instance

288+-- #if MIN_VERSION_base(4,8,0)

289+-- {-# OVERLAPPING #-}

290+-- #endif

291+-- ( MimeUnrender ct a, BuildHeadersTo ls

292+-- ) => HasReflexClient (Post (ct ': cts) (Headers ls a)) where

293+-- type Input (Post (ct ': cts) (Headers ls a)) = ()

294+-- type Client (Post (ct ': cts) (Headers ls a)) = Final (Headers ls a)

295+-- clientWithRoute Proxy req baseurl _ = do

296+-- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPost req baseurl

297+-- return $ Headers { getResponse = resp

298+-- , getHeadersHList = buildHeadersTo hdrs

299+-- }

503300--

504−-- Example:

301+-- -- | If you have a 'Put' endpoint in your API, the client

302+-- -- side querying function that is created when calling 'client'

303+-- -- will just require an argument that specifies the scheme, host

304+-- -- and port to send the request to.

305+-- instance

306+-- #if MIN_VERSION_base(4,8,0)

307+-- {-# OVERLAPPABLE #-}

308+-- #endif

309+-- (MimeUnrender ct a) => HasReflexClient (Put (ct ': cts) a) where

310+-- type Input (Put (ct ': cts) a) = ()

311+-- type Client (Put (ct ': cts) a) = Final a

312+-- clientWithRoute Proxy req baseurl _ =

313+-- snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req baseurl

505314--

506−-- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book

507−-- >

508−-- > myApi :: Proxy MyApi

509−-- > myApi = Proxy

510−-- >

511−-- > addBook :: Book -> ExceptT String IO Book

512−-- > addBook = client myApi host

513−-- > where host = BaseUrl Http "localhost" 8080

514−-- > -- then you can just use "addBook" to query that endpoint

515−

516−instance (MimeRender ct a, HasClient t m sublayout tag, Reflex t)

517− => HasClient t m (ReqBody (ct ': cts) a :> sublayout) tag where

518−

519− type Client t m (ReqBody (ct ': cts) a :> sublayout) tag =

520− Dynamic t (Either Text a) -> Client t m sublayout tag

521−

522− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap body =

523− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap

524− where req' = req { reqBody = bodyBytesCT }

525− ctProxy = Proxy :: Proxy ct

526− ctString = T.pack $ show $ contentType ctProxy

527− bodyBytesCT = Just $ (fmap . fmap)

528− (\b -> (mimeRender ctProxy b, ctString))

529− body

530−

531−

532−

533−-- | Make the querying function append @path@ to the request path.

534−instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient t m (path :> sublayout) tag where

535− type Client t m (path :> sublayout) tag = Client t m sublayout tag

536−

537− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap =

538− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t

539− (prependToPathParts (pure (Right $ T.pack p)) req) baseurl opts wrap

540−

541− where p = symbolVal (Proxy :: Proxy path)

542−

543−

544−instance HasClient t m api tag => HasClient t m (Vault :> api) tag where

545− type Client t m (Vault :> api) tag = Client t m api tag

546−

547− clientWithRouteAndResultHandler Proxy =

548− clientWithRouteAndResultHandler (Proxy :: Proxy api)

549−

550−

551−instance HasClient t m api tag => HasClient t m (RemoteHost :> api) tag where

552− type Client t m (RemoteHost :> api) tag = Client t m api tag

553−

554− clientWithRouteAndResultHandler Proxy =

555− clientWithRouteAndResultHandler (Proxy :: Proxy api)

556−

557−

558−

559−instance HasClient t m api tag => HasClient t m (IsSecure :> api) tag where

560− type Client t m (IsSecure :> api) tag = Client t m api tag

561−

562− clientWithRouteAndResultHandler Proxy =

563− clientWithRouteAndResultHandler (Proxy :: Proxy api)

564−

565−

566−instance (HasClient t m api tag, Reflex t)

567− => HasClient t m (BasicAuth realm usr :> api) tag where

568−

569− type Client t m (BasicAuth realm usr :> api) tag = Dynamic t (Maybe BasicAuthData)

570− -> Client t m api tag

571−

572− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap authdata =

573− clientWithRouteAndResultHandler (Proxy :: Proxy api) q t req' baseurl opts wrap

574− where

575− req' = req { authData = Just authdata }

576−

577−-- instance HasClient t m subapi =>

578−-- HasClient t m (WithNamedConfig name config subapi) where

579−

580−-- type Client t m (WithNamedConfig name config subapi) = Client t m subapi

581−-- clientWithRoute Proxy q = clientWithRoute (Proxy :: Proxy subapi) q

582−

583−

584−{- Note [Non-Empty Content Types]

585−~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

586−Rather than have

587−

588− instance (..., cts' ~ (ct ': cts)) => ... cts' ...

589−

590−It may seem to make more sense to have:

591−

592− instance (...) => ... (ct ': cts) ...

593−

594−But this means that if another instance exists that does *not* require

595−non-empty lists, but is otherwise more specific, no instance will be overall

596−more specific. This in turn generally means adding yet another instance (one

597−for empty and one for non-empty lists).

598−-}

599−

600−

601−-- SUPPORT FOR servant-auth --

602−

603−-- For JavaScript clients we should be sending/storing JSON web tokens in a

604−-- way that is inaccessible to JavaScript.

315+-- instance

316+-- #if MIN_VERSION_base(4,8,0)

317+-- {-# OVERLAPPING #-}

318+-- #endif

319+-- HasReflexClient (Put (ct ': cts) ()) where

320+-- type Input (Put (ct ': cts) ()) = ()

321+-- type Client (Put (ct ': cts) ()) = Final ()

322+-- clientWithRoute Proxy req baseurl _ =

323+-- void $ performRequestNoBody H.methodPut req baseurl

605324--

606−-- For @servant-auth@ this is done with HTTP-only cookies. In a Reflex-DOM

607−-- app this means the @servant-auth@ client should only verify that the API

608−-- supports Cookie-based authentication but do nothing with the token

609−-- directly.

610−

611−-- @HasCookieAuth auths@ is nominally a redundant constraint, but ensures

612−-- we're not trying to rely on cookies when the API does not use them.

613−instance (HasCookieAuth auths, HasClient t m api tag) => HasClient t m (Auth.Auth auths a :> api) tag where

614−

615− type Client t m (Auth.Auth auths a :> api) tag = Client t m api tag

616− clientWithRouteAndResultHandler Proxy = clientWithRouteAndResultHandler (Proxy :: Proxy api)

617−

618−

619−type family HasCookieAuth xs :: Constraint where

620− HasCookieAuth (Auth.Cookie ': xs) = ()

621− HasCookieAuth (x ': xs) = HasCookieAuth xs

622− HasCookieAuth '[] = CookieAuthNotEnabled

623−

624−class CookieAuthNotEnabled

325+-- -- | If you have a 'Put xs (Headers ls x)' endpoint, the client expects the

326+-- -- corresponding headers.

327+-- instance

328+-- #if MIN_VERSION_base(4,8,0)

329+-- {-# OVERLAPPING #-}

330+-- #endif

331+-- ( MimeUnrender ct a, BuildHeadersTo ls

332+-- ) => HasReflexClient (Put (ct ': cts) (Headers ls a)) where

333+-- type Input (Put (ct ': cts) (Headers ls a)) = ()

334+-- type Client (Put (ct ': cts) (Headers ls a)) = Final (Headers ls a)

335+-- clientWithRoute Proxy req baseurl _ = do

336+-- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPut req baseurl

337+-- return $ Headers { getResponse = resp

338+-- , getHeadersHList = buildHeadersTo hdrs

339+-- }

340+--

341+-- -- | If you have a 'Patch' endpoint in your API, the client

342+-- -- side querying function that is created when calling 'client'

343+-- -- will just require an argument that specifies the scheme, host

344+-- -- and port to send the request to.

345+-- instance

346+-- #if MIN_VERSION_base(4,8,0)

347+-- {-# OVERLAPPABLE #-}

348+-- #endif

349+-- (MimeUnrender ct a) => HasReflexClient (Patch (ct ': cts) a) where

350+-- type Input (Patch (ct ': cts) a) = ()

351+-- type Client (Patch (ct ': cts) a) = Final a

352+-- clientWithRoute Proxy req baseurl _ =

353+-- snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req baseurl

354+--

355+-- instance

356+-- #if MIN_VERSION_base(4,8,0)

357+-- {-# OVERLAPPING #-}

358+-- #endif

359+-- HasReflexClient (Patch (ct ': cts) ()) where

360+-- type Input (Patch (ct ': cts) ()) = ()

361+-- type Client (Patch (ct ': cts) ()) = Final ()

362+-- clientWithRoute Proxy req baseurl _ =

363+-- void $ performRequestNoBody H.methodPatch req baseurl

364+--

365+-- -- | If you have a 'Patch xs (Headers ls x)' endpoint, the client expects the

366+-- -- corresponding headers.

367+-- instance

368+-- #if MIN_VERSION_base(4,8,0)

369+-- {-# OVERLAPPING #-}

370+-- #endif

371+-- ( MimeUnrender ct a, BuildHeadersTo ls

372+-- ) => HasReflexClient (Patch (ct ': cts) (Headers ls a)) where

373+-- type Input (Patch (ct ': cts) (Headers ls a)) = ()

374+-- type Client (Patch (ct ': cts) (Headers ls a)) = Final (Headers ls a)

375+-- clientWithRoute Proxy req baseurl _ = do

376+-- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPatch req baseurl

377+-- return $ Headers { getResponse = resp

378+-- , getHeadersHList = buildHeadersTo hdrs

379+-- }

380+--

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

382+-- -- the corresponding querying function will automatically take

383+-- -- an additional argument of the type specified by your 'QueryParam',

384+-- -- enclosed in Maybe.

385+-- --

386+-- -- If you give Nothing, nothing will be added to the query string.

387+-- --

388+-- -- If you give a non-'Nothing' value, this function will take care

389+-- -- of inserting a textual representation of this value in the query string.

390+-- --

391+-- -- You can control how values for your type are turned into

392+-- -- text by specifying a 'ToHttpApiData' instance for your type.

393+-- --

394+-- -- Example:

395+-- --

396+-- -- > type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]

397+-- -- >

398+-- -- > myApi :: Proxy MyApi

399+-- -- > myApi = Proxy

400+-- -- >

401+-- -- > getBooksBy :: Maybe Text -> ExceptT String IO [Book]

402+-- -- > getBooksBy = client myApi host

403+-- -- > where host = BaseUrl Http "localhost" 8080

404+-- -- > -- then you can just use "getBooksBy" to query that endpoint.

405+-- -- > -- 'getBooksBy Nothing' for all books

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

407+-- instance (KnownSymbol sym, ToHttpApiData a, HasReflexClient sublayout)

408+-- => HasReflexClient (QueryParam sym a :> sublayout) where

409+--

410+-- type Input (QueryParam sym a :> sublayout) = Maybe a ::> Input sublayout

411+-- type Client (QueryParam sym a :> sublayout) = Client sublayout

412+--

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

414+-- clientWithRoute Proxy req baseurl (mparam ::> rest) =

415+-- clientWithRoute (Proxy :: Proxy sublayout)

416+-- (maybe req

417+-- (flip (appendToQueryString pname) req . Just)

418+-- mparamText

419+-- )

420+-- baseurl rest

421+--

422+-- where pname = cs pname'

423+-- pname' = symbolVal (Proxy :: Proxy sym)

424+-- mparamText = fmap toQueryParam mparam

425+--

426+-- -- | If you use a 'QueryParams' in one of your endpoints in your API,

427+-- -- the corresponding querying function will automatically take

428+-- -- an additional argument, a list of values of the type specified

429+-- -- by your 'QueryParams'.

430+-- --

431+-- -- If you give an empty list, nothing will be added to the query string.

432+-- --

433+-- -- Otherwise, this function will take care

434+-- -- of inserting a textual representation of your values in the query string,

435+-- -- under the same query string parameter name.

436+-- --

437+-- -- You can control how values for your type are turned into

438+-- -- text by specifying a 'ToHttpApiData' instance for your type.

439+-- --

440+-- -- Example:

441+-- --

442+-- -- > type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]

443+-- -- >

444+-- -- > myApi :: Proxy MyApi

445+-- -- > myApi = Proxy

446+-- -- >

447+-- -- > getBooksBy :: [Text] -> ExceptT String IO [Book]

448+-- -- > getBooksBy = client myApi host

449+-- -- > where host = BaseUrl Http "localhost" 8080

450+-- -- > -- then you can just use "getBooksBy" to query that endpoint.

451+-- -- > -- 'getBooksBy []' for all books

452+-- -- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'

453+-- -- > -- to get all books by Asimov and Heinlein

454+-- instance (KnownSymbol sym, ToHttpApiData a, HasReflexClient sublayout)

455+-- => HasReflexClient (QueryParams sym a :> sublayout) where

456+--

457+-- type Input (QueryParams sym a :> sublayout) = [a] ::> Input sublayout

458+-- type Client (QueryParams sym a :> sublayout) = Client sublayout

459+--

460+-- clientWithRoute Proxy req baseurl (paramlist ::> rest) =

461+-- clientWithRoute (Proxy :: Proxy sublayout)

462+-- (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))

463+-- req

464+-- paramlist'

465+-- )

466+-- baseurl rest

467+--

468+-- where pname = cs pname'

469+-- pname' = symbolVal (Proxy :: Proxy sym)

470+-- paramlist' = map (Just . toQueryParam) paramlist

471+--

472+-- -- | If you use a 'QueryFlag' in one of your endpoints in your API,

473+-- -- the corresponding querying function will automatically take

474+-- -- an additional 'Bool' argument.

475+-- --

476+-- -- If you give 'False', nothing will be added to the query string.

477+-- --

478+-- -- Otherwise, this function will insert a value-less query string

479+-- -- parameter under the name associated to your 'QueryFlag'.

480+-- --

481+-- -- Example:

482+-- --

483+-- -- > type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book]

484+-- -- >

485+-- -- > myApi :: Proxy MyApi

486+-- -- > myApi = Proxy

487+-- -- >

488+-- -- > getBooks :: Bool -> ExceptT String IO [Book]

489+-- -- > getBooks = client myApi host

490+-- -- > where host = BaseUrl Http "localhost" 8080

491+-- -- > -- then you can just use "getBooks" to query that endpoint.

492+-- -- > -- 'getBooksBy False' for all books

493+-- -- > -- 'getBooksBy True' to only get _already published_ books

494+-- instance (KnownSymbol sym, HasReflexClient sublayout)

495+-- => HasReflexClient (QueryFlag sym :> sublayout) where

496+--

497+-- type Input (QueryFlag sym :> sublayout) = Bool ::> Input sublayout

498+-- type Client (QueryFlag sym :> sublayout) = Client sublayout

499+--

500+-- clientWithRoute Proxy req baseurl (flag ::> rest) =

501+-- clientWithRoute (Proxy :: Proxy sublayout)

502+-- (if flag

503+-- then appendToQueryString paramname Nothing req

504+-- else req

505+-- )

506+-- baseurl rest

507+--

508+-- where paramname = cs $ symbolVal (Proxy :: Proxy sym)

509+--

510+--

511+-- -- | If you use a 'ReqBody' in one of your endpoints in your API,

512+-- -- the corresponding querying function will automatically take

513+-- -- an additional argument of the type specified by your 'ReqBody'.

514+-- -- That function will take care of encoding this argument as JSON and

515+-- -- of using it as the request body.

516+-- --

517+-- -- All you need is for your type to have a 'ToJSON' instance.

518+-- --

519+-- -- Example:

520+-- --

521+-- -- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book

522+-- -- >

523+-- -- > myApi :: Proxy MyApi

524+-- -- > myApi = Proxy

525+-- -- >

526+-- -- > addBook :: Book -> ExceptT String IO Book

527+-- -- > addBook = client myApi host

528+-- -- > where host = BaseUrl Http "localhost" 8080

529+-- -- > -- then you can just use "addBook" to query that endpoint

530+-- instance (MimeRender ct a, HasReflexClient sublayout)

531+-- => HasReflexClient (ReqBody (ct ': cts) a :> sublayout) where

532+--

533+-- type Input (ReqBody (ct ': cts) a :> sublayout) = a ::> Input sublayout

534+-- type Client (ReqBody (ct ': cts) a :> sublayout) = Client sublayout

535+--

536+-- clientWithRoute Proxy req baseurl (body ::> rest) =

537+-- clientWithRoute (Proxy :: Proxy sublayout)

538+-- (let ctProxy = Proxy :: Proxy ct

539+-- in setRQBody (mimeRender ctProxy body)

540+-- (contentType ctProxy)

541+-- req

542+-- )

543+-- baseurl rest

544+--

545+-- -- | Make the querying function append @path@ to the request path.

546+-- instance (KnownSymbol path, HasReflexClient sublayout) => HasReflexClient (path :> sublayout) where

547+-- type Input (path :> sublayout) = Input sublayout

548+-- type Client (path :> sublayout) = Client sublayout

549+--

550+-- clientWithRoute Proxy req baseurl val =

551+-- clientWithRoute (Proxy :: Proxy sublayout)

552+-- (appendToPath p req)

553+-- baseurl val

554+--

555+-- where p = symbolVal (Proxy :: Proxy path)

556+--

557+-- instance HasReflexClient api => HasReflexClient (Vault :> api) where

558+-- type Input (Vault :> api) = Input api

559+-- type Client (Vault :> api) = Client api

560+--

561+-- clientWithRoute Proxy req baseurl val =

562+-- clientWithRoute (Proxy :: Proxy api) req baseurl val

563+--

564+-- instance HasReflexClient api => HasReflexClient (RemoteHost :> api) where

565+-- type Input (RemoteHost :> api) = Input api

566+-- type Client (RemoteHost :> api) = Client api

567+--

568+-- clientWithRoute Proxy req baseurl val =

569+-- clientWithRoute (Proxy :: Proxy api) req baseurl val

570+--

571+-- instance HasReflexClient api => HasReflexClient (IsSecure :> api) where

572+-- type Input (IsSecure :> api) = Input api

573+-- type Client (IsSecure :> api) = Client api

574+--

575+-- clientWithRoute Proxy req baseurl val =

576+-- clientWithRoute (Proxy :: Proxy api) req baseurl val

src/Servant/Reflex/Multi.hsdeleted−401

@@ -1,401 +0,0 @@

1−{-# LANGUAGE AllowAmbiguousTypes #-}

2−{-# LANGUAGE CPP #-}

3−{-# LANGUAGE DataKinds #-}

4−{-# LANGUAGE FlexibleContexts #-}

5−{-# LANGUAGE FlexibleInstances #-}

6−{-# LANGUAGE InstanceSigs #-}

7−{-# LANGUAGE MultiParamTypeClasses #-}

8−{-# LANGUAGE OverloadedStrings #-}

9−{-# LANGUAGE PolyKinds #-}

10−{-# LANGUAGE ScopedTypeVariables #-}

11−{-# LANGUAGE TupleSections #-}

12−{-# LANGUAGE TypeFamilies #-}

13−{-# LANGUAGE TypeOperators #-}

14−{-# LANGUAGE UndecidableInstances #-}

15−

16−module Servant.Reflex.Multi (

17− -- * Compute servant client functions

18− clientA

19− , clientWithOptsA

20− , BaseUrl(..)

21− , Scheme(..)

22−

23− -- * Build QueryParam arguments

24− , QParam(..)

25−

26− -- * Access response data

27− , withCredentials

28−

29− -- * Access response data

30− , ReqResult(..)

31− , reqSuccess

32− , reqSuccess'

33− , reqFailure

34− , response

35−

36− , HasClientMulti(..)

37− ) where

38−

39−------------------------------------------------------------------------------

40−import Control.Applicative (liftA2)

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

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

43−import qualified Data.Set as Set

44−import Data.Text (Text)

45−import qualified Data.Text as T

46−import qualified Data.Text.Encoding as E

47−import GHC.TypeLits (KnownSymbol, symbolVal)

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

49− BasicAuthData, BuildHeadersTo (..),

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

51− HttpVersion, IsSecure,

52− MimeRender (..), MimeUnrender,

53− NoContent, QueryFlag, QueryParam,

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

55− RemoteHost, ReqBody,

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

57− contentType)

58−import Servant.API.Description (Summary)

59−

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

61− XhrRequest (..),

62− XhrResponseHeaders (..),

63− attachPromptlyDynWith, constDyn)

64−------------------------------------------------------------------------------

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

66− SupportsServantReflex)

67−import Servant.Common.Req (ClientOptions,

68− QParam (..), QueryPart (..), Req,

69− ReqResult (..), addHeader, authData,

70− defReq,

71− defaultClientOptions,

72− performRequestsCT,

73− performRequestsNoBody,

74− performSomeRequestsAsync,

75− prependToPathParts, qParamToQueryPart,

76− qParams, reqBody, reqFailure,

77− reqMethod, reqSuccess, reqSuccess',

78− respHeaders, response, withCredentials)

79−import Servant.Reflex (BuildHeaderKeysTo (..), toHeaders)

80−

81−

82−------------------------------------------------------------------------------

83−clientA :: (HasClientMulti t m layout f tag, Applicative f, Reflex t)

84− => Proxy layout -> Proxy m -> Proxy f -> Proxy tag

85− -> Dynamic t BaseUrl -> ClientMulti t m layout f tag

86−clientA p q f tag baseurl =

87− clientWithRouteMulti p q f tag (constDyn (pure defReq)) baseurl

88− defaultClientOptions

89−

90−

91−-- | A version of @client@ that sets the withCredentials flag

92−-- on requests. Use this function for clients of CORS API's

93−clientWithOptsA :: (HasClientMulti t m layout f tag, Applicative f, Reflex t)

94− => Proxy layout -> Proxy m -> Proxy f -> Proxy tag

95− -> Dynamic t BaseUrl -> ClientOptions -> ClientMulti t m layout f tag

96−clientWithOptsA p q f tag baseurl opts =

97− clientWithRouteMulti p q f tag

98− (constDyn (pure defReq)) baseurl opts

99−

100−------------------------------------------------------------------------------

101−class HasClientMulti t m layout f (tag :: *) where

102− type ClientMulti t m layout f tag :: *

103− clientWithRouteMulti :: Proxy layout -> Proxy m -> Proxy f -> Proxy tag

104− -> Dynamic t (f (Req t)) -> Dynamic t BaseUrl

105− -> ClientOptions -> ClientMulti t m layout f tag

106−

107−

108−------------------------------------------------------------------------------

109−instance (HasClientMulti t m a f tag, HasClientMulti t m b f tag) =>

110− HasClientMulti t m (a :<|> b) f tag where

111− type ClientMulti t m (a :<|> b) f tag = ClientMulti t m a f tag :<|>

112− ClientMulti t m b f tag

113− clientWithRouteMulti Proxy q f tag reqs baseurl opts =

114− clientWithRouteMulti (Proxy :: Proxy a) q f tag reqs baseurl opts :<|>

115− clientWithRouteMulti (Proxy :: Proxy b) q f tag reqs baseurl opts

116−

117−

118−------------------------------------------------------------------------------

119−instance (SupportsServantReflex t m,

120− ToHttpApiData a,

121− HasClientMulti t m sublayout f tag,

122− Applicative f)

123− => HasClientMulti t m (Capture capture a :> sublayout) f tag where

124−

125− type ClientMulti t m (Capture capture a :> sublayout) f tag =

126− f (Dynamic t (Either Text a)) -> ClientMulti t m sublayout f tag

127−

128− clientWithRouteMulti _ q f tag reqs baseurl opts vals =

129− clientWithRouteMulti (Proxy :: Proxy sublayout) q f tag reqs' baseurl opts

130− where

131− reqs' = (prependToPathParts <$> ps <*>) <$> reqs

132− ps = (fmap . fmap . fmap) toUrlPiece vals

133−

134−

135−------------------------------------------------------------------------------

136−-- VERB (Returning content) --

137−instance {-# OVERLAPPABLE #-}

138− -- Note [Non-Empty Content Types]

139− (MimeUnrender ct a,

140− ReflectMethod method, cts' ~ (ct ': cts),

141− SupportsServantReflex t m,

142− Applicative f,

143− Traversable f

144− ) => HasClientMulti t m (Verb method status cts' a) f tag where

145−

146− type ClientMulti t m (Verb method status cts' a) f tag =

147− Event t tag -> m (Event t (f (ReqResult tag a)))

148−

149− clientWithRouteMulti _ _ _ _ reqs baseurl opts =

150− performRequestsCT (Proxy :: Proxy ct) method reqs' baseurl opts

151− where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

152− reqs' = fmap (\r -> r { reqMethod = method }) <$> reqs

153−

154−

155−------------------------------------------------------------------------------

156−-- -- VERB (No content) --

157−instance {-# OVERLAPPING #-}

158− (ReflectMethod method, SupportsServantReflex t m, Traversable f) =>

159− HasClientMulti t m (Verb method status cts NoContent) f tag where

160− type ClientMulti t m (Verb method status cts NoContent) f tag =

161− Event t tag -> m (Event t (f (ReqResult tag NoContent)))

162− -- TODO: how to access input types here?

163− -- ExceptT ServantError IO NoContent

164− clientWithRouteMulti Proxy _ _ _ req baseurl opts =

165− performRequestsNoBody method req baseurl opts

166− where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

167−

168−

169−------------------------------------------------------------------------------

170−instance {-# OVERLAPPABLE #-}

171− -- Note [Non-Empty Content Types]

172− ( MimeUnrender ct a, BuildHeadersTo ls, BuildHeaderKeysTo ls,

173− ReflectMethod method, cts' ~ (ct ': cts),

174− SupportsServantReflex t m,

175− Traversable f

176− ) => HasClientMulti t m (Verb method status cts' (Headers ls a)) f tag where

177− type ClientMulti t m (Verb method status cts' (Headers ls a)) f tag =

178− Event t tag -> m (Event t (f (ReqResult tag (Headers ls a))))

179− clientWithRouteMulti Proxy _ _ _ reqs baseurl opts triggers = do

180− let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

181− resp <- performRequestsCT (Proxy :: Proxy ct) method reqs' baseurl opts triggers :: m (Event t (f (ReqResult tag a)))

182− return $ fmap toHeaders <$> resp

183− where

184− reqs' = fmap (\r ->

185− r { respHeaders =

186− OnlyHeaders (Set.fromList

187− (buildHeaderKeysTo (Proxy :: Proxy ls)))

188− }) <$> reqs

189−

190−

191−------------------------------------------------------------------------------

192−instance {-# OVERLAPPABLE #-}

193− ( BuildHeadersTo ls,

194− BuildHeaderKeysTo ls,

195− ReflectMethod method,

196− SupportsServantReflex t m,

197− Traversable f

198− ) => HasClientMulti t m (Verb method status

199− cts (Headers ls NoContent)) f tag where

200− type ClientMulti t m (Verb method status cts (Headers ls NoContent)) f tag

201− = Event t tag -> m (Event t (f (ReqResult tag (Headers ls NoContent))))

202− clientWithRouteMulti Proxy _ _ _ reqs baseurl opts triggers = do

203− let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)

204− resp <- performRequestsNoBody method reqs' baseurl opts triggers

205− return $ fmap toHeaders <$> resp

206− where reqs' = fmap (\req ->

207− req {respHeaders = OnlyHeaders (Set.fromList

208− (buildHeaderKeysTo (Proxy :: Proxy ls)))

209− }) <$> reqs

210−

211−

212−------------------------------------------------------------------------------

213−instance (KnownSymbol sym,

214− ToHttpApiData a,

215− HasClientMulti t m sublayout f tag,

216− SupportsServantReflex t m,

217− Traversable f,

218− Applicative f)

219− => HasClientMulti t m (Header sym a :> sublayout) f tag where

220−

221− type ClientMulti t m (Header sym a :> sublayout) f tag =

222− f (Dynamic t (Either Text a)) -> ClientMulti t m sublayout f tag

223−

224− clientWithRouteMulti Proxy f q tag reqs baseurl opts eVals =

225− clientWithRouteMulti (Proxy :: Proxy sublayout) f

226− q tag

227− reqs'

228− baseurl opts

229− where hname = T.pack $ symbolVal (Proxy :: Proxy sym)

230− reqs' = ((\eVal req -> Servant.Common.Req.addHeader hname eVal req)

231− <$> eVals <*>) <$> reqs

232−

233−

234−------------------------------------------------------------------------------

235−instance HasClientMulti t m sublayout f tag

236− => HasClientMulti t m (HttpVersion :> sublayout) f tag where

237−

238− type ClientMulti t m (HttpVersion :> sublayout) f tag =

239− ClientMulti t m sublayout f tag

240−

241− clientWithRouteMulti Proxy q f tag =

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

243−

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−

256−------------------------------------------------------------------------------

257−instance (KnownSymbol sym,

258− ToHttpApiData a,

259− HasClientMulti t m sublayout f tag,

260− Reflex t,

261− Applicative f)

262− => HasClientMulti t m (QueryParam sym a :> sublayout) f tag where

263−

264− type ClientMulti t m (QueryParam sym a :> sublayout) f tag =

265− Dynamic t (f (QParam a)) -> ClientMulti t m sublayout f tag

266−

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

268− -- TODO: Check the above comment

269− clientWithRouteMulti Proxy q f tag reqs baseurl opts mparams =

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

271− reqs' baseurl opts

272−

273− where pname = symbolVal (Proxy :: Proxy sym)

274− p prm = QueryPartParam $ fmap qParamToQueryPart prm

275− paramPair mp = (T.pack pname, p mp)

276− -- reqs' = (\params reqs -> (\req param -> req {qParams = paramPair param : qParams req}) <$> reqs <*> params)

277− -- <$> mparams <*> reqs

278− reqs' = liftA2 (\(pr :: QParam a) (r :: Req t) -> r { qParams = paramPair (constDyn pr) : qParams r })

279− <$> mparams <*> reqs

280−

281−

282−instance (KnownSymbol sym,

283− ToHttpApiData a,

284− HasClientMulti t m sublayout f tag,

285− Reflex t,

286− Applicative f)

287− => HasClientMulti t m (QueryParams sym a :> sublayout) f tag where

288−

289− type ClientMulti t m (QueryParams sym a :> sublayout) f tag =

290− Dynamic t (f [a]) -> ClientMulti t m sublayout f tag

291−

292− clientWithRouteMulti Proxy q f tag reqs baseurl opts paramlists =

293− clientWithRouteMulti (Proxy :: Proxy sublayout) q f tag reqs' baseurl opts

294−

295− where req' l r = r { qParams = (T.pack pname, params' (constDyn l)) : qParams r }

296− pname = symbolVal (Proxy :: Proxy sym)

297− params' l = QueryPartParams $ (fmap . fmap) (toQueryParam)

298− l

299− reqs' = liftA2 req' <$> paramlists <*> reqs

300−

301−

302−instance (KnownSymbol sym,

303− HasClientMulti t m sublayout f tag,

304− Reflex t,

305− Applicative f)

306− => HasClientMulti t m (QueryFlag sym :> sublayout) f tag where

307−

308− type ClientMulti t m (QueryFlag sym :> sublayout) f tag =

309− Dynamic t (f Bool) -> ClientMulti t m sublayout f tag

310−

311− clientWithRouteMulti Proxy q f' tag reqs baseurl opts flags =

312− clientWithRouteMulti (Proxy :: Proxy sublayout) q f' tag reqs' baseurl opts

313−

314− where req' f req = req { qParams = thisPair (constDyn f) : qParams req }

315− thisPair f = (T.pack pName, QueryPartFlag f) :: (Text, QueryPart t)

316− pName = symbolVal (Proxy :: Proxy sym)

317− reqs' = liftA2 req' <$> flags <*> reqs

318−

319−

320−instance (SupportsServantReflex t m,

321− Traversable f, Applicative f) => HasClientMulti t m Raw f tag where

322− type ClientMulti t m Raw f tag = f (Dynamic t (Either Text (XhrRequest ())))

323− -> Event t tag

324− -> m (Event t (f (ReqResult tag ())))

325−

326− clientWithRouteMulti _ _ _ _ _ _ opts rawReqs triggers = do

327− let rawReqs' = sequence rawReqs :: Dynamic t (f (Either Text (XhrRequest ())))

328− rawReqs'' = attachPromptlyDynWith (\fxhr t -> Compose (t, fxhr)) rawReqs' triggers

329− resps <- fmap (fmap aux . sequenceA . getCompose) <$> performSomeRequestsAsync opts rawReqs''

330− return resps

331− where

332− aux (tag, Right r) = ResponseSuccess tag () r

333− aux (tag, Left e) = RequestFailure tag e

334−

335−

336−instance (MimeRender ct a,

337− HasClientMulti t m sublayout f tag,

338− Reflex t,

339− Applicative f)

340− => HasClientMulti t m (ReqBody (ct ': cts) a :> sublayout) f tag where

341−

342− type ClientMulti t m (ReqBody (ct ': cts) a :> sublayout) f tag =

343− Dynamic t (f (Either Text a)) -> ClientMulti t m sublayout f tag

344−

345− clientWithRouteMulti Proxy q f tag reqs baseurl opts bodies =

346− clientWithRouteMulti (Proxy :: Proxy sublayout) q f tag reqs' baseurl opts

347− where req' b r = r { reqBody = bodyBytesCT (constDyn b) }

348− ctProxy = Proxy :: Proxy ct

349− ctString = T.pack $ show $ contentType ctProxy

350− bodyBytesCT b = Just $ (fmap . fmap)

351− (\b' -> (mimeRender ctProxy b', ctString))

352− b

353− reqs' = liftA2 req' <$> bodies <*> reqs

354−

355−

356−instance (KnownSymbol path,

357− HasClientMulti t m sublayout f tag,

358− Reflex t,

359− Functor f) => HasClientMulti t m (path :> sublayout) f tag where

360− type ClientMulti t m (path :> sublayout) f tag = ClientMulti t m sublayout f tag

361−

362− clientWithRouteMulti Proxy q f tag reqs baseurl =

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

364− (fmap (prependToPathParts (pure (Right $ T.pack p))) <$> reqs)

365− baseurl

366−

367− where p = symbolVal (Proxy :: Proxy path)

368−

369−

370−instance HasClientMulti t m api f tag => HasClientMulti t m (Vault :> api) f tag where

371− type ClientMulti t m (Vault :> api) f tag = ClientMulti t m api f tag

372−

373− clientWithRouteMulti Proxy q f tag reqs baseurl =

374− clientWithRouteMulti (Proxy :: Proxy api) q f tag reqs baseurl

375−

376−

377−instance HasClientMulti t m api f tag => HasClientMulti t m (RemoteHost :> api) f tag where

378− type ClientMulti t m (RemoteHost :> api) f tag = ClientMulti t m api f tag

379−

380− clientWithRouteMulti Proxy q f tag reqs baseurl =

381− clientWithRouteMulti (Proxy :: Proxy api) q f tag reqs baseurl

382−

383−

384−instance HasClientMulti t m api f tag => HasClientMulti t m (IsSecure :> api) f tag where

385− type ClientMulti t m (IsSecure :> api) f tag = ClientMulti t m api f tag

386−

387− clientWithRouteMulti Proxy q f tag reqs baseurl =

388− clientWithRouteMulti (Proxy :: Proxy api) q f tag reqs baseurl

389−

390−

391−instance (HasClientMulti t m api f tag, Reflex t, Applicative f)

392− => HasClientMulti t m (BasicAuth realm usr :> api) f tag where

393−

394− type ClientMulti t m (BasicAuth realm usr :> api) f tag = Dynamic t (f (Maybe BasicAuthData))

395− -> ClientMulti t m api f tag

396−

397− clientWithRouteMulti Proxy q f tag reqs baseurl opts authdatas =

398− clientWithRouteMulti (Proxy :: Proxy api) q f tag reqs' baseurl opts

399− where

400− req' a r = r { authData = Just (constDyn a) }

401− reqs' = liftA2 req' <$> authdatas <*> reqs

stack.yamldeleted−56

@@ -1,56 +0,0 @@

1−flags: {}

2−extra-package-dbs: []

3−packages:

4−- '.'

5−

6−- location:

7− git: https://github.com/reflex-frp/reflex

8− commit: d78ba4318c425ca9b942dc387d7c5c7ab2d2e095

9− extra-dep: true

10−

11−- location:

12− git: https://github.com/mokus0/dependent-sum.git

13− commit: bbc8ad3a81ea7f2b07ce7d036efd56f2e0f7c6ff

14− extra-dep: true

15−

16−- location:

17− git: https://github.com/gtk2hs/gtk2hs.git

18− commit: 21d3a12a82756d04066e5e4198b35097012ee65b

19− subdirs:

20− - cairo

21− - gio

22− - glib

23− - gtk

24− - pango

25− - tools

26− extra-dep: true

27−

28−- location:

29− git: https://github.com/byorgey/hashtables.git

30− commit: 47d9ed261a5aba66a13d3c4da0e391d338b57fc5

31− extra-dep: true

32−

33−- location:

34− git: https://github.com/afcady/reflex-dom.git

35− commit: 39b5ff23f3ae95d77c909ab3ed4bc4bd9e61f600

36− extra-dep: true

37−

38−- location:

39− git: https://github.com/afcady/dependent-sum-template.git

40− commit: 68fc1a90580ea8f20775491cf651eefea422212a

41− extra-dep: true

42−

43−extra-deps:

44−- cpphs-1.20.4

45−- directory-1.2.7.1

46−- ghcjs-dom-0.2.4.0

47−- haskell-src-exts-1.17.1

48−- haskell-src-meta-0.6.0.14

49−- hlint-1.9.35

50−- prim-uniq-0.1.0.1

51−- primitive-0.6.2.0

52−- ref-tf-0.4.0.1

53−- vector-0.12.0.0

54−- webkitgtk3-javascriptcore-0.13.2.0

55−- zenc-0.1.1

56−resolver: lts-8.3

testdriver/LICENSE.mddeleted−30