master...dd16ebb · servant-reflex

git.iko.soy/servant-reflex

on dd16ebb help sign in

servant-reflex.cabal+2−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,

@@ -42,7 +43,7 @@ library

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

43 reflex-dom-core == 0.4 && < 0.5,

43 safe >= 0.3.9 && < 0.4,

44 safe >= 0.3.9 && < 0.4,

44 servant >= 0.8 && < 0.12,

45 servant >= 0.8 && < 0.12,

45− servant-auth >= 0.2.1 && < 0.3,

46+ servant-auth >= 0.2.1 && < 0.4,

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

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

47 text >= 1.2 && < 1.3,

48 text >= 1.2 && < 1.3,

48 transformers >= 0.4 && < 0.6

49 transformers >= 0.4 && < 0.6

src/Servant/Common/Req.hs+65−19

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

8{-# LANGUAGE ScopedTypeVariables #-}

9{-# LANGUAGE TupleSections #-}

11+{-# LANGUAGE MultiParamTypeClasses #-}

12+{-# LANGUAGE FlexibleInstances #-}

11module Servant.Common.Req where

13module Servant.Common.Req where

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

15-------------------------------------------------------------------------------

@@ -15,8 +17,11 @@ import Control.Applicative (liftA2, liftA3)

15import Control.Concurrent

17import Control.Concurrent

16import Control.Monad (join)

18import Control.Monad (join)

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

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

20+import Data.Aeson

18import Data.Bifunctor (first)

21import Data.Bifunctor (first)

19−import qualified Data.ByteString.Builder as Builder

22+import qualified Data.ByteString.Builder as BB

23+import qualified Data.ByteString as BS

24+import Data.ByteString.Lazy (ByteString)

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

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

21import qualified Data.Map as Map

26import qualified Data.Map as Map

22import Data.Maybe (catMaybes, fromMaybe)

27import Data.Maybe (catMaybes, fromMaybe)

@@ -25,17 +30,24 @@ import Data.Monoid ((<>))

25import Data.Proxy (Proxy(..))

30import Data.Proxy (Proxy(..))

26import Data.Text (Text)

31import Data.Text (Text)

27import qualified Data.Text as T

32import qualified Data.Text as T

28−import qualified Data.Text.Encoding as TE

33+import qualified Data.Text.Lazy as TL

34+import qualified Data.Text.Encoding as T

29import Data.Traversable (forM)

35import Data.Traversable (forM)

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

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

37+import qualified Language.Javascript.JSaddle as JS

38+import qualified Data.JSString.Text as JS (lazyTextFromJSString)

31import qualified Network.URI as N

39import qualified Network.URI as N

32import Reflex.Dom.Core hiding (tag)

40import Reflex.Dom.Core hiding (tag)

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

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

34 SupportsServantReflex)

42 SupportsServantReflex)

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

43+import Servant.API.ContentTypes ( NoContent(..), Accept, JSON

44+ , OctetStream, PlainText

45+ , FormUrlEncoded)

36import Web.HttpApiData (ToHttpApiData(..))

46import Web.HttpApiData (ToHttpApiData(..))

47+import Web.FormUrlEncoded (FromForm, urlDecodeAsForm)

37-------------------------------------------------------------------------------

48-------------------------------------------------------------------------------

38import Servant.API.BasicAuth

49import Servant.API.BasicAuth

50+-------------------------------------------------------------------------------

41------------------------------------------------------------------------------

53------------------------------------------------------------------------------

@@ -150,7 +162,7 @@ prependToPathParts p req =

150 req { reqPathParts = p : reqPathParts req }

162 req { reqPathParts = p : reqPathParts req }

151

163

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

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

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

165+addHeader name val req = req { headers = (name, (fmap . fmap) (T.decodeUtf8 . toHeader) val) : headers req }

154

166

155

167

156reqToReflexRequest

168reqToReflexRequest

@@ -245,8 +257,8 @@ reqToReflexRequest reqMeth reqHost req =

245 mkAuth _ (Left e) = Left e

257 mkAuth _ (Left e) = Left e

246 mkAuth Nothing r = r

258 mkAuth Nothing r = r

247 mkAuth (Just (BasicAuthData u p)) (Right config) = Right $ config

259 mkAuth (Just (BasicAuthData u p)) (Right config) = Right $ config

248− { _xhrRequestConfig_user = Just $ TE.decodeUtf8 u

260+ { _xhrRequestConfig_user = Just $ T.decodeUtf8 u

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

261+ , _xhrRequestConfig_password = Just $ T.decodeUtf8 p}

250

262

251 addAuth :: Dynamic t (Either Text (XhrRequestConfig x))

263 addAuth :: Dynamic t (Either Text (XhrRequestConfig x))

252 -> Dynamic t (Either Text (XhrRequestConfig x))

264 -> Dynamic t (Either Text (XhrRequestConfig x))

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

326 return ()

338 return ()

327

339

328

340

329−

330type XhrPayload = T.Text

341type XhrPayload = T.Text

331bytesToPayload :: BL.ByteString -> XhrPayload

342bytesToPayload :: BL.ByteString -> XhrPayload

332−bytesToPayload = TE.decodeUtf8 . BL.toStrict

343+bytesToPayload = T.decodeUtf8 . BL.toStrict

333

344

334

345

335performRequestsCT

346performRequestsCT

@@ -344,11 +355,10 @@ performRequestsCT

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

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

345performRequestsCT ct reqMeth reqs reqHost opts trigger = do

356performRequestsCT ct reqMeth reqs reqHost opts trigger = do

346 resps <- performRequests reqMeth reqs reqHost opts trigger

357 resps <- performRequests reqMeth reqs reqHost opts trigger

347− let decodeResp x = first T.pack .

358+ let decodeResp x = first T.pack

348− mimeUnrender ct .

359+ . mimeUnrender ct

349− BL.fromStrict .

360+ . JS.textToJSString

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

351− (_xhrResponse_responseText x)

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

352 return $ fmap

362 return $ fmap

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

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

354 Left e -> RequestFailure t e

364 Left e -> RequestFailure t e

@@ -379,7 +389,7 @@ evalResponse

379 :: (XhrResponse -> Either Text a)

389 :: (XhrResponse -> Either Text a)

380 -> (tag, XhrResponse)

390 -> (tag, XhrResponse)

381 -> ReqResult tag a

391 -> ReqResult tag a

382−evalResponse decode (tag, xhr) =

392+evalResponse decodeRes (tag, xhr) =

383 let okStatus = _xhrResponse_status xhr < 400

393 let okStatus = _xhrResponse_status xhr < 400

384 errMsg = fromMaybe

394 errMsg = fromMaybe

385 ("Empty response with error code " <>

395 ("Empty response with error code " <>

@@ -389,20 +399,56 @@ evalResponse decode (tag, xhr) =

389 then either

399 then either

390 (\e -> ResponseFailure tag e xhr)

400 (\e -> ResponseFailure tag e xhr)

391 (\v -> ResponseSuccess tag v xhr)

401 (\v -> ResponseSuccess tag v xhr)

392− (decode xhr)

402+ (decodeRes xhr)

393 else ResponseFailure tag errMsg xhr

403 else ResponseFailure tag errMsg xhr

394 in respPayld

404 in respPayld

395

405

396

406

407+-- | Similar to 'Servant.API.ContentType.MimeUnrender' but with the differnce that

408+-- the second argument expects a JSString instead of ByteString.

409+-- This can lead to better performance ghcjs.

410+class Accept contentType => MimeUnrender contentType a where

411+ mimeUnrender :: Proxy contentType -> JS.JSString -> Either String a

412+

413+instance FromJSON a => MimeUnrender JSON a where

414+ mimeUnrender _ = note "Failed to decode response" . jsonDecode

415+

416+-- | @urlDecodeAsForm@

417+-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only

418+-- holds if every element of x is non-null (i.e., not @("", "")@)

419+instance FromForm a => MimeUnrender FormUrlEncoded a where

420+ mimeUnrender _ = first T.unpack . urlDecodeAsForm . BB.toLazyByteString . T.encodeUtf8Builder . JS.textFromJSString

421+

422+-- | @left show . TextL.decodeUtf8'@

423+instance MimeUnrender PlainText TL.Text where

424+ mimeUnrender _ = pure . JS.lazyTextFromJSString

425+

426+-- | @left show . TextS.decodeUtf8' . toStrict@

427+instance MimeUnrender PlainText T.Text where

428+ mimeUnrender _ = pure . JS.textFromJSString

429+

430+-- | @Right . BC.unpack@

431+instance MimeUnrender PlainText String where

432+ mimeUnrender _ = Right . T.unpack . JS.textFromJSString

433+

434+-- | @Right . id@

435+instance MimeUnrender OctetStream ByteString where

436+ mimeUnrender _ = pure . BB.toLazyByteString . T.encodeUtf8Builder . JS.textFromJSString

437+

438+-- | @Right . toStrict@

439+instance MimeUnrender OctetStream BS.ByteString where

440+ mimeUnrender _ = pure . T.encodeUtf8 . JS.textFromJSString

441+

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

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

398−note e = maybe (Left e) Right

443+note e Nothing = Left e

444+note _ (Just a) = Right a

399

445

400fmapL :: (e -> e') -> Either e a -> Either e' a

446fmapL :: (e -> e') -> Either e a -> Either e' a

401fmapL _ (Right a) = Right a

447fmapL _ (Right a) = Right a

402fmapL f (Left e) = Left (f e)

448fmapL f (Left e) = Left (f e)

403

449

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

450+builderToText :: BB.Builder -> T.Text

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

451+builderToText = T.decodeUtf8 . BL.toStrict . BB.toLazyByteString

406

452

407escape :: T.Text -> T.Text

453escape :: T.Text -> T.Text

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

454+escape = T.pack . N.escapeURIString (not . N.isReserved) . T.unpack . T.decodeUtf8 . BL.toStrict . BB.toLazyByteString . toEncodedUrlPiece

src/Servant/Reflex.hs+2−2

@@ -51,7 +51,7 @@ import Servant.API ((:<|>)(..),(:>), BasicAuth,

51 BasicAuthData, BuildHeadersTo(..),

52 Capture, contentType, Header,

53 Headers(..), HttpVersion, IsSecure,

54− MimeRender(..), MimeUnrender,

54+ MimeRender(..),

55 NoContent, QueryFlag, QueryParam,

56 QueryParams, Raw, ReflectMethod(..),

57 RemoteHost, ReqBody,

@@ -68,7 +68,7 @@ import Reflex.Dom.Core (Dynamic, Event, Reflex,

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

69 showBaseUrl,

70 SupportsServantReflex)

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

71+import Servant.Common.Req (ClientOptions(..), MimeUnrender(..),

72 defaultClientOptions,

73 Req, ReqResult(..), QParam(..),

74 QueryPart(..), addHeader, authData,

src/Servant/Reflex/Multi.hs+2−2

@@ -49,7 +49,7 @@ import Servant.API ((:<|>) (..), (:>), BasicAuth,

49 BasicAuthData, BuildHeadersTo (..),

50 Capture, Header, Headers (..),

51 HttpVersion, IsSecure, MimeRender (..),

52− MimeUnrender, NoContent, QueryFlag,

52+ NoContent, QueryFlag,

53 QueryParam, QueryParams, Raw,

54 ReflectMethod (..), RemoteHost,

55 ReqBody, ToHttpApiData (..), Vault,

@@ -62,7 +62,7 @@ import Reflex.Dom.Core (Dynamic, Event, Reflex,

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

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

64 SupportsServantReflex)

65−import Servant.Common.Req (ClientOptions,

65+import Servant.Common.Req (ClientOptions, MimeUnrender,

66 QParam (..), QueryPart (..), Req,

67 ReqResult (..), addHeader, authData,

68 defReq,