master...cb7bb12 · servant-reflex

git.iko.soy/servant-reflex

on cb7bb12 help sign in

exec/Example.hs+20−19

since splitsnapshots

unifiedsplit

@@ -30,6 +30,7 @@ api = Proxy

31main :: IO ()

32main = mainWidget $ do

33+ el "h1" $ text "Wowzers!"

33 divClass "example-base" run

34 divClass "example-base" run

34 divClass "example-multi" runMulti

35 divClass "example-multi" runMulti

@@ -64,9 +65,9 @@ runMulti = do

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

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

65 text "Greetings"

66 text "Greetings"

66 textInput def

67 textInput def

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

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

68 b <- button "Go"

69 b <- button "Go"

69− r' <- sayHi (fmap QParamSome <$> nms) (fmap (:[]) $ grts) (constDyn [True, False]) (1 <$ b)

70+ r' <- sayHi (fmap QParamSome <$> nms) (fmap (:[]) grts) (constDyn [True, False]) (1 <$ b)

71 dynText =<< holdDyn "Waiting" (T.pack . show . catMaybes . fmap reqSuccess <$> r')

72 dynText =<< holdDyn "Waiting" (T.pack . show . catMaybes . fmap reqSuccess <$> r')

@@ -103,11 +104,11 @@ run = mdo

103 unitResponse <- getUnit $ tag (current reqCount) unitBtn

104 unitResponse <- getUnit $ tag (current reqCount) unitBtn

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

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

105

106

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

107+ score <- foldDyn (+) 0 (fmapMaybe reqSuccess intResponse)

107

108

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

109+ r <- holdDyn "Waiting" $ showXhrResponse <$>

109− leftmost [fmapMaybe response (unitResponse)

110+ leftmost [fmapMaybe response unitResponse

110− ,fmapMaybe response (intResponse)

111+ ,fmapMaybe response intResponse

111 ]

112 ]

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

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

113 return (unitBtn, intBtn)

114 return (unitBtn, intBtn)

@@ -116,14 +117,14 @@ run = mdo

116

117

117 text "Name"

118 text "Name"

118 el "br" $ return ()

119 el "br" $ return ()

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

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

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

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

121 el "br" $ return ()

122 el "br" $ return ()

122

123

123 text "Greetings (space-separated)"

124 text "Greetings (space-separated)"

124 el "br" $ return ()

125 el "br" $ return ()

125 greetings <- fmap (fmap T.words . value) $

126 greetings <- fmap (fmap T.words . value) $

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

127+ divClass "greetings-input" $ textInput def

127

128

128 el "br" $ return ()

129 el "br" $ return ()

129

130

@@ -135,23 +136,23 @@ run = mdo

135

136

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

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

137 divClass "greeting-response" $ dynText =<<

138 divClass "greeting-response" $ dynText =<<

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

139+ holdDyn "No hi yet" (leftmost [ fmapMaybe reqSuccess resp

139− , fmapMaybe reqFailure (resp)])

140+ , fmapMaybe reqFailure resp])

140 return sayHiClicks

141 return sayHiClicks

141

142

142 dblBtn <- elClass "div" "demo-group" $ do

143 dblBtn <- elClass "div" "demo-group" $ do

143 text "A Double to double"

144 text "A Double to double"

144 el "br" $ return ()

145 el "br" $ return ()

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

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

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

147+ dblBtn <- divClass "double-button" $ button "Double it"

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

148+ dblResp <- dbl ((note "read failure" . readMaybe . T.unpack) <$>

148 dblinp) (tag (current reqCount) dblBtn)

149 dblinp) (tag (current reqCount) dblBtn)

149 divClass "double-errors" $ dynText =<<

150 divClass "double-errors" $ dynText =<<

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

151+ holdDyn "(no errors)" (fmapMaybe reqFailure dblResp)

151 el "br" (return ())

152 el "br" (return ())

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

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

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

154+ holdDyn "No number yet" (tShow <$>

154− fmapMaybe reqSuccess (dblResp))

155+ fmapMaybe reqSuccess dblResp)

155 return dblBtn

156 return dblBtn

156

157

157 mpGo <- elClass "div" "demo-group" $ do

158 mpGo <- elClass "div" "demo-group" $ do

@@ -159,9 +160,9 @@ run = mdo

159 b <- value <$> checkbox False def

160 b <- value <$> checkbox False def

160 mpGo <- button "Test"

161 mpGo <- button "Test"

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

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

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

163+ dynText =<< holdDyn "No res yet" (tShow <$>

163− fmapMaybe reqSuccess $

164+ fmapMaybe reqSuccess

164− (multiResp))

165+ multiResp)

165 return mpGo

166 return mpGo

166

167

167 return ()

168 return ()

@@ -171,7 +172,7 @@ run = mdo

171 elClass "div" "demo-group" $ do

172 elClass "div" "demo-group" $ do

172 text "JSON Unicode encoding test"

