master...c8339e0 · servant-reflex

git.iko.soy/servant-reflex

on c8339e0 help sign in

servant-reflex.cabal+1

since splitsnapshots

unifiedsplit

@@ -27,6 +27,7 @@ library

27 hs-source-dirs: src

28 build-depends:

29 base >= 4.8 && < 4.10,

30+ aeson >= 0.11 && < 1.3,

30 bytestring >= 0.10 && < 0.11,

31 bytestring >= 0.10 && < 0.11,

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

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

32 containers >= 0.5.6 && < 0.6,

33 containers >= 0.5.6 && < 0.6,

src/Servant/Common/Req.hs+20−11

@@ -14,6 +14,7 @@ import Control.Concurrent

14import Control.Applicative (liftA2, liftA3)

15import Control.Monad (join)

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

17+import Data.Aeson

17import Data.Bifunctor (first)

18import Data.Bifunctor (first)

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

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

19import qualified Data.Map as Map

20import qualified Data.Map as Map

@@ -26,6 +27,8 @@ import qualified Data.Text as T

26import qualified Data.Text.Encoding as TE

27import qualified Data.Text.Encoding as TE

27import Data.Traversable (forM)

28import Data.Traversable (forM)

28import Language.Javascript.JSaddle.Monad (JSM, MonadJSM)

29import Language.Javascript.JSaddle.Monad (JSM, MonadJSM)

30+import qualified Language.Javascript.JSaddle as JS

31+import Language.Javascript.JSaddle.Types (JSVal)

29import Reflex.Dom hiding (tag)

32import Reflex.Dom hiding (tag)

30import Servant.Common.BaseUrl (BaseUrl, showBaseUrl,

33import Servant.Common.BaseUrl (BaseUrl, showBaseUrl,

31 SupportsServantReflex)

34 SupportsServantReflex)

@@ -347,23 +350,29 @@ bytesToPayload = TE.decodeUtf8 . BL.toStrict

347-- , fmap (uncurry RequestFailure) badReq

350-- , fmap (uncurry RequestFailure) badReq

348-- ]

351-- ]

349

352

350−

351performRequestsCT

353performRequestsCT

352− :: (SupportsServantReflex t m,

354+ :: ( SupportsServantReflex t m

353− MimeUnrender ct a, Traversable f)

355+ -- , MimeUnrender ct a

356+ , FromJSON a

357+ , Traversable f

358+ )

354 => Proxy ct

359 => Proxy ct

355 -> Text

360 -> Text

356 -> Dynamic t (f (Req t))

361 -> Dynamic t (f (Req t))

357 -> Dynamic t BaseUrl

362 -> Dynamic t BaseUrl

358 -> Event t tag

363 -> Event t tag

359 -> m (Event t (f (ReqResult tag a)))

364 -> m (Event t (f (ReqResult tag a)))

360−performRequestsCT ct reqMeth reqs reqHost trigger = do

365+performRequestsCT _ reqMeth reqs reqHost trigger = do

361 resps <- performRequests reqMeth reqs reqHost trigger

366 resps <- performRequests reqMeth reqs reqHost trigger

362− let decodeResp x = first T.pack .

367+ -- let decodeResp x = first T.pack .

363− mimeUnrender ct .

368+ -- mimeUnrender ct .

364− BL.fromStrict .

369+ -- BL.fromStrict .

365− TE.encodeUtf8 =<< note "No body text"

370+ -- TE.encodeUtf8 =<< note "No body text"

371+ let decodeResp x = first T.pack

372+ . note "Failed to decode"

373+ . jsonDecode

374+ . JS.textToJSString

366− (_xhrResponse_responseText x)

375+ =<< note "No body text" (_xhrResponse_responseText x)

367 return $ fmap

376 return $ fmap

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

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

369 Left e -> RequestFailure t e

378 Left e -> RequestFailure t e

@@ -393,7 +402,7 @@ evalResponse

393 :: (XhrResponse -> Either Text a)

402 :: (XhrResponse -> Either Text a)

394 -> (tag, XhrResponse)

403 -> (tag, XhrResponse)

395 -> ReqResult tag a

404 -> ReqResult tag a

396−evalResponse decode (tag, xhr) =

405+evalResponse decodeRes (tag, xhr) =

397 let okStatus = _xhrResponse_status xhr < 400

406 let okStatus = _xhrResponse_status xhr < 400

398 errMsg = fromMaybe

407 errMsg = fromMaybe

