ee086c7 · reflex-dom · git.iko.soy

default.nix+2−1

compare with develop

unifiedsplit

@@ -1,6 +1,6 @@

1{ mkDerivation, dependent-map, ghcjs-dom, lens

2, mtl, reflex, safe, text, these

3−, transformers, data-default, semigroups

3+, transformers, data-default, semigroups, string-conv

4}:

5

6mkDerivation {

@@ -19,6 +19,7 @@ mkDerivation {

19 text

20 data-default

21 semigroups

22+ string-conv

22 ];

23 ];

23 license = null;

24 license = null;

24}

25}

reflex-dom.cabal+3−1

@@ -33,7 +33,9 @@ library

33 if impl(ghcjs)

34 cpp-options: -D__GHCJS__

35 build-depends:

36+ aeson,

36− ghcjs-base

37+ ghcjs-base,

38+ string-conv

37

39

38 exposed-modules:

40 exposed-modules:

39 Reflex.Dom

41 Reflex.Dom

src/Reflex/Dom/Xhr.hs+18−1

@@ -5,10 +5,12 @@ module Reflex.Dom.Xhr where

5import Control.Lens

6import Control.Monad

7import Control.Monad.IO.Class

8+import Data.Aeson

8import Data.Default

9import Data.Default

9import Data.Map (Map)

10import Data.Map (Map)

10import qualified Data.Map as Map

11import qualified Data.Map as Map

11import Data.Maybe

12import Data.Maybe

13+import Data.String.Conv

12import Data.Text (Text)

14import Data.Text (Text)

13import qualified Data.Text as T

15import qualified Data.Text as T

14import GHCJS.Foreign

16import GHCJS.Foreign

@@ -51,7 +53,7 @@ newXMLHttpRequest req cb = do

51 xhr <- xmlHttpRequestNew

53 xhr <- xmlHttpRequestNew

52 let c = _xhrRequest_config req

54 let c = _xhrRequest_config req

53 xmlHttpRequestOpen

55 xmlHttpRequestOpen

54− xhr

56+ xhr

55 (_xhrRequest_method req)

57 (_xhrRequest_method req)

56 (_xhrRequest_url req)

58 (_xhrRequest_url req)

57 True

59 True

@@ -74,4 +76,19 @@ performRequestAsync :: MonadWidget t m => Event t XhrRequest -> m (Event t XhrRe

74performRequestAsync req = performEventAsync $ ffor req $ \r cb -> do

76performRequestAsync req = performEventAsync $ ffor req $ \r cb -> do

75 liftIO $ newXMLHttpRequest r cb

77 liftIO $ newXMLHttpRequest r cb

76 return ()

78 return ()

79+

80+getAndDecode :: (FromJSON a, MonadWidget t m) => Event t String -> m (Event t (Maybe a))

81+getAndDecode url = do

82+ r <- performRequestAsync $ fmap (\x -> XhrRequest "GET" x def) url

83+ return $ fmap decodeXhrResponse r

84+

85+decodeText :: FromJSON a => Text -> Maybe a

86+decodeText = decode . toS

87+

88+decodeJSString :: FromJSON a => JSString -> Maybe a

89+decodeJSString = decodeText . fromJSString

90+

91+decodeXhrResponse :: FromJSON a => XhrResponse -> Maybe a

92+decodeXhrResponse = join . fmap decodeJSString . _xhrResponse_body

93+

77#endif

94#endif