on develop help sign in
Merge develop into jsaddle
commit929b0faa1a629c3c633c7d51f0b55d67a9f07c7a authorHamish Mackenzie <Hamish.K.Mackenzie@googlemail.com> dateSun 29 Jan 2017, 14:05 (10 years ago) parent402ad568290c80
4 files changed+126−37
reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+18−11 reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+4−2 reflex-dom-core/src/Reflex/Dom/Builder/Static.hs+4−2 reflex-dom-core/src/Reflex/Dom/Xhr.hs+100−22
reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+18−11
@@ -152,27 +152,20 @@ type Namespace = Text
152152
153153data TextNodeConfig t
154154 = TextNodeConfig { _textNodeConfig_initialContents :: Text
155− , _textNodeConfig_setContents :: Event t Text
155+ , _textNodeConfig_setContents :: Maybe (Event t Text)
156156 }
157157
158158#ifndef USE_TEMPLATE_HASKELL
159159textNodeConfig_initialContents :: Lens' (TextNodeConfig t) Text
160160textNodeConfig_initialContents f (TextNodeConfig a b) = (\a' -> TextNodeConfig a' b) <$> f a
161161{-# INLINE textNodeConfig_initialContents #-}
162−textNodeConfig_setContents :: Lens
163− (TextNodeConfig t1)
164− (TextNodeConfig t2)
165− (Event t1 Text)
166− (Event t2 Text)
167−textNodeConfig_setContents f (TextNodeConfig a b) = (\b' -> TextNodeConfig a b') <$> f b
168−{-# INLINE textNodeConfig_setContents #-}
169162#endif
170163
171164instance (Reflex t) => Default (TextNodeConfig t) where
172165 {-# INLINABLE def #-}
173166 def = TextNodeConfig
174167 { _textNodeConfig_initialContents = mempty
175− , _textNodeConfig_setContents = never
168+ , _textNodeConfig_setContents = Nothing
176169 }
177170
178171data TextNode d t = TextNode
@@ -450,10 +443,24 @@ data SelectElement er d t = SelectElement
450443 , _selectElement_raw :: RawSelectElement d
451444 }
452445
446+#ifdef USE_TEMPLATE_HASKELL
447+makeLensesFor
448+ [("_textNodeConfig_initialContents", "textNodeConfig_initialContents")]
449+ ''TextNodeConfig
450+#endif
451+
452+-- | This lens is technically illegal. The implementation of 'TextNodeConfig' uses a 'Maybe' under the hood for efficiency reasons. However, always interacting with 'TextNodeConfig' via lenses will always behave correctly, and if you pattern match on it, you should always treat 'Nothing' as 'never'.
453+textNodeConfig_setContents :: Reflex t => Lens (TextNodeConfig t) (TextNodeConfig t) (Event t Text) (Event t Text)
454+textNodeConfig_setContents =
455+ let getter t = case _textNodeConfig_setContents t of
456+ Nothing -> never
457+ Just e -> e
458+ setter t e = t { _textNodeConfig_setContents = Just e }
459+ in lens getter setter
460+
453461#ifdef USE_TEMPLATE_HASKELL
454462concat <$> mapM makeLenses
455− [ ''TextNodeConfig
456− , ''ElementConfig
463+ [ ''ElementConfig
457464 , ''PlaceholderConfig
458465 , ''InputElementConfig
459466 , ''TextAreaElementConfig
reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+4−2
@@ -329,9 +329,11 @@ instance er ~ EventResult => Default (GhcjsEventSpec er) where
329329instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t m) where
330330 type DomBuilderSpace (ImmediateDomBuilderT t m) = GhcjsDomSpace
331331 {-# INLINABLE textNode #-}
332− textNode (TextNodeConfig initialContents eSetContents) = do
332+ textNode (TextNodeConfig initialContents mSetContents) = do
333333 n <- textNodeInternal initialContents
334− lift $ performEvent_ $ ffor eSetContents $ \t -> setNodeValue n (Just t)
334+ case mSetContents of
335+ Nothing -> return ()
336+ Just eSetContents -> lift $ performEvent_ $ ffor eSetContents $ \t -> setNodeValue n (Just t)
335337 return $ TextNode n
336338 {-# INLINABLE element #-}
337339 element elementTag cfg child = fst <$> makeElement elementTag cfg child
reflex-dom-core/src/Reflex/Dom/Builder/Static.hs+4−2
@@ -174,11 +174,13 @@ instance (Reflex t, MonadAdjust t m, MonadHold t m) => MonadAdjust t (StaticDomB
174174instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) where
175175 type DomBuilderSpace (StaticDomBuilderT t m) = StaticDomSpace
176176 {-# INLINABLE textNode #-}
177− textNode (TextNodeConfig initialContents setContents) = StaticDomBuilderT $ do
177+ textNode (TextNodeConfig initialContents mSetContents) = StaticDomBuilderT $ do
178178 --TODO: Do not escape quotation marks; see https://stackoverflow.com/questions/25612166/what-characters-must-be-escaped-in-html-5
179179 shouldEscape <- asks _staticDomBuilderEnv_shouldEscape
180180 let escape = if shouldEscape then fromHtmlEscapedText else byteString . encodeUtf8
181− modify . (:) <=< hold (escape initialContents) $ fmapCheap escape setContents --Only because it doesn't get optimized when profiling is on
181+ modify . (:) =<< case mSetContents of
182+ Nothing -> return (pure (escape initialContents))
183+ Just setContents -> hold (escape initialContents) $ fmapCheap escape setContents --Only because it doesn't get optimized when profiling is on
182184 return $ TextNode ()
183185 {-# INLINABLE element #-}
184186 element elementTag cfg child = do
reflex-dom-core/src/Reflex/Dom/Xhr.hs+100−22
@@ -8,30 +8,72 @@
88#ifdef USE_TEMPLATE_HASKELL
99{-# LANGUAGE TemplateHaskell #-}
1010#endif
11+
12+-- | A module for performing asynchronous HTTP calls from JavaScript
13+-- using the
14+-- <https://developer.mozilla.org/en-US/docs/Web/API/XMLHttpRequest XMLHttpRequest>
15+-- API (essentially AJAX). Despite the name, there is nothing whatsoever specific to XML.
16+--
17+-- The API has two components:
18+--
19+-- * convenient functions for common usecases like GET and POST
20+-- requests to APIs using JSON.
21+--
22+-- * a flexible set of functions for creating and executing arbitrary
23+-- requests and handling responses.
24+--
1125module Reflex.Dom.Xhr
12− ( XMLHttpRequest
13− , XhrRequest (..)
14− , XhrRequestConfig (..)
15− , XhrResponse (..)
16− , XhrResponseBody (..)
17− , XhrResponseHeaders (..)
18− , XhrResponseType (..)
19− , XhrException (..)
20− , IsXhrPayload (..)
21− , _xhrResponse_body
22− , decodeText
23− , decodeXhrResponse
24− , getAndDecode
26+ ( -- * Common Patterns
27+
28+ -- | Functions that conveniently expose common uses like GET and
29+ -- POST to JSON APIs.
30+ getAndDecode
2531 , getMay
26− , newXMLHttpRequest
27− , newXMLHttpRequestWithError
28− , performMkRequestAsync
29− , performMkRequestsAsync
30− , performRequestAsync
31− , performRequestAsyncWithError
32− , performRequestsAsync
33− , performRequestsAsyncWithError
3432 , postJson
33+
34+ , decodeXhrResponse
35+ , decodeText
36+
37+ -- * General Request API
38+
39+ -- | This is the most general flow for sending XHR requests:
40+ --
41+ -- 1. Create an 'Event' stream of 'XhrRequest' records (ie
42+ -- @Event t (XhrRequest a)@). The records configure the request,
43+ -- and the 'Event' controls when the request or requests are
44+ -- actually sent.
45+ --
46+ -- 2. Plug the @Event t (XhrRequest a)@ into one of the functions
47+ -- for performing requests like 'performRequestAsync'.
48+ --
49+ -- 3. Consume the resulting stream of 'XhrResponse' events,
50+ -- parsing the body of the response however appropriate. A really
51+ -- common pattern is turning the 'Event' into a 'Dynamic' with
52+ -- 'holdDyn' or a related function.
53+ --
54+ -- Here is an example of calling a search API whenever the user
55+ -- types in a text input field and printing the result on the page:
56+ --
57+ -- @
58+ -- url query = "http:\/\/example.com\/search?query=" \<> query
59+ --
60+ -- search queries = do
61+ -- responses \<- performRequestAsync $ toRequest \<$> queries
62+ -- return $ view xhrResponse_responseText \<$> responses
63+ -- where toRequest query = XhrRequest \"GET" (url query) def
64+ --
65+ -- main = mainWidget $ do
66+ -- input \<- textInput def
67+ -- let queries = updated $ input ^. textInput_value
68+ -- results \<- search queries
69+ -- asText \<- holdDyn "No results." $ pack . show \<$> results
70+ -- dynText asText
71+ -- @
72+
73+ -- ** XHR Requests
74+ , XhrRequest (..)
75+ , XhrRequestConfig (..)
76+
3577 , xhrRequest
3678 , xhrRequestConfig_headers
3779 , xhrRequestConfig_password
@@ -43,12 +85,48 @@ module Reflex.Dom.Xhr
4385 , xhrRequest_config
4486 , xhrRequest_method
4587 , xhrRequest_url
46− , xhrResponse_body
88+
89+ -- ** Performing Requests
90+ , performMkRequestAsync
91+ , performMkRequestsAsync
92+ , performRequestAsync
93+ , performRequestAsyncWithError
94+ , performRequestsAsync
95+ , performRequestsAsyncWithError
96+
97+ -- ** XHR Responses
98+ , XhrResponse (..)
99+ , XhrResponseBody (..)
100+ , XhrResponseHeaders (..)
101+ , XhrResponseType (..)
102+
47103 , xhrResponse_response
48104 , xhrResponse_responseText
49105 , xhrResponse_status
50106 , xhrResponse_statusText
51107 , xhrResponse_headers
108+
109+ -- *** Deprecated
110+ , xhrResponse_body
111+ , _xhrResponse_body
112+
113+ -- ** Error Handling
114+ , XhrException (..)
115+ , IsXhrPayload (..)
116+
117+ -- * JavaScript XMLHttpRequest Objects
118+
119+ -- | 'XMLHttpRequest' is the type of JavaScript's underlying runtime
120+ -- objects that represent XHR requests.
121+ --
122+ -- Chances are you shouldn't need these in day-to-day code.
123+ , XMLHttpRequest
124+
125+ -- ** Constructors
126+ , newXMLHttpRequest
127+ , newXMLHttpRequestWithError
128+
129+ -- ** Fields
52130 , xmlHttpRequestGetReadyState
53131 , xmlHttpRequestGetResponseText
54132 , xmlHttpRequestGetStatus