399 ("Empty response with error code " <>

408 ("Empty response with error code " <>

@@ -403,7 +412,7 @@ evalResponse decode (tag, xhr) =

403 then either

412 then either

404 (\e -> ResponseFailure tag e xhr)

413 (\e -> ResponseFailure tag e xhr)

405 (\v -> ResponseSuccess tag v xhr)

414 (\v -> ResponseSuccess tag v xhr)

406− (decode xhr)

415+ (decodeRes xhr)

407 else ResponseFailure tag errMsg xhr

416 else ResponseFailure tag errMsg xhr

408 in respPayld

417 in respPayld

409

418

src/Servant/Reflex.hs+4−2

@@ -34,6 +34,7 @@ module Servant.Reflex

34 ) where

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

37+import Data.Aeson

37import Control.Applicative

38import Control.Applicative

38import Data.Monoid ((<>))

39import Data.Monoid ((<>))

39import qualified Data.Set as Set

40import qualified Data.Set as Set

@@ -128,7 +129,7 @@ instance (HasClient t m a tag, HasClient t m b tag) => HasClient t m (a :<|> b)

128-- -> m (Event t (l, ReqResult Book))

129-- -> m (Event t (l, ReqResult Book))

129-- > getBook = client myApi (constDyn host)

130-- > getBook = client myApi (constDyn host)

130

131

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

132+instance (SupportsServantReflex t m, FromJSON a, ToHttpApiData a, HasClient t m sublayout tag)

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

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

133

134

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

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

@@ -145,7 +146,7 @@ instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout ta

145-- VERB (Returning content) --

146-- VERB (Returning content) --

146instance {-# OVERLAPPABLE #-}

147instance {-# OVERLAPPABLE #-}

147 -- Note [Non-Empty Content Types]

148 -- Note [Non-Empty Content Types]

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

149+ (FromJSON a, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts), SupportsServantReflex t m

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

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

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

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

151 Event t tag -> m (Event t (ReqResult tag a))

152 Event t tag -> m (Event t (ReqResult tag a))

@@ -198,6 +199,7 @@ instance {-# OVERLAPPABLE #-} (BuildHeaderKeysTo xs, KnownSymbol h)

198instance {-# OVERLAPPABLE #-}

199instance {-# OVERLAPPABLE #-}

199 -- Note [Non-Empty Content Types]

200 -- Note [Non-Empty Content Types]

200 ( MimeUnrender ct a, BuildHeadersTo ls, BuildHeaderKeysTo ls,

201 ( MimeUnrender ct a, BuildHeadersTo ls, BuildHeaderKeysTo ls,

202+ FromJSON a,

201 ReflectMethod method, cts' ~ (ct ': cts),

203 ReflectMethod method, cts' ~ (ct ': cts),

202 SupportsServantReflex t m

204 SupportsServantReflex t m

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

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

src/Servant/Reflex/Multi.hs+3

@@ -34,6 +34,7 @@ module Servant.Reflex.Multi (

34 ) where

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

37+import Data.Aeson

37import Control.Applicative (liftA2)

38import Control.Applicative (liftA2)

38import Data.Functor.Compose (Compose (..), getCompose)

39import Data.Functor.Compose (Compose (..), getCompose)

39import Data.Proxy (Proxy (..))

40import Data.Proxy (Proxy (..))

@@ -119,6 +120,7 @@ instance (SupportsServantReflex t m,

119instance {-# OVERLAPPABLE #-}

120instance {-# OVERLAPPABLE #-}

120 -- Note [Non-Empty Content Types]

121 -- Note [Non-Empty Content Types]

121 (MimeUnrender ct a,

122 (MimeUnrender ct a,

123+ FromJSON a,

122 ReflectMethod method, cts' ~ (ct ': cts),

124 ReflectMethod method, cts' ~ (ct ': cts),

123 SupportsServantReflex t m,

125 SupportsServantReflex t m,

124 Applicative f,

126 Applicative f,

@@ -152,6 +154,7 @@ instance {-# OVERLAPPING #-}

152instance {-# OVERLAPPABLE #-}

154instance {-# OVERLAPPABLE #-}

153 -- Note [Non-Empty Content Types]

155 -- Note [Non-Empty Content Types]

154 ( MimeUnrender ct a, BuildHeadersTo ls, BuildHeaderKeysTo ls,

156 ( MimeUnrender ct a, BuildHeadersTo ls, BuildHeaderKeysTo ls,

157+ FromJSON a,

155 ReflectMethod method, cts' ~ (ct ': cts),

158 ReflectMethod method, cts' ~ (ct ': cts),

156 SupportsServantReflex t m,

159 SupportsServantReflex t m,

157 Traversable f

160 Traversable f