173 text "JSON Unicode encoding test"

173 txt <- value <$> textInput def

174 txt <- value <$> textInput def

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

175+ ev <- (1 <$) <$> button "Question"

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

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

176 rr <- qna dQ ev

177 rr <- qna dQ ev

177 el "p" $

178 el "p" $

overrides.nix+3−3

@@ -6,8 +6,8 @@ let

7in

8reflex-platform.ghcjs.override {

9− overrides = self: super: {

9+ overrides = self: super: {

10− # servant = dc (self.callPackage (c2n deps/servant/servant) {});

10+ servant = dc (self.callPackage (c2n deps/servant/servant) {});

11− # http-api-data = dc (self.callPackage (c2n deps/http-api-data) {});

11+ http-api-data = dc (self.callPackage (c2n deps/http-api-data) {});

12 };

13}

src/Servant/Reflex.hs+51−61

@@ -4,13 +4,6 @@

4{-# LANGUAGE FlexibleContexts #-}

5{-# LANGUAGE FlexibleInstances #-}

6{-# LANGUAGE InstanceSigs #-}

7−{-# LANGUAGE OverloadedStrings #-}

8−{-# LANGUAGE PolyKinds #-}

9−{-# LANGUAGE ScopedTypeVariables #-}

10−{-# LANGUAGE TupleSections #-}

11−{-# LANGUAGE TypeFamilies #-}

12−{-# LANGUAGE TypeOperators #-}

13−{-# LANGUAGE UndecidableInstances #-}

14{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE MultiParamTypeClasses #-}

15{-# LANGUAGE OverloadedStrings #-}

8{-# LANGUAGE OverloadedStrings #-}

16{-# LANGUAGE PolyKinds #-}

9{-# LANGUAGE PolyKinds #-}

@@ -35,49 +28,46 @@ module Servant.Reflex

36------------------------------------------------------------------------------

29------------------------------------------------------------------------------

37import Control.Applicative

30import Control.Applicative

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

39−import qualified Data.Set as Set

40−import qualified Data.Text.Encoding as E

41−import Data.CaseInsensitive (mk)

31+import Data.CaseInsensitive (mk)

42import Data.Functor.Identity

32import Data.Functor.Identity

33+import qualified Data.Map as Map

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

43−import Data.Proxy (Proxy (..))

35+import Data.Proxy (Proxy (..))

44−import qualified Data.Map as Map

36+import qualified Data.Set as Set

45−import Data.Text (Text)

37+import Data.Text (Text)

46−import qualified Data.Text as T

38+import qualified Data.Text as T

39+import qualified Data.Text.Encoding as E

47−import GHC.TypeLits (KnownSymbol, symbolVal)

40+import GHC.TypeLits (KnownSymbol, symbolVal)

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

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

49− BasicAuthData, BuildHeadersTo(..),

42+ BasicAuthData, BuildHeadersTo (..),

50− Capture, contentType, Header,

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

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

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

52− MimeRender(..), MimeUnrender,

53− NoContent, QueryFlag, QueryParam,

45+ MimeUnrender, NoContent, QueryFlag,

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

46+ QueryParam, QueryParams, Raw,

55− RemoteHost, ReqBody,

47+ ReflectMethod (..), RemoteHost,

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

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

57−

49+ Verb, contentType)

50+

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

51+import Reflex.Dom (Dynamic, Event, Reflex,

59− XhrRequest(..),

52+ XhrRequest (..), XhrResponse (..),

60− XhrResponseHeaders(..),

53+ XhrResponseHeaders (..),

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

54+ attachPromptlyDynWith, constDyn, ffor,

55+ fmapMaybe, leftmost,

62− leftmost, performRequestsAsync,

56+ performRequestsAsync)

63− )

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

57------------------------------------------------------------------------------

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

58+import Servant.Common.BaseUrl (BaseUrl (..), Scheme (..),

59+ SupportsServantReflex, baseUrlWidget,

66− showBaseUrl,

60+ showBaseUrl)

67− SupportsServantReflex)

68−import Servant.Common.Req (Req, ReqResult(..), QParam(..),

61+import Servant.Common.Req (QParam (..), QueryPart (..), Req,

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

62+ ReqResult (..), addHeader, authData,

70− defReq, evalResponse, prependToPathParts,

63+ defReq, evalResponse,

71− -- performRequestCT,

72− performRequestsCT,

64+ performRequestsCT,

73− -- performRequestNoBody,

74− performRequestsNoBody,

65+ performRequestsNoBody,

75− performSomeRequestsAsync,

66+ performSomeRequestsAsync,

76− qParamToQueryPart, reqBody,

67+ prependToPathParts, qParamToQueryPart,

77− reqSuccess, reqFailure,

68+ qParams, reqBody, reqFailure,

69+ reqMethod, reqSuccess, reqTag,

78− reqMethod, respHeaders, response,

70+ respHeaders, response)

79− reqTag,

80− qParams)

83-- * Accessing APIs as a Client

73-- * Accessing APIs as a Client

@@ -97,7 +87,7 @@ import Servant.Common.Req (Req, ReqResult(..), QParam(..),

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

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

98client :: (HasClient t m layout tag)

88client :: (HasClient t m layout tag)

99 => Proxy layout -> Proxy m -> Proxy tag -> Dynamic t BaseUrl -> Client t m layout tag

89 => Proxy layout -> Proxy m -> Proxy tag -> Dynamic t BaseUrl -> Client t m layout tag

100−client p q t baseurl = clientWithRoute p q t defReq baseurl

90+client p q t = clientWithRoute p q t defReq

101

102

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

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

@@ -139,7 +129,7 @@ instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout ta

139 q t

129 q t

140 (prependToPathParts p req)

130 (prependToPathParts p req)

141 baseurl

131 baseurl

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

132+ where p = (fmap . fmap) toUrlPiece val

143

133

144

134

145-- VERB (Returning content) --

135-- VERB (Returning content) --

@@ -153,7 +143,7 @@ instance {-# OVERLAPPABLE #-}

153 -- ExceptT ServantError IO a

143 -- ExceptT ServantError IO a

154 clientWithRoute Proxy _ _ req baseurl trigs =

144 clientWithRoute Proxy _ _ req baseurl trigs =

155 -- performRequestCT (Proxy :: Proxy ct) method req' baseurl trigs

145 -- performRequestCT (Proxy :: Proxy ct) method req' baseurl trigs

156− fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity $ req') baseurl trigs

146+ fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity req') baseurl trigs

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

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

158 req' = req { reqMethod = method }

148 req' = req { reqMethod = method }

159

149

@@ -267,8 +257,8 @@ instance HasClient t m sublayout tag

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

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

268 Client t m sublayout tag

258 Client t m sublayout tag

269

259

270− clientWithRoute Proxy q t =

260+ clientWithRoute Proxy =

271− clientWithRoute (Proxy :: Proxy sublayout) q t

261+ clientWithRoute (Proxy :: Proxy sublayout)

272

262

273

263

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

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

@@ -462,9 +452,9 @@ instance (MimeRender ct a, HasClient t m sublayout tag, Reflex t)

462instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient t m (path :> sublayout) tag where

452instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient t m (path :> sublayout) tag where

463 type Client t m (path :> sublayout) tag = Client t m sublayout tag

453 type Client t m (path :> sublayout) tag = Client t m sublayout tag

464

454

465− clientWithRoute Proxy q t req baseurl =

455+ clientWithRoute Proxy q t req =

466 clientWithRoute (Proxy :: Proxy sublayout) q t

456 clientWithRoute (Proxy :: Proxy sublayout) q t

467− (prependToPathParts (pure (Right $ T.pack p)) req) baseurl

457+ (prependToPathParts (pure (Right $ T.pack p)) req)

468

458

469 where p = symbolVal (Proxy :: Proxy path)

459 where p = symbolVal (Proxy :: Proxy path)

470

460

@@ -472,23 +462,23 @@ instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient

472instance HasClient t m api tag => HasClient t m (Vault :> api) tag where

462instance HasClient t m api tag => HasClient t m (Vault :> api) tag where

473 type Client t m (Vault :> api) tag = Client t m api tag

463 type Client t m (Vault :> api) tag = Client t m api tag

474

464

475− clientWithRoute Proxy q t req baseurl =

465+ clientWithRoute Proxy =

476− clientWithRoute (Proxy :: Proxy api) q t req baseurl

466+ clientWithRoute (Proxy :: Proxy api)

477

467

478

468

479instance HasClient t m api tag => HasClient t m (RemoteHost :> api) tag where

469instance HasClient t m api tag => HasClient t m (RemoteHost :> api) tag where

480 type Client t m (RemoteHost :> api) tag = Client t m api tag

470 type Client t m (RemoteHost :> api) tag = Client t m api tag

481

471

482− clientWithRoute Proxy q t req baseurl =

472+ clientWithRoute Proxy =

483− clientWithRoute (Proxy :: Proxy api) q t req baseurl

473+ clientWithRoute (Proxy :: Proxy api)

484

474

485

475

486

476

487instance HasClient t m api tag => HasClient t m (IsSecure :> api) tag where

477instance HasClient t m api tag => HasClient t m (IsSecure :> api) tag where

488 type Client t m (IsSecure :> api) tag = Client t m api tag

478 type Client t m (IsSecure :> api) tag = Client t m api tag

489

479

490− clientWithRoute Proxy q t req baseurl =

480+ clientWithRoute Proxy =

491− clientWithRoute (Proxy :: Proxy api) q t req baseurl

481+ clientWithRoute (Proxy :: Proxy api)

492

482

493

483

494instance (HasClient t m api tag, Reflex t)

484instance (HasClient t m api tag, Reflex t)