git.iko.soy/reflex-dom
on develop help sign in
Merge develop into jsaddle
929b0faHamish Mackenzie
reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+18−11
compare with develop
unifiedsplit
@@ -152,27 +152,20 @@ type Namespace = Text
152
152
153data TextNodeConfig t
153data TextNodeConfig t
154 = TextNodeConfig { _textNodeConfig_initialContents :: Text
154 = TextNodeConfig { _textNodeConfig_initialContents :: Text
155− , _textNodeConfig_setContents :: Event t Text
155+ , _textNodeConfig_setContents :: Maybe (Event t Text)
156 }
156 }
157
157
158#ifndef USE_TEMPLATE_HASKELL
158#ifndef USE_TEMPLATE_HASKELL
159textNodeConfig_initialContents :: Lens' (TextNodeConfig t) Text
159textNodeConfig_initialContents :: Lens' (TextNodeConfig t) Text
160textNodeConfig_initialContents f (TextNodeConfig a b) = (\a' -> TextNodeConfig a' b) <$> f a
160textNodeConfig_initialContents f (TextNodeConfig a b) = (\a' -> TextNodeConfig a' b) <$> f a
161{-# INLINE textNodeConfig_initialContents #-}
161{-# 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 #-}
169#endif
162#endif
170
163
171instance (Reflex t) => Default (TextNodeConfig t) where
164instance (Reflex t) => Default (TextNodeConfig t) where
172 {-# INLINABLE def #-}
165 {-# INLINABLE def #-}
173 def = TextNodeConfig
166 def = TextNodeConfig
174 { _textNodeConfig_initialContents = mempty
167 { _textNodeConfig_initialContents = mempty
175− , _textNodeConfig_setContents = never
168+ , _textNodeConfig_setContents = Nothing
176 }
169 }
177
170
178data TextNode d t = TextNode
171data TextNode d t = TextNode
@@ -450,10 +443,24 @@ data SelectElement er d t = SelectElement
450 , _selectElement_raw :: RawSelectElement d
443 , _selectElement_raw :: RawSelectElement d
451 }
444 }
452
445
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+
453#ifdef USE_TEMPLATE_HASKELL
461#ifdef USE_TEMPLATE_HASKELL
454concat <$> mapM makeLenses
462concat <$> mapM makeLenses
455− [ ''TextNodeConfig
456− , ''ElementConfig
463+ [ ''ElementConfig
457 , ''PlaceholderConfig
464 , ''PlaceholderConfig
458 , ''InputElementConfig
465 , ''InputElementConfig
459 , ''TextAreaElementConfig
466 , ''TextAreaElementConfig
reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+4−2
@@ -329,9 +329,11 @@ instance er ~ EventResult => Default (GhcjsEventSpec er) where
329instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t m) where
329instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t m) where
330 type DomBuilderSpace (ImmediateDomBuilderT t m) = GhcjsDomSpace
330 type DomBuilderSpace (ImmediateDomBuilderT t m) = GhcjsDomSpace
331 {-# INLINABLE textNode #-}
331 {-# INLINABLE textNode #-}
332− textNode (TextNodeConfig initialContents eSetContents) = do
332+ textNode (TextNodeConfig initialContents mSetContents) = do
333 n <- textNodeInternal initialContents
333 n <- textNodeInternal initialContents
334+ case mSetContents of
335+ Nothing -> return ()
334− lift $ performEvent_ $ ffor eSetContents $ \t -> setNodeValue n (Just t)
336+ Just eSetContents -> lift $ performEvent_ $ ffor eSetContents $ \t -> setNodeValue n (Just t)
335 return $ TextNode n
337 return $ TextNode n
336 {-# INLINABLE element #-}
338 {-# INLINABLE element #-}
337 element elementTag cfg child = fst <$> makeElement elementTag cfg child
339 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
174instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) where
174instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) where
175 type DomBuilderSpace (StaticDomBuilderT t m) = StaticDomSpace
175 type DomBuilderSpace (StaticDomBuilderT t m) = StaticDomSpace
176 {-# INLINABLE textNode #-}
176 {-# INLINABLE textNode #-}
177− textNode (TextNodeConfig initialContents setContents) = StaticDomBuilderT $ do
177+ textNode (TextNodeConfig initialContents mSetContents) = StaticDomBuilderT $ do
178 --TODO: Do not escape quotation marks; see https://stackoverflow.com/questions/25612166/what-characters-must-be-escaped-in-html-5
178 --TODO: Do not escape quotation marks; see https://stackoverflow.com/questions/25612166/what-characters-must-be-escaped-in-html-5
179 shouldEscape <- asks _staticDomBuilderEnv_shouldEscape
179 shouldEscape <- asks _staticDomBuilderEnv_shouldEscape
180 let escape = if shouldEscape then fromHtmlEscapedText else byteString . encodeUtf8
180 let escape = if shouldEscape then fromHtmlEscapedText else byteString . encodeUtf8
181+ modify . (:) =<< case mSetContents of
182+ Nothing -> return (pure (escape initialContents))
181− modify . (:) <=< hold (escape initialContents) $ fmapCheap escape setContents --Only because it doesn't get optimized when profiling is on
183+ Just setContents -> hold (escape initialContents) $ fmapCheap escape setContents --Only because it doesn't get optimized when profiling is on
182 return $ TextNode ()
184 return $ TextNode ()
183 {-# INLINABLE element #-}
185 {-# INLINABLE element #-}
184 element elementTag cfg child = do
186 element elementTag cfg child = do
reflex-dom-core/src/Reflex/Dom/Xhr.hs+100−22
@@ -8,30 +8,72 @@
8#ifdef USE_TEMPLATE_HASKELL
8#ifdef USE_TEMPLATE_HASKELL
9{-# LANGUAGE TemplateHaskell #-}
9{-# LANGUAGE TemplateHaskell #-}
10#endif
10#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+--
11module Reflex.Dom.Xhr
25module Reflex.Dom.Xhr
12− ( XMLHttpRequest
26+ ( -- * Common Patterns
13− , XhrRequest (..)
27+
14− , XhrRequestConfig (..)
28+ -- | Functions that conveniently expose common uses like GET and
15− , XhrResponse (..)
29+ -- POST to JSON APIs.
16− , XhrResponseBody (..)
17− , XhrResponseHeaders (..)
18− , XhrResponseType (..)
19− , XhrException (..)
20− , IsXhrPayload (..)
21− , _xhrResponse_body
22− , decodeText
23− , decodeXhrResponse
24− , getAndDecode
30+ getAndDecode
25 , getMay
31 , getMay
26− , newXMLHttpRequest
27− , newXMLHttpRequestWithError
28− , performMkRequestAsync
29− , performMkRequestsAsync
30− , performRequestAsync
31− , performRequestAsyncWithError
32− , performRequestsAsync
33− , performRequestsAsyncWithError
34 , postJson
32 , 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+
35 , xhrRequest
77 , xhrRequest
36 , xhrRequestConfig_headers
78 , xhrRequestConfig_headers
37 , xhrRequestConfig_password
79 , xhrRequestConfig_password
@@ -43,12 +85,48 @@ module Reflex.Dom.Xhr
43 , xhrRequest_config
85 , xhrRequest_config
44 , xhrRequest_method
86 , xhrRequest_method
45 , xhrRequest_url
87 , 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+
47 , xhrResponse_response
103 , xhrResponse_response
48 , xhrResponse_responseText
104 , xhrResponse_responseText
49 , xhrResponse_status
105 , xhrResponse_status
50 , xhrResponse_statusText
106 , xhrResponse_statusText
51 , xhrResponse_headers
107 , 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
52 , xmlHttpRequestGetReadyState
130 , xmlHttpRequestGetReadyState
53 , xmlHttpRequestGetResponseText
131 , xmlHttpRequestGetResponseText
54 , xmlHttpRequestGetStatus
132 , xmlHttpRequestGetStatus