on develop help sign in
Implement textAreas
commit4129aaf174f14acbdc3224f2c59bf503ef8e629f authorRyan Trinkle <ryan.trinkle@gmail.com> dateFri 27 May 2016, 13:46 (10 years ago) parent6c5fcb8
1 file changed+22−5
src/Reflex/Dom/Builder/Immediate.hs+22−5
src/Reflex/Dom/Builder/Immediate.hs+22−5
@@ -11,13 +11,14 @@ import Foreign.JavaScript.TH
1111import GHCJS.DOM.Document (Document, createTextNode, createElement, createElementNS, createDocumentFragment)
1212import GHCJS.DOM.Element (setAttribute, setAttributeNS, removeAttribute, removeAttributeNS, getScrollTop)
1313import qualified GHCJS.DOM.HTMLInputElement as Input
14+import qualified GHCJS.DOM.HTMLTextAreaElement as TextArea
1415import qualified GHCJS.DOM.Element as Element
1516import qualified GHCJS.DOM.Window as Window
1617import GHCJS.DOM.EventM (on, event, EventM)
1718import qualified GHCJS.DOM.Event as Event
1819import GHCJS.DOM.MouseEvent
1920import GHCJS.DOM.Node (appendChild, getParentNode, getPreviousSibling, removeChild, toNode, getOwnerDocument, insertBefore)
20−import GHCJS.DOM.Types (Node, IsNode, ToDOMString, FocusEvent, KeyboardEvent, WheelEvent, TouchEvent, IsElement, IsEvent, castToHTMLInputElement)
21+import GHCJS.DOM.Types (Node, IsNode, ToDOMString, FocusEvent, KeyboardEvent, WheelEvent, TouchEvent, IsElement, IsEvent, castToHTMLInputElement, castToHTMLTextAreaElement)
2122import qualified GHCJS.DOM.Types as DOM
2223import qualified GHCJS.DOM.EventM as DOM
2324import GHCJS.DOM.UIEvent
@@ -232,12 +233,28 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t
232233 [ False <$ Reflex.select (_element_events e) (WrapArg Blur)
233234 , True <$ Reflex.select (_element_events e) (WrapArg Focus)
234235 ]
235− inputValue <- wrapDomEvent domElement (`on` Element.input) $ fromMaybe "" <$> Input.getValue domInputElement
236− return $ InputElement v (nubDyn c) inputValue hasFocus e
236+ return $ InputElement v (nubDyn c) valueChangedByUI hasFocus e
237237 {-# INLINABLE textAreaElement #-}
238238 textAreaElement cfg = do --TODO
239− (i, _) <- element "textarea" (_textAreaElementConfig_elementConfig cfg) $ return ()
240− return $ TextAreaElement (constDyn "") never (constDyn False) i
239+ ((e, _), domElement) <- makeElement "textarea" (cfg ^. textAreaElementConfig_elementConfig) $ return ()
240+ let domTextAreaElement = castToHTMLTextAreaElement domElement
241+ Just v0 <- TextArea.getValue domTextAreaElement
242+ let getMyValue = fromMaybe "" <$> TextArea.getValue domTextAreaElement
243+ valueChangedByUI <- performEvent $ ffor (Reflex.select (_element_events e) (WrapArg Input)) $ \_ ->
244+ getMyValue
245+ valueChangedBySetValue <- performEvent $ ffor (cfg ^. textAreaElementConfig_setValue) $ \v' -> do
246+ TextArea.setValue domTextAreaElement $ Just v'
247+ getMyValue -- We get the value after setting it in case the browser has mucked with it somehow
248+ v <- holdDyn v0 $ leftmost
249+ [ valueChangedBySetValue
250+ , valueChangedByUI
251+ ]
252+ let initialFocus = False --TODO: Is this correct?
253+ hasFocus <- holdDyn initialFocus $ leftmost
254+ [ False <$ Reflex.select (_element_events e) (WrapArg Blur)
255+ , True <$ Reflex.select (_element_events e) (WrapArg Focus)
256+ ]
257+ return $ TextAreaElement v valueChangedByUI hasFocus e
241258
242259{-# INLINABLE insertImmediateAbove #-}
243260insertImmediateAbove :: (Reflex t, IsNode placeholder, PerformEvent t m, MonadIO (Performable m)) => placeholder -> Event t (ImmediateDomBuilderT t (Performable m) a) -> ImmediateDomBuilderT t m (Event t a)