@@ -10,6 +10,7 @@
1010{-# LANGUAGE TypeFamilies #-}
1111
1212import Control.Concurrent
13+import Control.Lens ((^.))
1314import Control.Monad
1415import Control.Monad.Catch
1516import Control.Monad.Fix
@@ -19,7 +20,7 @@ import Data.IORef
1920import Data.Maybe (fromMaybe)
2021import Data.Proxy
2122import Data.Text (Text)
22−import Language.Javascript.JSaddle (JSException(..), syncPoint, liftJSM)
23+import Language.Javascript.JSaddle (JSException(..), syncPoint, liftJSM, jsg, js1)
2324import Language.Javascript.JSaddle.Warp
2425import Network.HTTP.Types (status200)
2526import Network.Wai
@@ -31,7 +32,7 @@ import System.Timeout
3132import Test.Hspec
3233import Test.HUnit
3334import Test.WebDriver (WD)
34−import qualified GHCJS.DOM.Types as DOM (File)
35+import qualified GHCJS.DOM.Types as DOM
3536import qualified GHCJS.DOM.File as File
3637
3738--import System.IO.Silently
@@ -39,6 +40,8 @@ import System.IO.Temp
3940import System.Directory
4041import qualified System.FilePath as FilePath
4142
43+import qualified GHCJS.DOM.EventM as EventM
44+import qualified GHCJS.DOM.GlobalEventHandlers as Events
4245import qualified Data.ByteString.Lazy as LBS
4346import qualified Data.Text as T
4447import qualified Data.Text.Encoding as TE
@@ -199,6 +202,23 @@ main = hspec $ parallel $ do
199202 pure e
200203 testWidget' checkSSRAttr (\e -> assertAttr e "ssr" Nothing) $ el "div" $ text "hello world"
201204
205+ it "can't misuse raw elements" $ do
206+ clicked <- newIORef False
207+ let check = do
208+ e <- WD.findElem $ WD.ByTag "div"
209+ liftIO $ readIORef clicked >>= flip shouldBe True
210+ WD.click e
211+ liftIO $ do
212+ threadDelay 100000
213+ readIORef clicked >>= flip shouldBe False
214+ testWidget (pure ()) check $ do
215+ (e, _) <- el' "div" $ text "hello"
216+ prerender (pure ()) $ do
217+ let e' = DOM.uncheckedCastTo DOM.HTMLElement (_element_raw e)
218+ liftJSM $ e' `EventM.on` Events.click $ do
219+ liftIO $ writeIORef clicked True
220+ pure ()
221+
202222 describe "inputElement" $ parallel $ do
203223 it "doesn't wipe user input when switching over" $ do
204224 inputRef <- newIORef ""
@@ -240,6 +260,30 @@ main = hspec $ parallel $ do
240260 testWidget (pure ()) checkValue $ do
241261 e <- inputElement def
242262 performEvent_ $ liftIO . writeIORef focusRef <$> updated (_inputElement_hasFocus e)
263+ it "sets value appropriately" $ do
264+ valueByUIRef <- newIORef ""
265+ valueRef <- newIORef ""
266+ setValueChan :: Chan Text <- newChan
267+ let checkValue = do
268+ liftIO $ readIORef valueByUIRef >>= flip shouldBe ""
269+ liftIO $ readIORef valueRef >>= flip shouldBe ""
270+ e <- WD.findElem $ WD.ByTag "input"
271+ WD.sendKeys "hello" e
272+ liftIO $ do
273+ threadDelay 100000
274+ readIORef valueByUIRef >>= flip shouldBe "hello"
275+ readIORef valueRef >>= flip shouldBe "hello"
276+ writeChan setValueChan "world"
277+ threadDelay 100000
278+ readIORef valueByUIRef >>= flip shouldBe "hello"
279+ readIORef valueRef >>= flip shouldBe "world"
280+ testWidget (pure ()) checkValue $ do
281+ (setValue, triggerSetValue) <- newTriggerEvent
282+ prerender (pure ()) $ liftIO $ void $ forkIO $ forever $ do
283+ triggerSetValue =<< readChan setValueChan
284+ e <- inputElement $ def & inputElementConfig_setValue .~ setValue
285+ performEvent_ $ liftIO . writeIORef valueByUIRef <$> _inputElement_input e
286+ performEvent_ $ liftIO . writeIORef valueRef <$> updated (value e)
243287 it "sets checked appropriately" $ do
244288 checkedByUIRef <- newIORef False
245289 checkedRef <- newIORef False