4129aaf · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Implement textAreas

4129aafRyan Trinkle10 years ago

src/Reflex/Dom/Builder/Immediate.hs+22−5

compare with develop

unifiedsplit

@@ -11,13 +11,14 @@ import Foreign.JavaScript.TH

11import GHCJS.DOM.Document (Document, createTextNode, createElement, createElementNS, createDocumentFragment)

12import GHCJS.DOM.Element (setAttribute, setAttributeNS, removeAttribute, removeAttributeNS, getScrollTop)

13import qualified GHCJS.DOM.HTMLInputElement as Input

14+import qualified GHCJS.DOM.HTMLTextAreaElement as TextArea

14import qualified GHCJS.DOM.Element as Element

15import qualified GHCJS.DOM.Element as Element

15import qualified GHCJS.DOM.Window as Window

16import qualified GHCJS.DOM.Window as Window

16import GHCJS.DOM.EventM (on, event, EventM)

17import GHCJS.DOM.EventM (on, event, EventM)

17import qualified GHCJS.DOM.Event as Event

18import qualified GHCJS.DOM.Event as Event

18import GHCJS.DOM.MouseEvent

19import GHCJS.DOM.MouseEvent

19import GHCJS.DOM.Node (appendChild, getParentNode, getPreviousSibling, removeChild, toNode, getOwnerDocument, insertBefore)

20import 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)

21import qualified GHCJS.DOM.Types as DOM

22import qualified GHCJS.DOM.Types as DOM

22import qualified GHCJS.DOM.EventM as DOM

23import qualified GHCJS.DOM.EventM as DOM

23import GHCJS.DOM.UIEvent

24import GHCJS.DOM.UIEvent

@@ -232,12 +233,28 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t

232 [ False <$ Reflex.select (_element_events e) (WrapArg Blur)

233 [ False <$ Reflex.select (_element_events e) (WrapArg Blur)

233 , True <$ Reflex.select (_element_events e) (WrapArg Focus)

234 , True <$ Reflex.select (_element_events e) (WrapArg Focus)

234 ]

235 ]

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

237 {-# INLINABLE textAreaElement #-}

238 textAreaElement cfg = do --TODO

239− (i, _) <- element "textarea" (_textAreaElementConfig_elementConfig cfg) $ return ()

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+ ]

240− return $ TextAreaElement (constDyn "") never (constDyn False) i

257+ return $ TextAreaElement v valueChangedByUI hasFocus e

241

258

242{-# INLINABLE insertImmediateAbove #-}

259{-# INLINABLE insertImmediateAbove #-}

243insertImmediateAbove :: (Reflex t, IsNode placeholder, PerformEvent t m, MonadIO (Performable m)) => placeholder -> Event t (ImmediateDomBuilderT t (Performable m) a) -> ImmediateDomBuilderT t m (Event t a)

260insertImmediateAbove :: (Reflex t, IsNode placeholder, PerformEvent t m, MonadIO (Performable m)) => placeholder -> Event t (ImmediateDomBuilderT t (Performable m) a) -> ImmediateDomBuilderT t m (Event t a)